diff --git a/.github/workflows/deploy-oauth-moodle.yml b/.github/workflows/deploy-oauth-moodle.yml new file mode 100644 index 000000000..6e5979d9c --- /dev/null +++ b/.github/workflows/deploy-oauth-moodle.yml @@ -0,0 +1,73 @@ +# 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 }} + 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/.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/Dockerfile b/Dockerfile index bd280f5ad..cb1a8c698 100644 --- a/Dockerfile +++ b/Dockerfile @@ -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/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"] diff --git a/docker-compose.yml b/docker-compose.yml new file mode 100644 index 000000000..d4734708b --- /dev/null +++ b/docker-compose.yml @@ -0,0 +1,103 @@ +# 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 + +# 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: + learnocaml: + container_name: backend + # image: ocamlsf/learn-ocaml:0.13 + build: . + ports: + - '8080:8080' + environment: + # (ocaml variable) root URL: + LEARNOCAML_BASE_URL: "http://localhost:8080" + # (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 + + # Only useful for dev + maildev: + image: maildev/maildev + ports: + - "1080:80" + 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: + image: 'docker.io/bitnami/mariadb:10.3-debian-10' + environment: + - ALLOW_EMPTY_PASSWORD=yes + - MARIADB_USER=bn_moodle + - MARIADB_DATABASE=bitnami_moodle + # - BITNAMI_DEBUG=true + volumes: + - 'mariadb_data:/bitnami/mariadb' + networks: + - moodle-net + 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 + # - BITNAMI_DEBUG=true + volumes: + - 'moodle_data:/bitnami/moodle' + - 'moodledata_data:/bitnami/moodledata' + networks: + - moodle-net + 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 + name: localdomain + moodle-net: + driver: bridge diff --git a/docs/howto-deploy-a-learn-ocaml-instance.md b/docs/howto-deploy-a-learn-ocaml-instance.md index 51588b210..90456887c 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. diff --git a/learn-ocaml-client.opam b/learn-ocaml-client.opam index 476ab76e8..fe0f001e7 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] diff --git a/learn-ocaml.opam b/learn-ocaml.opam index 8777f30d6..6ea653302 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -21,6 +21,7 @@ depends: [ "cohttp-lwt" {>= "1.0.0" & < "2.0.0"} "cohttp-lwt-unix" {>= "1.0.0" & < "2.0.0"} "conf-git" + "cryptokit" "decompress" {= "0.8.1"} "digestif" {>= "0.7.1"} "dune" {= "2.0.1"} @@ -41,6 +42,7 @@ depends: [ "markup" "markup-lwt" "ocaml" {= "4.05.0"} + "ocamlnet" {> "4.1"} "ocamlfind" {build} "ocp-indent-nlfork" "ocp-ocamlres" {>= "0.4"} @@ -50,8 +52,8 @@ depends: [ "pprint" "ppx_cstruct" "ppx_tools" + "safepass" "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..13f87b353 100644 --- a/learn-ocaml.opam.locked +++ b/learn-ocaml.opam.locked @@ -39,6 +39,7 @@ depends: [ "conf-pkg-config" {= "1.2"} "conf-which" {= "1"} "cppo" {= "1.6.6"} + "cryptokit" {= "1.14"} "cstruct" {= "5.0.0"} "decompress" {= "0.8.1"} "digestif" {= "0.8.0-1"} @@ -69,6 +70,7 @@ depends: [ "mmap" {= "1.1.0"} "num" {= "0"} "ocaml" {= "4.05.0"} + "ocamlnet" {= "4.1.7"} "ocaml-compiler-libs" {= "v0.9.0"} "ocaml-migrate-parsetree" {= "1.7.3"} "ocaml-secondary-compiler" {= "4.08.1-1"} @@ -101,6 +103,7 @@ depends: [ "result" {= "1.5"} "rresult" {= "0.6.0"} "seq" {= "0.2.2"} + "safepass" {= "3.0"} "sexplib" {= "v0.9.3"} "ssl" {= "0.5.5"} "stdio" {= "v0.9.1"} @@ -111,7 +114,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/app/dune b/src/app/dune index e48a6d160..48d7dc033 100644 --- a/src/app/dune +++ b/src/app/dune @@ -143,6 +143,70 @@ (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)) +) + +(executable + (name learnocaml_reset_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_reset_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)) +) + +(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)) +) + +(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) @@ -151,6 +215,10 @@ (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) + (learnocaml_reset_main.bc.js as www/js/learnocaml-reset.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_common.ml b/src/app/learnocaml_common.ml index bd9c10aff..a16cd83d5 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 = @@ -135,22 +139,29 @@ 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; 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 +990,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 +1001,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 +1009,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..43b2ef606 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -23,6 +23,13 @@ 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 () -> ()] *) +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 -> @@ -44,6 +51,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_config.ml b/src/app/learnocaml_config.ml index f99afef34..f989bc192 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##.baseUrl (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 ba20ae535..9c63e7ef3 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 cf67f896c..3e08a9e92 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" @@ -43,11 +46,26 @@ module El = struct module Login_overlay = struct let login_overlay_id, login_overlay = id "login-overlay" - let input_nick_id, input_nick = id "login-nickname-input" - let input_secret_id, input_secret = id "login-secret-input" + let login_new_token_id, login_new_token = id "login-new-token" + let login_new_id, login_new = id "login-new" + let login_returning_id, login_returning = id "login-returning" + + let token_nickname_id, token_nickname = id "token-nickname-input" + let token_secret_id, token_secret = id "token-secret-input" + let token_new_button_id, token_new_button = id "token-new-button" + 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" - let input_tok_id, input_tok = id "login-token-input" + let login_input_email_id, login_input_email = id "login-email-input" + let login_input_password_id, login_input_password = id "login-password-input" + let login_forgotten_id, login_forgotten = id "txt_login_forgotten" let button_connect_id, button_connect = id "login-connect-button" + let login_input_token_id, login_input_token = id "login-token-input" + let button_token_connect_id, button_token_connect = id "login-token-button" let nickname_field_id, nickname_field = id "learnocaml-nickname" end @@ -515,6 +533,30 @@ let teacher_tab token a b () = let get_stored_token () = Learnocaml_local_storage.(retrieve sync_token) +let can_show_token ?(force=false) () = + (* Is this localStorage caching really useful? *) + 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 *) + 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 = @@ -528,58 +570,276 @@ 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 ~force:true () >>= 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 + 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 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 @@ + 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 -> + 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 ""); + 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"]]; + 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 () -> + cb_alert ~title:[%i"RESET REQUEST SENT"] + ([%i"A confirmation e-mail has been sent to the address:"] + ^ " " ^ new_email) + Js_utils.reload; + Lwt.return_none + | Error (`Not_found _) -> + alert ~title:[%i"ERROR"] + [%i"The entered e-mail couldn't be recognized."]; + 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 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 validate_email email = + if check_email_js email then Lwt.return_some email + 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"; + if get_opt config##.enablePasswd then + Manip.SetCss.display login_new_token "none" + else + begin + Manip.SetCss.display login_new "none"; + Manip.SetCss.display login_returning "none" + end; let get_token, got_token = Lwt.task () in + let create_raw_token () = + if not (get_opt config##.enablePasswd) then + let nickname = String.trim (Manip.value token_nickname) in + if Token.check nickname || String.length nickname < 2 then + (Manip.SetCss.borderColor token_nickname "#f44"; + Lwt.return_none) + else + let secret = Sha.sha512 (String.trim (Manip.value token_secret)) 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; + Learnocaml_local_storage.(store can_show_token) true; + show_token_dialog token + >>= fun () -> + Lwt.return_some (token, nickname)) + else + Lwt.return_none + in let create_token () = - let nickname = String.trim (Manip.value input_nick) in - if Token.check nickname || String.length nickname < 2 then - (Manip.SetCss.borderColor input_nick "#f44"; - Lwt.return_none) + 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) 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 || 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 + 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 + 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 + 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 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 + else + let nickname = String.trim (Manip.value reg_input_nick) and + secret = Sha.sha512 (String.trim (Manip.value input_secret)) in + retrieve (Learnocaml_api.Nonce ()) + >>= fun nonce -> + let secret = Sha.sha512 (nonce ^ secret) in + (Learnocaml_local_storage.(store nickname) nickname; + retrieve + (Learnocaml_api.Create_user (email, nickname, password, secret)) + >>= fun () -> + cb_alert ~title:[%i"VALIDATION REQUIRED"] + [%i"A confirmation e-mail has been sent to your address."] + Js_utils.reload; + Lwt.return_none) else - let secret = Sha.sha512 (String.trim (Manip.value input_secret)) 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)) + Lwt.return_none in - let rec login_token () = - let input = input_tok in - match Token.parse (Manip.value input) with - | exception (Failure _) -> - Manip.SetCss.borderColor input "#f44"; - Lwt.return_none - | token -> - Server_caller.request (Learnocaml_api.Fetch_save token) >>= function - | Ok save -> + let rec login_passwd () = + let email = Manip.value login_input_email and + password = Manip.value login_input_password in + if get_opt config##.enablePasswd then + 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 + | Ok token -> + 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_some (token, save.Save.nickname) - | Error (`Not_found _) -> + | 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 -> + | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ - H.p [H.txt [%i"Could not retrieve data from server"]]; - H.code [H.txt (Server_caller.string_of_error e)]; - ] ~buttons:[ - [%i"Retry"], (fun () -> login_token ()); - [%i"Cancel"], (fun () -> Lwt.return_none); - ] + H.p [H.txt [%i"Could not retrieve data from server"]]; + H.code [H.txt (Server_caller.string_of_error e)]; + ] ~buttons:[ + [%i"Retry"], (fun () -> login_passwd ()); + [%i"Cancel"], (fun () -> Lwt.return_none); + ] + else + Lwt.return_none + in + let rec login_token () = + let input = login_input_token in + match Token.parse (Manip.value input) with + | exception (Failure _) -> + Manip.SetCss.borderColor input "#f44"; + Lwt.return_none + | token -> + Server_caller.request (Learnocaml_api.Can_login token) >>= function + | Error _ | Ok false -> + alert ~title:[%i"INVALID TOKEN"] @@ + 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 + | _ -> + 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) true; + Lwt.return_some (token, save.Save.nickname) + | Error (`Not_found _) -> + alert ~title:[%i"TOKEN NOT FOUND"] + [%i"The entered token couldn't be recognized."]; + 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 () -> login_token ()); + [%i"Cancel"], (fun () -> Lwt.return_none); + ] + in + 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"; + 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) + >>= complete_reset_password reset_password + else + Lwt.return_none in let handler f t = fun _ -> Lwt.async (fun () -> @@ -588,24 +848,64 @@ let init_token_dialog () = | None -> ()); t in + Manip.Ev.onclick token_new_button (handler create_raw_token false); + Manip.Ev.onreturn token_nickname (handler create_raw_token ()); Manip.Ev.onclick button_new (handler create_token false); - Manip.Ev.onreturn input_nick (handler create_token ()); - Manip.Ev.onclick button_connect (handler login_token false); - Manip.Ev.onreturn input_tok (handler login_token ()); + Manip.Ev.onreturn reg_input_nick (handler create_token ()); + Manip.Ev.onclick button_connect (handler login_passwd false); + Manip.Ev.onreturn login_input_password (handler login_passwd ()); + Manip.Ev.onclick login_forgotten (handler reset_password false); + Manip.Ev.onclick button_token_connect (handler login_token false); + Manip.Ev.onreturn login_input_token (handler login_token ()); get_token >|= fun (token, nickname) -> (Tyxml_js.To_dom.of_input nickname_field)##.value := Js.string nickname; 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 delete_cookie name = + Dom_html.document##.cookie := Js.string (Printf.sprintf "%s=; Max-age=-1;" name) + let init_sync_token button_group = catch (fun () -> - begin try - Lwt.return Learnocaml_local_storage.(retrieve sync_token) - with Not_found -> 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 () = @@ -617,13 +917,39 @@ let set_string_translations () = [%i"Activities"]; "txt_login_welcome", configured config##.txtLoginWelcome [%i"Welcome to Learn OCaml"]; + "txt_token_first_connection", [%i"First connection"]; + "txt_token_first_connection_dialog", [%i"Choose a nickname"]; + "txt_first_connection_secret", [%i"Enter the secret"]; + "txt_token_new", [%i"Create new token"]; "txt_first_connection", [%i"First connection"]; - "txt_first_connection_dialog", [%i"Choose a nickname"]; + "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_login_new", [%i"Create new token"]; + "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 account"]; "txt_returning", [%i"Returning user"]; - "txt_returning_dialog", [%i"Enter your token"]; + "txt_returning_email", [%i"E-mail address"]; + "txt_returning_password", [%i"Password"]; "txt_login_returning", [%i"Connect"]; + "txt_login_forgotten", [%i"Forgot your password?"]; + "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", (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"]; + "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) -> @@ -632,15 +958,12 @@ let set_string_translations () = let placeholder_translations = [ El.nickname_field, configured config##.txtNickname [%i"Nickname"]; - El.Login_overlay.input_nick, configured config##.txtNickname - [%i"Nickname"]; ] in List.iter (fun (el, text) -> (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 @@ -673,8 +996,65 @@ let () = Manip.appendChild El.content div ; delete_arg "activity" in + 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 () = + let rec change_password () = + 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 () -> + ask_string ~title:[%i"New e-mail 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 + if get_opt config##.enablePasswd then + can_show_token () >>= fun show_token -> + if show_token + then Lwt.return @@ show_upgrade_button () + 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 get_opt o = Js.Optdef.get o (fun () -> false) in let tabs = (if get_opt config##.enableTryocaml then [ "tryocaml", ([%i"Try OCaml"], tryocaml_tab) ] else []) @ @@ -782,33 +1162,44 @@ let () = Lwt.return_unit in let logout_dialog () = + can_show_token () >>= fun show_token -> Server_caller.request (Learnocaml_api.Update_save (get_stored_token (), get_state_as_save_file ())) >|= (function - | Ok _ -> - [%i"Be sure to write down your token before logging out:"] + | Ok _ -> + if show_token then + [%i"Be sure to write down your token before logging out:"] + else + [%i"Are you sure you want to logout?"] | Error _ -> [%i"WARNING: the data could not be synchronised with the server. \ Logging out will lose your local changes, be sure you exported \ a backup."]) >|= fun s -> + let dialog_content = + (H.p [H.txt s]) :: + if show_token then + [H.div ~a:[H.a_style "text-align: center;"] + [token_disp_div (get_stored_token ())]] + else + [] in confirm ~title:[%i"Logout"] ~ok_label:[%i"Logout"] - [H.p [H.txt s]; - H.div ~a:[H.a_style "text-align: center;"] - [token_disp_div (get_stored_token ())]] + dialog_content (fun () -> Lwt.async @@ fun () -> Learnocaml_local_storage.clear (); + delete_cookie "token"; reload (); Lwt.return_unit) in List.iter (fun (text, icon, f) -> button ~container:El.sync_buttons ~theme:"white" ~group:sync_button_group ~icon text f) [ - [%i"Show token"], "token", (fun () -> - show_token_dialog (get_stored_token ()); - Lwt.return_unit); + (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); @@ -857,7 +1248,10 @@ let () = true); Server_caller.request (Learnocaml_api.Version ()) >>= (function - | Ok _ -> init_sync_token sync_button_group >|= init_tabs + | Ok _ -> + init_sync_token sync_button_group >|= init_tabs >>= fun tabs -> + init_op () >>= fun () -> + Lwt.return tabs | Error _ -> Lwt.return (init_tabs None)) >>= fun tabs -> try let activity = arg "activity" in diff --git a/src/app/learnocaml_local_storage.ml b/src/app/learnocaml_local_storage.ml index d2e5e0d66..f8b05751e 100644 --- a/src/app/learnocaml_local_storage.ml +++ b/src/app/learnocaml_local_storage.ml @@ -151,6 +151,15 @@ let sync_token = { key = Some key ; dependent_keys = (=) key ; store ; retrieve ; delete ; listeners = [] } +let can_show_token = + let key = mangle [ "can-show-token" ] in + let enc = Json_encoding.(obj1 (req "can-show" bool)) in + let store value = store_single key enc value + and retrieve () = retrieve_single key enc () + and delete () = delete_single key enc () in + { key = Some key ; dependent_keys = (=) key ; + store ; retrieve ; delete ; listeners = [] } + let nickname = let key = mangle [ "nickname" ] in let enc = Json_encoding.(obj1 (req "nickname" string)) in diff --git a/src/app/learnocaml_local_storage.mli b/src/app/learnocaml_local_storage.mli index 1755e6342..f1febc4b6 100644 --- a/src/app/learnocaml_local_storage.mli +++ b/src/app/learnocaml_local_storage.mli @@ -46,4 +46,6 @@ val server_id : int storage_key val sync_token : Token.t storage_key +val can_show_token : bool storage_key + val nickname : string storage_key diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml new file mode 100644 index 000000000..b965a0ad0 --- /dev/null +++ b/src/app/learnocaml_lti_main.ml @@ -0,0 +1,167 @@ +(* 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 Lwt +open Learnocaml_data +open Learnocaml_common + +module H = Tyxml_js.Html5 + +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 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" + +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" + +let login_email_input_id, login_email_input = id "login-email-input" +let login_password_input_id, login_password_input = id "login-password-input" +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 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) -> + Manip.setInnerHtml (find_component id) text) + +let send_sync_request () = + let parameters = + [("email", [Manip.value reg_input_email]); + ("passwd", [Manip.value reg_input_password]); + ("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 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) 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 || 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 + 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 + 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 + else + let nickname = String.trim (Manip.value reg_input_nick) and + secret = Sha.sha512 (String.trim (Manip.value input_secret)) in + retrieve (Learnocaml_api.Nonce ()) + >>= fun nonce -> + let secret = Sha.sha512 (nonce ^ secret) in + (Learnocaml_local_storage.(store nickname) nickname; + 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."]; + Lwt.return_unit) + +let init_dialogs () = + Manip.SetCss.display login_overlay "block"; + Manip.Ev.onclick login_new_button (fun _ -> + Lwt.async create_token; + true) + +let () = + (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); + init_dialogs (); + set_string_translations [ + "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_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 \ + 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."]; + "txt_login_new", [%i"Create new account"]; + "txt_returning", [%i"Returning user"]; + "txt_returning_email", [%i"E-mail address"]; + "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"]; + "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/app/learnocaml_reset_main.ml b/src/app/learnocaml_reset_main.ml new file mode 100644 index 000000000..822e9780e --- /dev/null +++ b/src/app/learnocaml_reset_main.ml @@ -0,0 +1,27 @@ +(* 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 -> ()); + 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_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 = diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml new file mode 100644 index 000000000..08c228a7c --- /dev/null +++ b/src/app/learnocaml_upgrade_main.ml @@ -0,0 +1,124 @@ +(* 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 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 + (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_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"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."]; + ]; + init_token_dialog () + 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 new file mode 100644 index 000000000..0e5b1461f --- /dev/null +++ b/src/app/learnocaml_validate_main.ml @@ -0,0 +1,31 @@ +(* 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 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 -> ()); + let message = + [%i"Your e-mail address has been confirmed. You can now login."] in + cb_alert ~title:[%i"EMAIL CONFIRMED"] message redirect 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/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..c9c1331d1 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -15,6 +15,11 @@ open Arg let version = Api.version +let check_email_ml email = + let regexp = Str.regexp Learnocaml_data.email_regexp_ml in + Learnocaml_data.email_check_length email + && Str.string_match regexp email 0 + let url_conv = conv ~docv:"URL" ( (fun s -> @@ -88,6 +93,34 @@ module Args_create_token = struct let term = Term.(const apply $ nickname $ secret) end +module Args_create_user = struct + type t = { + email : string; + password : string; + nickname : string option; + secret : string option; + } + + let email = + value & pos 0 string "" & info [] ~docv:"EMAIL" ~doc: + "The email." + + let password = + value & pos 1 string "" & info [] ~docv:"PASSWORD" ~doc: + "The password." + + let nickname = + value & pos 2 (some string) None & info [] ~docv:"NICKNAME" ~doc: + "The desired nickname." + + let secret = + value & pos 3 (some string) None & info [] ~docv:"SECRET" ~doc: + "The secret. If not provided, use \"\" as a secret." + + let apply email password nickname secret = {email; password; nickname; secret} + let term = Term.(const apply $ email $ password $ nickname $ secret) +end + module Args_exercise_id = struct let id = value & pos 0 (some string) None & info [] ~docv:"ID" ~doc: @@ -424,7 +457,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 = @@ -435,9 +468,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 @@ -551,6 +584,51 @@ let get_nonce_and_create_token server nickname secret_candidate = fetch server (Api.Create_token (Sha.sha512 (nonce ^ secret_candidate), None, nickname)) +let get_nonce_and_create_user server email password nickname secret_candidate = + let secret_candidate = Sha.sha512 secret_candidate in + fetch server (Api.Nonce ()) + >>= fun nonce -> + fetch server + (Api.Create_user (email, nickname, password, Sha.sha512 (nonce ^ secret_candidate))) + +let user_login server email password = + fetch server (Api.Login (email, password)) + +let init ?(local=false) ?server ?token () = + let path = if local then ConfigFile.local_path else ConfigFile.user_path in + let server = get_server server in + let get_new_token nickname = + Printf.printf "Please provide the secret: "; + match Console.input ~default:None (fun s -> Some s) with + | Some secret_candidate -> + get_nonce_and_create_token server nickname secret_candidate + | None -> failwith "Please provide a secret" + in + let get_token () = + match token with + | Some t -> Lwt.return t + | None -> + Printf.eprintf + "Please provide your user token on %s (leave empty to generate one): %!" + (Uri.to_string server); + match + Console.input ~default:None + (fun s -> Some (Token.parse s)) + with + | Some t -> Lwt.return t + | None -> + Printf.eprintf "Please enter a nickname: %!"; + get_new_token + (Console.input + (fun s -> if String.length s < 2 then None else Some s)) + in + check_server_version server >>= fun _ -> + get_token () >>= fun token -> + let config = { ConfigFile. server; token=Some(token) } in + ConfigFile.write path config >|= fun () -> + Printf.eprintf "Configuration written to %s\n%!" path; + config + let get_config_option ?local ?(save_back=false) ?(allow_static=false) server_opt token_opt = match ConfigFile.path ?local () with | Some f -> @@ -600,7 +678,7 @@ let get_config_o ?save_back ?(allow_static=false) o = module Init = struct open Args_global open Args_create_token - + let init global_args create_token_args = let path = if global_args.local then ConfigFile.local_path else ConfigFile.user_path in let get_token server = @@ -639,7 +717,63 @@ module Init = struct ~doc:"Initialize the configuration file." "init" end - + +module Init_user = struct + open Args_global + open Args_create_user + + let init global_args create_user_args = + let path = if global_args.local then ConfigFile.local_path else ConfigFile.user_path in + 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 + | None -> Lwt.fail_with "You must provide a server." + | Some s -> Lwt.return s + in + get_server () >>= fun server -> + check_server_version server >>= fun _ -> + 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 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."; + 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 \ + create an account with an email, a password, a \ + nickname and a secret." + + let cmd = + Term.( + const (fun go co -> Pervasives.exit (Lwt_main.run (init go co))) + $ Args_global.term $ Args_create_user.term), + Term.info ~man + ~doc:"Initialize the configuration file." + "init-user" +end + module Grade = struct open Args_exercises let grade go eo = @@ -755,17 +889,17 @@ module Print_server = struct >>= fun config -> Lwt_io.printl (Uri.to_string config.ConfigFile.server) >|= fun () -> 0 - + let explanation = "Just print the configured server." - + let man = man explanation - + let cmd = use_global print_server, Term.info ~man ~doc:explanation "print-server" - + end - + module Set_options = struct let set_opts o = get_config_o ~save_back:true ~allow_static:true o @@ -926,7 +1060,7 @@ module Template = struct ~doc:"Get the template of a given exercise." "template" end - + module Exercise_list = struct let doc= "Get a structured json containing a list of the exercises of the server" @@ -942,19 +1076,46 @@ module Exercise_list = struct in let json = match ezjsonm with - | `O _ | `A _ as json -> json + | `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 exercise_list, 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 @@ -969,6 +1130,7 @@ end let () = match Term.eval_choice ~catch:false Main.cmd [ Init.cmd + ; Init_user.cmd ; Grade.cmd ; Print_token.cmd ; Set_options.cmd @@ -976,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/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 859cfaad6..5819bf009 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -373,14 +373,18 @@ let main o = \ enableLessons: %b,\n\ \ enableExercises: %b,\n\ \ enableToplevel: %b,\n\ - \ baseUrl: \"%s\"\n\ + \ baseUrl: \"%s\",\n\ + \ enablePasswd: %b,\n\ + \ enableMoodle: %b\n\ }\n" (tutorials_ret <> None) (playground_ret <> None) (lessons_ret <> None) (exercises_ret <> None) (o.builder.Builder.toplevel <> Some false) - o.builder.Builder.base_url >>= fun () -> + o.builder.Builder.base_url + preconfig.ServerData.use_passwd + preconfig.ServerData.use_moodle >>= fun () -> Lwt.return (tutorials_ret <> Some false && exercises_ret <> Some false))) else Lwt.return true diff --git a/src/main/learnocaml_server_main.ml b/src/main/learnocaml_server_main.ml index e3a4e3c3e..213e42d1c 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.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/dune b/src/server/dune index 6925512d6..08387d3c4 100644 --- a/src/server/dune +++ b/src/server/dune @@ -9,12 +9,16 @@ lwt_utils cohttp.lwt magic-mime - sha + sha checkseum.c decompress learnocaml_report learnocaml_data learnocaml_api learnocaml_store - learnocaml_partition_create) + learnocaml_sendmail + token_index + learnocaml_partition_create + cryptokit + markup) ) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index bcb01291d..17d3a0639 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -9,6 +9,11 @@ open Learnocaml_data open Learnocaml_store +let check_email_ml email = + let regexp = Str.regexp Learnocaml_data.email_regexp_ml in + Learnocaml_data.email_check_length email + && Str.string_match regexp email 0 + let port = ref 8080 let cert_key_files = ref None @@ -76,12 +81,17 @@ 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 } + | 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) @@ -116,21 +126,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 @@ -176,6 +187,83 @@ 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) + +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 + +let create_student conn (config: Learnocaml_data.Server.config) req + 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) + (`Forbidden, "No registered token for your address") + @@ fun nonce -> + Hashtbl.remove nonce_req conn; + let know_secret = + match config.ServerData.secret with + | None -> true + | Some x -> Sha.sha512 (nonce ^ x) = secret_candidate in + if not know_secret + then lwt_fail (`Forbidden, "Bad secret") + else + post_check + >?= fun () -> + Token.create_student () + >>= fun tok -> + (match nick with + | None -> Lwt.return_unit + | Some nickname -> Save.set tok Save.{empty with nickname}) + >>= fun () -> + (match base_auth with + | `Token use_moodle -> + 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 + ~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 () -> + 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) *) +let get_nickname token = + Save.get token >>= function + | 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 -> + Learnocaml_sendmail.reset_password + ~nick + ~url:(req.Api.host ^ "/reset_password/" ^ handle) + address; + respond_json cache address + module Memory_cache = struct let (tbl: (cache_request_hash, cached_response) Hashtbl.t) = @@ -196,6 +284,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" @@ -226,12 +315,152 @@ 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 -> + (* 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 + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + Token_index.check_oauth !sync_dir (req.Api.host ^ "/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 + 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_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 ~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 + 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 + let cookies = [Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) + ~path:"/" ~http_only:true + ("csrf", "expired")] in + let email = List.assoc "email" 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, password)) >>= + (function + | None -> lwt_fail (`Forbidden, "incorrect password") + | Some token -> + 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 }) + | 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) 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 + 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 () -> + Token_index.( + MoodleIndex.add_user !sync_dir user_id token >>= 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 } + | 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 _ -> + lwt_fail (`Forbidden, "LTI is disabled on this instance.") | Api.Static path -> respond_static cache path | Api.Nonce () -> @@ -245,39 +474,65 @@ module Request_handler = struct Hashtbl.add nonce_req conn nonce; nonce in respond_json cache nonce + | Api.Create_token _ when config.ServerData.use_passwd -> + lwt_fail (`Forbidden, "Creating a raw token is forbidden on this instance.") | Api.Create_token (secret_candidate, None, nick) -> valid_string_of_endp conn >?= fun conn -> - lwt_option_fail - (Hashtbl.find_opt nonce_req conn) - (`Forbidden, "No registered token for your address") - @@ fun nonce -> - Hashtbl.remove nonce_req conn; - let know_secret = - match config.ServerData.secret with - | None -> true - | Some x -> Sha.sha512 (nonce ^ x) = secret_candidate in - if not know_secret - then lwt_fail (`Forbidden, "Bad secret") - else - Token.create_student () - >>= fun tok -> - (match nick with | None -> Lwt.return_unit - | Some nickname -> - Save.set tok Save.{empty with nickname}) - >>= fun () -> respond_json cache tok + 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 () -> respond_json cache token) + (fun () -> Token.register token >>= fun () -> + let auth = Token_index.Token (token, false) in + Token_index.UserIndex.add !sync_dir auth >>= fun () -> + respond_json cache token) (function | Failure body -> (`Bad_request, body) | exn -> (`Internal_server_error, Printexc.to_string exn)) | 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 -> + 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 -> + Token_index.UserIndex.authenticate !sync_dir (Token_index.Passwd (nick, password)) >>= + (function + | Some token -> respond_json cache token + | _ -> + Lwt.return (Printf.printf "[WARNING] Bad login or password for: %s\n%!" nick) + >>= fun () -> + 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 _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Can_login token -> + 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 () -> @@ -295,7 +550,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 @@ -334,7 +590,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 -> @@ -421,7 +678,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 -> @@ -494,17 +752,222 @@ 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.emails_of_token !sync_dir token >>= + (function + | Some (old_address, _pending) -> + 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 -> + get_nickname token >>= fun nick -> + Learnocaml_sendmail.change_email + ~nick + ~url:(req.Api.host ^ "/confirm/" ^ handle) + 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 + | Some token -> + Token_index.UserIndex.confirm_email !sync_dir token >>= fun () -> + Token_index.UpgradeIndex.revoke_operation !sync_dir handle >>= fun () -> + respond_static cache ["validate.html"] + | None -> + lwt_fail (`Forbidden, "Nothing to do.")) + | Api.Send_reset_password address when config.ServerData.use_passwd -> + 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 -> + 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%!" + address) + >>= fun () -> + respond_json cache address) + | Api.Change_password token when config.ServerData.use_passwd -> + 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 -> lwt_fail (`Not_found, "Unknown user.")) + | Api.Reset_password handle when config.ServerData.use_passwd -> + Token_index.UpgradeIndex.can_reset_password !sync_dir handle >>= + (function + | Some _token -> + 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 ["reset.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 "handle" -> + `Start_element ((e, "input"), (("", "value"), handle) :: 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 } + | None -> + lwt_fail (`Forbidden, "Nothing to do.")) + | Api.Do_reset_password body when config.ServerData.use_passwd -> + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + let handle = List.assoc "handle" params in + Token_index.UpgradeIndex.can_reset_password !sync_dir handle >>= + (function + | Some token -> + 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 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 () -> + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } + | None -> + lwt_fail (`Forbidden, "Nothing to do.")) + + | 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 _ -> + 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.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.emails_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 + 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) 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") @@ -519,15 +982,25 @@ 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 -> 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)); @@ -583,6 +1056,22 @@ let compress ?(level = 4) data = let launch () = Random.self_init () ; Learnocaml_store.Server.get () >>= fun config -> + 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.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.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 @@ -603,8 +1092,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 _ -> @@ -619,10 +1108,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 @@ -654,19 +1145,38 @@ 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 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 = !base_url; 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; host = !base_url; path; args} + else + lwt_fail (`Forbidden, "CSRF token mismatch") + | None, None | None, Some _ -> + lwt_ok {Api.meth = `POST params; host = !base_url; path; args} + | _, _ -> + lwt_fail (`Forbidden, "Bad CSRF token") end | _ -> lwt_fail (`Bad_request, "Unsupported method")) >?= (fun req -> @@ -683,6 +1193,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/dune b/src/state/dune index 2f37a386d..8174d7eaa 100644 --- a/src/state/dune +++ b/src/state/dune @@ -26,9 +26,16 @@ learnocaml_data) ) +(library + (name token_index) + (wrapped false) + (modules Token_index) + (libraries lwt lwt.unix lwt_utils learnocaml_api learnocaml_data cryptokit netstring safepass) +) + (library (name learnocaml_store) (wrapped false) (modules Learnocaml_store) - (libraries lwt_utils learnocaml_api) + (libraries token_index lwt_utils learnocaml_api) ) diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 63043e4c3..0294a5a58 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -21,6 +21,12 @@ type _ request = string * student token option * string option -> student token request | Create_teacher_token: teacher token -> teacher token request + | Create_user: + string * string * string * string -> unit request + | Login: + string * string -> student token request + | Can_login: + student token -> bool request | Fetch_save: 'a token -> Save.t request | Archive_zip: @@ -28,6 +34,14 @@ type _ request = | Update_save: 'a token * Save.t -> Save.t request | Git: 'a token * string list -> string request + | Launch: + string -> string request + | Launch_token: + string -> string request + | Launch_login: + string -> string request + | Launch_direct: + string -> string request | Students_list: teacher token -> Student.t list request @@ -66,12 +80,48 @@ 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 + | Abort_email_change: + Token.t -> unit request + | Confirm_email: + string -> string request + | Change_password: + 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: + string -> string 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 + | Upgrade: + string -> string request + | Server_config: + unit -> bool request + | Invalid_request: string -> string request type http_request = { meth: [ `GET | `POST of string]; + host: string; path: string list; args: (string * string) list; } @@ -104,7 +154,13 @@ module Conversions (Json: JSON_CODEC) = struct Token.(to_string, parse) | Create_teacher_token _ -> json J.(obj1 (req "token" string)) +> - Token.(to_string, parse) + Token.(to_string, parse) + | Create_user _ -> + json J.unit + | Login _ -> + json J.(obj1 (req "token" string)) +> + Token.(to_string, parse) + | Can_login _ -> json J.bool | Fetch_save _ -> json Save.enc | Archive_zip _ -> @@ -112,6 +168,10 @@ module Conversions (Json: JSON_CODEC) = struct | Update_save _ -> json Save.enc | Git _ -> str + | Launch _ -> str + | Launch_token _ -> str + | Launch_login _ -> str + | Launch_direct _ -> str | Students_list _ -> json (J.list Student.enc) | Set_students_list _ -> @@ -145,6 +205,22 @@ module Conversions (Json: JSON_CODEC) = struct | Partition _ -> json Partition.enc + | 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 + | Reset_password _ -> str + | Do_reset_password _ -> str + + | Get_emails _ -> json J.(option (tup2 string (option string))) + + | Upgrade_form _ -> str + | Upgrade _ -> str + + | Server_config () -> json J.bool + | Invalid_request _ -> str @@ -157,13 +233,15 @@ 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 = { + let post ?token path body = { meth = `POST body; + host = ""; path; - args = ["token", Token.to_string token]; + args = match token with None -> [] | Some t -> ["token", Token.to_string t]; } in function | Static path -> @@ -173,12 +251,22 @@ module Conversions (Json: JSON_CODEC) = struct | Nonce () -> get ["nonce"] - | Create_token (secret_candiate, token, nick) -> - get ?token (["sync"; "new"; secret_candiate] @ + | Create_token (secret_candidate, token, nick) -> + get ?token (["sync"; "new"; secret_candidate] @ (match nick with None -> [] | Some n -> [n])) | Create_teacher_token token -> assert (Token.is_teacher token); get ~token ["teacher"; "new"] + | Create_user (email, nick, passwd, secret_candidate) -> + post (["sync"; "new_user"]) + (Json.encode + J.(tup4 string string string string) + (email, nick, passwd, secret_candidate)) + | Login (nick, passwd) -> + post (["sync"; "login"]) + (Json.encode J.(tup2 string string) (nick, passwd)) + | Can_login token -> + get ~token ["sync"; "canlogin"] | Fetch_save token -> get ~token ["save.json"] @@ -187,7 +275,15 @@ 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_token _ -> + assert false (* Reserved for an LTI application *) + | Launch_login _ -> + assert false (* Reserved for an LTI application *) + | Launch_direct _ -> + assert false (* Reserved for an LTI application *) | Students_list token -> assert (Token.is_teacher token); @@ -248,6 +344,34 @@ 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) + | Abort_email_change token -> + post ~token ["abort_email_change"] "" + | Confirm_email _ -> + assert false (* Reserved for a link *) + | 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 _ -> + assert false (* Reserved for a link *) + + | Get_emails token -> + get ~token ["get_emails"] + + | Upgrade_form _ -> + assert false (* Reserved for a link *) + | Upgrade body -> + post ["do_upgrade"] body + + | Server_config () -> + get ["get_server_config"] + | Invalid_request s -> failwith ("Error request "^s) @@ -258,7 +382,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 @@ -270,7 +394,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 @@ -293,6 +417,18 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct Create_token (secret_candidate, token, Some nick) |> k | `GET, ["teacher"; "new"], Some token when Token.is_teacher token -> Create_teacher_token token |> k + | `POST body, ["sync"; "new_user"], _ -> + (match Json.decode J.(tup4 string string string string) body with + | email, nick, password, secret -> + Create_user (email, nick, password, secret) |> k + | exception e -> Invalid_request (Printexc.to_string e) |> k) + | `POST body, ["sync"; "login"], _ -> + (match Json.decode J.(tup2 string string) body with + | nick, password -> Login (nick, password) |> k + | exception e -> Invalid_request (Printexc.to_string e) |> k) + + | `GET, ["sync"; "canlogin"], Some token -> + Can_login token |> k | `GET, ["save.json"], Some token -> Fetch_save token |> k @@ -344,7 +480,20 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct Static ["exercise.html"] |> k | _ -> Static ("static"::path) |> k) - | `GET, ("description"::_), _token -> + + | `POST body, ["launch"], _token -> + Launch body |> k + + | `POST body, ["launch"; "token"], _ -> + Launch_token body |> k + + | `POST body, ["launch"; "login"], _token -> + Launch_login body |> k + + | `POST body, ["launch"; "direct"], _ -> + Launch_direct body |> k + + | `GET, ("description"::_path), _token -> (* match token with | None -> Invalid_request "Missing token" |> k *) Static ["description.html"] |> k @@ -378,6 +527,38 @@ 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 + | 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"], _ -> + (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, ["get_emails"], Some token -> + Get_emails token |> k + + | `POST body, ["upgrade"], _ -> + Upgrade_form body |> k + | `POST body, ["do_upgrade"], _ -> + Upgrade body |> k + + | `GET, ["get_server_config"], _ -> + Server_config () |> k + | `GET, ["teacher"; "exercise-status.json"], Some token when Token.is_teacher token -> Exercise_status_index token |> k @@ -401,6 +582,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/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index b51db4eb2..2374af3cc 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -34,6 +34,12 @@ type _ request = string * student token option * string option -> student token request | Create_teacher_token: teacher token -> teacher token request + | Create_user: + string * string * string * string -> unit request + | Login: + string * string -> student token request + | Can_login: + student token -> bool request | Fetch_save: 'a token -> Save.t request | Archive_zip: @@ -42,6 +48,14 @@ type _ request = 'a token * Save.t -> Save.t request | Git: 'a token * string list -> string request + | Launch: + string -> string request + | Launch_token: + string -> string request + | Launch_login: + string -> string request + | Launch_direct: + string -> string request | Students_list: teacher token -> Student.t list request @@ -85,6 +99,36 @@ 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 + | Abort_email_change: + Token.t -> unit request + | Confirm_email: + string -> string request + | Change_password: + 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: + string -> string request + + | Get_emails: + Token.t -> (string * string option) option request + + | Upgrade_form: + string -> string 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 @@ -92,6 +136,7 @@ type _ request = type http_request = { meth: [ `GET | `POST of string]; + host: string; path: string list; args: (string * string) list; } @@ -107,7 +152,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 diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 39ce6f6d0..d95d0067b 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -6,6 +6,39 @@ * 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]\\)?\\)+$" +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 @@ -376,18 +409,39 @@ let enc_check_version_2 enc = module Server = struct type preconfig = { secret : string option; + use_moodle : bool; + use_passwd : bool; } let empty_preconfig = { secret = None; - } + use_moodle = false; + use_passwd = false; + } + + let bool_of_option = function + | 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) - (fun secret : preconfig -> {secret}) @@ - J.obj1 (J.opt "secret" J.string) + J.conv (fun (c : preconfig) -> + (c.secret, Some(c.use_moodle), Some(c.use_passwd))) + (fun (secret, use_moodle, use_passwd) -> + {secret; + 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" errorable_bool) + (J.opt "use_passwd" errorable_bool) type config = { secret : string option; + use_moodle : bool; + use_passwd : bool; server_id : int; } @@ -398,13 +452,23 @@ module Server = struct let server_id = Random.bits () in { secret; + use_moodle = preconf.use_moodle; + use_passwd = preconf.use_passwd; server_id; } let config_enc = - J.conv (fun (c : config) -> (c.secret,c.server_id)) - (fun (secret,server_id) : config -> {secret; server_id}) @@ - J.obj2 (J.opt "secret" J.string) (J.req "server_id" J.int) + J.conv (fun (c : config) -> + (c.secret, Some(c.use_moodle), Some(c.use_passwd), c.server_id)) + (fun (secret, use_moodle, use_passwd, server_id) -> + {secret; + use_moodle = bool_of_option use_moodle; + use_passwd = bool_of_option use_passwd; + server_id}) @@ + J.obj4 (J.opt "secret" J.string) + (J.opt "use_moodle" errorable_bool) + (J.opt "use_passwd" errorable_bool) + (J.req "server_id" J.int) end module Exercise = struct diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index 2408c5eec..7f6786e8e 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -6,6 +6,25 @@ * 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 + +(** "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 @@ -125,6 +144,8 @@ module Server : sig where users can pre-set some of the server settings. *) type preconfig = { secret : string option; + use_moodle : bool; + use_passwd : bool; } val empty_preconfig : preconfig @@ -132,6 +153,8 @@ module Server : sig from the preconfig during the 'build' stage. *) type config = { secret : string option; (* maybe a secret *) + use_moodle : bool; + use_passwd : bool; server_id : int; (* random integer generated each building time *) } diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 20ca030e1..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 () + 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,32 +365,7 @@ 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 - ) "" [] + 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 new file mode 100644 index 000000000..3b2935aa8 --- /dev/null +++ b/src/state/token_index.ml @@ -0,0 +1,601 @@ +(* 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 + +let ( / ) dir f = if dir = "" then f else Filename.concat dir f +let indexes_subdir = "data" + +let logfailwith str arg = + Printf.printf "[ERROR] %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 () + +module J = Json_encoding + +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 -> "" + | `Bool v -> string_of_bool v + | _ -> assert false +end + +module type IndexRW = sig + type t + + val init : unit -> t + val read : t -> 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 + + (* Unlocked by default *) + let init = Lwt_mutex.create + + 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.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 *) +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 = enc_check_version_1 file @@ J.list Token.enc + + let parse = Json_codec.decode enc + 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 = + let found_indexes = + let rec scan f d acc = + let rec aux s acc = + Lwt.catch (fun () -> + Lwt_stream.get s >>= function + | Some ("." | ".." | "data") -> 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 (sync_dir / 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 + ) "" [] in + 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 = + let filename = (sync_dir / indexes_subdir / name) in + let create () = + create_index sync_dir >>= fun () -> + RW.read rw filename parse in + if Sys.file_exists filename then + Lwt.catch + (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 + 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 -> + 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) + +module BaseMoodleIndex (RW: IndexRW) = struct + let rw = RW.init () + let file = "moodle_user.json" + + 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 + + let create_index sync_dir = + RW.write rw (sync_dir / indexes_subdir / file) serialise [] + + let get_users sync_dir = + Lwt.catch + (fun () -> RW.read rw (sync_dir / indexes_subdir / file) parse) + (fun _exn -> Lwt.return []) + + let user_exists sync_dir id = + 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 + Lwt.return () + else + let users = (id, token) :: users in + RW.write rw (sync_dir / indexes_subdir / 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) + +module BaseOauthIndex (RW: IndexRW) = struct + let rw = RW.init () + let file = "oauth.json" + + 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 + + let create_index sync_dir = + let secret = generate_random_hex 32 in + RW.write rw (sync_dir / indexes_subdir / 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 rw (sync_dir / indexes_subdir / 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 / indexes_subdir / file) serialise [oauth] + + let add_nonce sync_dir nonce = + RW.read rw (sync_dir / indexes_subdir / file) parse >>= fun oauth -> + let oauth = + match oauth with + | (secret, nonces) :: r -> (secret, nonce :: nonces) :: r + | [] -> [(generate_random_hex 32, [nonce])] in + RW.write rw (sync_dir / indexes_subdir / 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) + +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 result = Cryptokit.hash_string hash signature_base_string in + 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") + +(** 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) + +type authentication = + | AuthToken of Token.t + | Passwd of (string * string) + +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)]). + + 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 = + enc_check_version_1 file + @@ J.( + list (union [case (tup2 Token.enc bool) + (function + | Token (token, using_moodle) -> Some (token, using_moodle) + | _ -> None) + (fun (token, using_moodle) -> Token (token, using_moodle)); + case (tup4 Token.enc string string (option string)) + (function + | Password (token, email, passwd, verify_email) -> + Some (token, email, passwd, verify_email) + | _ -> None) + (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 + + let token_list_to_users = + List.map (fun token -> Token (token, false)) + + 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 rw (sync_dir / indexes_subdir / file) parse) + (fun _exn -> create_index sync_dir) + + let authenticate sync_dir auth = + get_data sync_dir >|= + List.fold_left (fun res elt -> + if res = None then + match auth, elt with + | 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) + | _ -> + None + else res) None + + let exists sync_dir email = + get_data sync_dir >|= + List.exists (function + | Password (_token, found_email, _passwd, None) -> found_email = email + | Password (_token, found_email, _passwd, Some verify_email) -> + 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 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 + (token, Password (token, email, hash, verify_email)) in + if exists_token token users then + logfailwith "BaseUserIndex.add: duplicate token" (Token.to_string token) + else + RW.write rw (sync_dir / indexes_subdir / file) serialise (new_user :: users) + + let update sync_dir token passwd = + get_data sync_dir >|= + List.map (function + | Token (found_token, _use_moodle) when found_token = token -> + 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) + | 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 -> + 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 + logfailwith "BaseUserIndex.upgrade: duplicate email" 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, email, hash, Some(email)) + | Password (found_token, _email, _passwd, _verify) + when found_token = token -> + logfailwith "BaseUserIndex.upgrade: invalid action" (Token.to_string token) + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise + + let confirm_email sync_dir token = + get_data sync_dir >|= + List.map (function + | 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 + + 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, 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 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 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 -> + Some (email, pending) + | _ -> res) None + + let change_email sync_dir token new_email = + (exists sync_dir new_email >|= fun exists -> + if exists then + logfailwith "BaseUserIndex.change_email: duplicate email" new_email) + >>= fun () -> + 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) + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise + + let abort_email_change sync_dir token = + 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 -> + Password (found_token, email, passwd, None) + | Token (found_token, _moodle) when found_token = token -> + logfailwith "BaseUserIndex.abort_email_change: invalid action" (Token.to_string token) + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise +end + +module UserIndex = BaseUserIndex (IndexFile) + +module BaseUpgradeIndex (RW: IndexRW) = struct + let rw = RW.init () + let file = "upgrade.json" + + type t = + | ChangeEmail + | ResetPassword + + let enc = + enc_check_version_1 file + @@ J.( + 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 + + let create_index sync_dir = + RW.write rw (sync_dir / indexes_subdir / file) serialise [] >|= fun () -> + [] + + let get_data sync_dir = + Lwt.catch + (fun () -> RW.read rw (sync_dir / indexes_subdir / file) parse) + (fun _exn -> create_index sync_dir) + + let create_upgrade_operation kind sync_dir token = + get_data sync_dir >>= fun operations -> + let id = generate_random_hex 32 in + (id, (token, Unix.time (), kind)) :: operations + |> RW.write rw (sync_dir / indexes_subdir / file) serialise >|= fun () -> + id + + let change_email = create_upgrade_operation ChangeEmail + let reset_password = create_upgrade_operation ResetPassword + + let check_upgrade_operation kind sync_dir handle = + get_data sync_dir >|= fun operations -> + (* 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 + | Some (token, _date, ChangeEmail) when kind = ChangeEmail -> Some token + | _ -> None + + 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 :: _ -> + 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 = + 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) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise + + let filter_old_operations sync_dir = + get_data sync_dir >>= fun operations -> + (* 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 + |> 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 new file mode 100644 index 000000000..e562c3f68 --- /dev/null +++ b/src/state/token_index.mli @@ -0,0 +1,120 @@ +(* 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. *) + +(** Used both for file i/o and request handling *) +module Json_codec: Learnocaml_api.JSON_CODEC + +module type IndexRW = sig + type t + + val init : unit -> t + val read : t -> 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 + +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 + val token_exists : string -> Learnocaml_data.Token.t -> 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 + +val check_oauth : string -> string -> (string * string) list -> (string, string) result Lwt.t + +type user = + | Token of (Learnocaml_data.Token.t * bool) + | Password of (Learnocaml_data.Token.t * string * string * string option) + +type authentication = + | AuthToken of Learnocaml_data.Token.t + | Passwd of (string * string) + +module UserIndex: sig + + (* 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 + + (** 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 + + (** 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 : + ?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: + * [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 + val abort_email_change : string -> Learnocaml_data.Token.t -> unit Lwt.t +end + +module UpgradeIndex: sig + (* returns a handle *) + 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 + + 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/src/utils/dune b/src/utils/dune index 51daffeac..5ba9f5bfc 100644 --- a/src/utils/dune +++ b/src/utils/dune @@ -55,4 +55,12 @@ (flags :standard -warn-error A-4-42-44-45-48) (libraries asak lwt learnocaml_store learnocaml_data) (modules learnocaml_partition_create) -) \ No newline at end of file +) + +(library + (name learnocaml_sendmail) + (wrapped false) + (flags :standard -warn-error A-4-42-44-45-48) + (libraries threads netstring) + (modules learnocaml_sendmail) +) 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 diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml new file mode 100644 index 000000000..60aa02483 --- /dev/null +++ b/src/utils/learnocaml_sendmail.ml @@ -0,0 +1,190 @@ +(* -*- coding: utf-8-unix; -*- *) +(* 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 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 + | None -> None + | Some _ -> + match Sys.getenv_opt "EMAIL" with + | None -> None + | Some email -> Some email + +(* 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, +|} + +let confirm : (string -> string, unit, string) format = + {| +Please follow the link below to confirm your e-mail address: + +%s +|} + +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 = + {| +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). +|} + +let change_new : (string -> string, unit, string) format = + {| +Please follow the link below to confirm this change: + +%s +|} + +let reset : (string -> string, unit, string) format = + {| +Someone (probably you) requested changing your Learn-OCaml password. + +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" + +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 = + Printf.sprintf link_format url (encode_html_utf8 url) + +let wrap_html ~title text = + let lines = Str.global_replace (Str.regexp "$") "
" text in + Printf.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 | Some "" -> "", "" + | 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_html = + wrap_html ~title:subject + (Printf.sprintf hello (padding ^ nickname) + ^ pretext + ^ Printf.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 + (* 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 = + 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 ("mailto:" ^ 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 new file mode 100644 index 000000000..988723d7e --- /dev/null +++ b/src/utils/learnocaml_sendmail.mli @@ -0,0 +1,19 @@ +(* 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. *) + +(** [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 ~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 ~nick ~url addr] helps users change their password. *) +val reset_password: nick:string option -> url:string -> string -> unit diff --git a/src/utils/lwt_utils.ml b/src/utils/lwt_utils.ml index 0fe27a22c..959c2f08d 100644 --- a/src/utils/lwt_utils.ml +++ b/src/utils/lwt_utils.ml @@ -8,10 +8,19 @@ open Lwt.Infix +let is_directory path = + Lwt.catch + (fun () -> + Lwt_unix.lstat path >|= function + | Lwt_unix.{st_kind=S_DIR; _} -> true + | _ -> false) + (fun _exn -> Lwt.return_false) + let rec mkdir_p ?(perm=0o755) dir = Lwt_unix.file_exists dir >>= function | true -> - if Sys.is_directory dir then + is_directory dir >>= fun is_directory -> + if is_directory then Lwt.return () else Lwt.fail_with diff --git a/src/utils/lwt_utils.mli b/src/utils/lwt_utils.mli index 11eecd091..3cee419f6 100644 --- a/src/utils/lwt_utils.mli +++ b/src/utils/lwt_utils.mli @@ -6,6 +6,7 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) +val is_directory: string -> bool Lwt.t val mkdir_p: ?perm:int -> string -> unit Lwt.t (** [copy_tree src dst] copies the file [src] into file [dst] *) diff --git a/static/css/learnocaml_main.css b/static/css/learnocaml_main.css index 54cf03a26..cdda05ea7 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; @@ -917,11 +917,14 @@ body { z-index: 22220; overflow: auto; } +#login-overlay > div > span { + text-align: center; +} div#login-overlay > h1 { text-align: center; margin-bottom: 50px; } -#login-new, #login-returning { +#login-new-token, #login-new, #login-returning, #login-token, #login-direct { margin: 30px auto; background-color: #666; border-radius: 3px; @@ -931,7 +934,7 @@ div#login-overlay > h1 { flex-direction: column; } @media (min-width: 1000px) { - #login-new, #login-returning { + #login-new-token, #login-new, #login-returning, #login-token, #login-direct { width: 30vw; } } @@ -946,12 +949,12 @@ div#login-overlay > h1 { color: black; border-radius: 3px 3px 0 0; } -#login-new > div, #login-returning > 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 > div > div, #login-returning > 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 { @@ -980,6 +983,11 @@ div#login-overlay button { min-width: 10em; } +div#login-overlay a { + color: #9bd; + text-align: center; +} + #logout-overlay { display: none; position: fixed; @@ -1061,3 +1069,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 b574371b6..0af08be94 100644 --- a/static/index.html +++ b/static/index.html @@ -44,6 +44,15 @@

Activities

-->
+
+
+
+
+ + +
+
+
@@ -66,34 +75,86 @@

Activities

-

-
-

+

+
+

-
+
-
-
- +

-
+
+
+ +
+
+
+
+ +
+ + +
+ +
+
+

+
+
+
+ +
+
+
+
+ +
+
+
+
+ +
+
+
+
+ +
+
+
- + +
+
+ + +
+ +
+
+

+
+
+
+
- +
diff --git a/static/lti.html b/static/lti.html new file mode 100644 index 000000000..5597f3063 --- /dev/null +++ b/static/lti.html @@ -0,0 +1,111 @@ + + + + + Learn OCaml + + + + + + + + +
+
+
+

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

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

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

+
+
+
+ +
+
+
+
+ +
+ + + +
+ +
+ +
+
+
+ + diff --git a/static/reset.html b/static/reset.html new file mode 100644 index 000000000..fb9a92abd --- /dev/null +++ b/static/reset.html @@ -0,0 +1,40 @@ + + + + + Learn OCaml + + + + + + + + +
+
+
+

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

+
+
+
+
+ +
+
+
+
+ +
+
+
+
+ +
+
    +
    • +
    • +
+ + + +
+
+ + 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 + + + + + + + + diff --git a/translations/fr.po b/translations/fr.po index 9b1fdb7b1..4fd65d56d 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,305 +5,273 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-01-01 19:29+0100\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" "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:69,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:108,50--54 +#: 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:133,21--28 +#: 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: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:824,29--36 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: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: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:814,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:419,26--41 +#: 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:809,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:420,22--59 +#: 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:810,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:423,12--19 +#: src/app/learnocaml_common.ml:463,11--18 +#: 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:813,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:426,25--33 +#: src/app/learnocaml_common.ml:464,11--19 msgid "Ignore" msgstr "Ignorer" -#: src/app/learnocaml_common.ml:446,26--39 +#: src/app/learnocaml_common.ml:459,26--39 msgid "SYNC FAILED" msgstr "ECHEC DE LA SYNCHRONISATION" -#: src/app/learnocaml_common.ml:447,25--69 +#: 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:499,39--50 +#: src/app/learnocaml_common.ml:519,39--50 msgid "%dd %02dh" msgstr "%dj %02dh" -#: src/app/learnocaml_common.ml:500,40--51 +#: src/app/learnocaml_common.ml:520,40--51 msgid "%02d:%02d" msgstr "%02d:%02d" -#: src/app/learnocaml_common.ml:501,23--36 +#: src/app/learnocaml_common.ml:521,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:552,34--55 +#: src/app/learnocaml_common.ml:1039,38--59 msgid "difficulty: %d / 40" msgstr "difficulté: %d / 40" -#: src/app/learnocaml_common.ml:567,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:589,32--41 -#: src/app/learnocaml_index_main.ml:123,57--66 +#: 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:590,32--41 -#: src/app/learnocaml_index_main.ml:124,57--66 +#: 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:591,33--43 -#: src/app/learnocaml_index_main.ml:125,58--68 +#: 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:743,26--33 +#: src/app/learnocaml_common.ml:764,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:769,25--32 +#: src/app/learnocaml_common.ml:890,24--31 msgid "Reset" msgstr "Réinitialiser" -#: src/app/learnocaml_common.ml:753,22--35 +#: src/app/learnocaml_common.ml:774,22--35 msgid "Eval phrase" msgstr "Évaluer la phrase" -#: src/app/learnocaml_common.ml:768,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:769,39--47 -#: src/app/learnocaml_common.ml:774,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:770,41--51 -#: src/app/learnocaml_index_main.ml:692,30--40 +#: src/app/learnocaml_common.ml:791,41--51 +#: src/app/learnocaml_index_main.ml:1055,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: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 +#: 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:793,37--47 msgid "Exercise" msgstr "Exercice" -#: src/app/learnocaml_common.ml:773,37--46 +#: src/app/learnocaml_common.ml:794,37--46 msgid "Details" msgstr "Détails" -#: src/app/learnocaml_common.ml:775,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:780,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:781,38--45 +#: src/app/learnocaml_common.ml:802,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:803,37--48 +#: src/app/learnocaml_exercise_main.ml:200,23--34 +#: src/app/learnocaml_index_main.ml:1052,29--40 +#: 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:805,37--46 msgid "Subject" msgstr "Énoncé" -#: src/app/learnocaml_common.ml:785,39--47 +#: src/app/learnocaml_common.ml:806,39--47 msgid "Answer" msgstr "Réponse" -#: src/app/learnocaml_common.ml:870,22--42 +#: src/app/learnocaml_common.ml:891,22--42 msgid "START FROM SCRATCH" msgstr "TOUT RECOMMENCER" -#: src/app/learnocaml_common.ml:871,19--68 +#: 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:878,27--37 +#: src/app/learnocaml_common.ml:899,27--37 msgid "Download" msgstr "Télécharger" -#: src/app/learnocaml_common.ml:886,22--33 +#: src/app/learnocaml_common.ml:907,22--33 msgid "Eval code" msgstr "Évaluer le code" -#: src/app/learnocaml_common.ml:893,23--29 +#: src/app/learnocaml_common.ml:914,23--29 msgid "Sync" msgstr "Sync" -#: src/app/learnocaml_common.ml:946,37--52 +#: src/app/learnocaml_common.ml:967,34--49 msgid "OCaml prelude" msgstr "Prélude OCaml" -#: src/app/learnocaml_common.ml:953,62--68 +#: src/app/learnocaml_common.ml:974,59--65 msgid "Hide" msgstr "Cacher" -#: src/app/learnocaml_common.ml:960,62--68 +#: src/app/learnocaml_common.ml:981,59--65 msgid "Show" msgstr "Montrer" -#: src/app/learnocaml_common.ml:981,19--37 +#: src/app/learnocaml_common.ml:1005,18--36 +#: src/app/learnocaml_index_main.ml:911,27--45 msgid "Enter the secret" msgstr "Entrez le secret" -#: src/app/learnocaml_common.ml:1021,25--38 +#: src/app/learnocaml_common.ml:1045,22--35 msgid "Difficulty:" msgstr "Difficulté :" -#: src/app/learnocaml_common.ml:1035,42--52 +#: src/app/learnocaml_common.ml:1059,39--49 msgid "Kind: %s" msgstr "Type : %s" -#: src/app/learnocaml_common.ml:1176,46--59 +#: src/app/learnocaml_common.ml:1200,46--59 msgid "Identifier:" msgstr "Identifiant de l'exercice :" -#: src/app/learnocaml_common.ml:1180,48--57 +#: src/app/learnocaml_common.ml:1204,48--57 msgid "Author:" msgstr "Auteur :" -#: src/app/learnocaml_common.ml:1181,47--57 +#: src/app/learnocaml_common.ml:1205,47--57 msgid "Authors:" msgstr "Auteurs :" -#: src/app/learnocaml_common.ml:1186,31--48 +#: src/app/learnocaml_common.ml:1210,31--48 msgid "Skills trained:" msgstr "Compétences pratiquées :" -#: src/app/learnocaml_common.ml:1190,31--49 +#: src/app/learnocaml_common.ml:1214,31--49 msgid "Skills required:" msgstr "Compétences requises :" -#: src/app/learnocaml_common.ml:1195,36--57 +#: src/app/learnocaml_common.ml:1219,36--57 msgid "Previous exercises:" msgstr "Exercices précédents :" -#: src/app/learnocaml_common.ml:1198,35--52 +#: src/app/learnocaml_common.ml:1222,35--52 msgid "Next exercises:" msgstr "Exercices suivants :" -#: src/app/learnocaml_common.ml:1203,29--39 +#: src/app/learnocaml_common.ml:1227,26--36 msgid "Metadata" msgstr "Métadonnées" @@ -315,36 +283,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 +320,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 +362,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: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:25,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:27,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!" +msgstr "Je sais le faire moi-même !" -#: src/app/learnocaml_exercise_main.ml:28,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 " @@ -417,11 +385,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:90,18--29 msgid "TIME'S UP" msgstr "TEMPS ÉCOULÉ" -#: src/app/learnocaml_exercise_main.ml:86,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." @@ -429,58 +397,59 @@ 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: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:128,41--59 -#: src/app/learnocaml_playground_main.ml:43,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:207,28--37 -#: src/app/learnocaml_playground_main.ml:77,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:211,25--33 +#: src/app/learnocaml_exercise_main.ml:216,29--37 msgid "Grade!" msgstr "Noter!" -#: src/app/learnocaml_exercise_main.ml:216,51--58 +#: src/app/learnocaml_exercise_main.ml:220,48--55 msgid "abort" msgstr "abandonner" -#: src/app/learnocaml_exercise_main.ml:220,38--73 +#: 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:226,38--60 +#: src/app/learnocaml_exercise_main.ml:230,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:253,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:274,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: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:49,17--44 +#: 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: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 +457,202 @@ 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" +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:824,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: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:728,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:117,21--42 +#: 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: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: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: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: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: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:917,38--46 +msgid "Secret" +msgstr "Secret" + +#: src/app/learnocaml_lti_main.ml:135,29--198 +#: 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." +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:138,41--251 +#: 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." +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:141,26--46 +#: 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: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: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: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:910,44--63 +msgid "Choose a nickname" +msgstr "Choisissez un identifiant" + +#: 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: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)" +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:933,30--37 +#: src/app/learnocaml_teacher_tab.ml:559,22--29 +msgid "Token" +msgstr "Token" -#: src/app/learnocaml_index_main.ml:64,18--37 +#: src/app/learnocaml_index_main.ml:88,18--37 msgid "Loading exercises" msgstr "Chargement des exercices" -#: src/app/learnocaml_index_main.ml:97,32--49 +#: src/app/learnocaml_index_main.ml:121,32--49 msgid "Exercise closed" msgstr "Exercice fermé" -#: src/app/learnocaml_index_main.ml:98,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:145,31--64 +#: 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:152,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:178,18--35 +#: src/app/learnocaml_index_main.ml:202,18--35 msgid "Loading lessons" msgstr "Chargement des cours" -#: src/app/learnocaml_index_main.ml:211,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:252,39--45 -#: src/app/learnocaml_index_main.ml:441,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:268,40--46 -#: src/app/learnocaml_index_main.ml:458,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:325,18--37 +#: src/app/learnocaml_index_main.ml:349,18--37 msgid "Loading tutorials" msgstr "Chargement des tutoriels" -#: src/app/learnocaml_index_main.ml:491,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:504,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:524,22--46 +#: 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:525,21--147 +#: 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." @@ -554,90 +660,187 @@ 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:578,24--47 msgid "Please write it down." msgstr "Notez-le !" -#: src/app/learnocaml_index_main.ml:565,28--45 +#: 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:585,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:590,29--52 +msgid "No e-mail registered." +msgstr "Pas d'e-mail enregistré." + +#: 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:594,63--82 +#: src/app/learnocaml_index_main.ml:597,67--86 +msgid "(to be confirmed)" +msgstr "(à confirmer)" + +#: src/app/learnocaml_index_main.ml:597,22--39 +msgid "Pending change:" +msgstr "Changement en cours :" + +#: 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: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:611,41--82 +msgid "" +"\n" +"(if it is associated with an account)" +msgstr "" +"\n" +"(si elle est associée à un compte)" + +#: 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: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:658,12--45 +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:805,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:566,17--60 -msgid "The entered token couldn't be recognised." +#: src/app/learnocaml_index_main.ml:769,17--60 +#: 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." -#: src/app/learnocaml_index_main.ml:620,7--21 +#: src/app/learnocaml_index_main.ml:791,26--41 +msgid "INVALID TOKEN" +msgstr "TOKEN INVALIDE" + +#: src/app/learnocaml_index_main.ml:792,31--244 +#, fuzzy +msgid "" +"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:796,54--70 +msgid " or Moodle/LTI" +msgstr " ou avec Moodle/LTI" + +#: src/app/learnocaml_index_main.ml:904,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:906,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:624,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:625,31--49 -msgid "First connection" -msgstr "Première connexion" - -#: src/app/learnocaml_index_main.ml:626,38--57 -msgid "Choose a nickname" -msgstr "Choisissez un identifiant" - -#: src/app/learnocaml_index_main.ml:627,38--46 -msgid "Secret" -msgstr "Secret" - -#: src/app/learnocaml_index_main.ml:628,24--42 +#: src/app/learnocaml_index_main.ml:912,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_index_main.ml:629,24--40 -msgid "Returning user" -msgstr "Utilisateur existant" +#: 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:630,31--49 -msgid "Enter your token" -msgstr "Entrez votre token" +#: 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:631,31--40 -msgid "Connect" -msgstr "Se connecter" +#: 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: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: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:676,41--62 +#: src/app/learnocaml_index_main.ml:982,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:1008,31--51 +msgid "New e-mail address" +msgstr "Nouvelle adresse e-mail" + +#: 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: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:1028,20--41 +msgid "Abort e-mail change" +msgstr "Annuler le changement d'e-mail" + +#: 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:1048,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:687,29--38 +#: src/app/learnocaml_index_main.ml:1050,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:1057,32--44 +#: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:697,28--35 +#: src/app/learnocaml_index_main.ml:1060,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:795,15--69 +#: 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:797,15--186 +#: 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: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." @@ -646,229 +849,325 @@ 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: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:814,9--21 +#: src/app/learnocaml_index_main.ml:1188,15--27 +msgid "Show login" +msgstr "Afficher votre login" + +#: src/app/learnocaml_index_main.ml:1189,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:817,9--25 +#: src/app/learnocaml_index_main.ml:1191,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:820,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:821,9--17 +#: src/app/learnocaml_index_main.ml:1195,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:822,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:828,38--44 +#: src/app/learnocaml_index_main.ml:1202,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" "\n" "write it down." msgstr "" -"Nouveau token prof. créé:\n" +"Nouveau token prof. créé :\n" "%s\n" "\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:24,29--45 +msgid "Reset password" +msgstr "Réinitialiser le mot de passe" + +#: src/app/learnocaml_reset_main.ml:25,27--41 +msgid "New password" +msgstr "Nouveau mot de passe" + +#: src/app/learnocaml_reset_main.ml:26,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: " +msgstr "Suivi étudiant : " + +#: src/app/learnocaml_upgrade_main.ml:28,29--38 +msgid "Upgrade" +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." +msgstr "Un courriel sera envoyé à votre adresse pour la confirmer." + +#: src/app/learnocaml_upgrade_main.ml:32,38--48 +msgid "NO TOKEN" +msgstr "PAS DE TOKEN" + +#: src/app/learnocaml_upgrade_main.ml:32,53--76 +msgid "You are not logged in" +msgstr "Vous n'êtes pas connecté" + +#: 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)" +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 "" @@ -929,18 +1228,28 @@ 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 "Create account" +#~ msgstr "Créer un compte" -msgid "Failed to download archive. Please try again later!" -msgstr "" -"Le téléchargement de l'archive a échoué. Veuillez réessayer " -"ulterieurement!" +#, fuzzy +#~ msgid "USER NOT FOUND" +#~ msgstr "UTILISATEUR NON TROUVÉ" + +#~ 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 "No description available." #~ msgstr "Aucune description." @@ -1020,9 +1329,6 @@ msgstr "" #~ msgid "Remove tags" #~ msgstr "Retirer les tags" -#~ msgid "INVALID NICKNAME" -#~ msgstr "PSEUDONYME INVALIDE" - #~ msgid "You must provide a nickname" #~ msgstr "Un pseudonyme est requis" @@ -1034,4 +1340,3 @@ msgstr "" #~ msgid "This session has been closed. You can close this tab." #~ msgstr "La session a été fermée. Vous pouvez fermer cet onglet." -