Maj terminée. Pour consulter la release notes associée voici le lien :
https://about.gitlab.com/releases/2021/07/07/critical-security-release-gitlab-14-0-4-released/

web_site.ml 4.79 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1 2 3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2014 Inria                                           *)
Stephane Glondu's avatar
Stephane Glondu committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

22
open Lwt
Stephane Glondu's avatar
Stephane Glondu committed
23
open Util
24
open Serializable_t
25
open Signatures
Stephane Glondu's avatar
Stephane Glondu committed
26
open Web_serializable_j
27
open Web_common
28
open Web_signatures
Stephane Glondu's avatar
Stephane Glondu committed
29

30 31 32 33
module type CONFIG = sig
  val name : string
  val path : string list
  val source_file : string
34
  val instances : Web_auth.auth_instance list
35
end
Stephane Glondu's avatar
Stephane Glondu committed
36

37
module Make (C : CONFIG) : SITE_SERVICES = struct
38
  open Eliom_service
Stephane Glondu's avatar
Stephane Glondu committed
39 40
  open Eliom_registration

41 42
  let make_path x = C.path @ x

43
  module Auth = Web_auth.Make (C)
Stephane Glondu's avatar
Stephane Glondu committed
44 45 46 47 48 49 50

  let main_election = ref None
  let featured = ref []

  (* The following reference is there to cut a dependency loop:
     S.register_election depends on S (via Templates). It will be set
     to a proper value once we have called Templates.Make. *)
51

Stephane Glondu's avatar
Stephane Glondu committed
52 53 54 55 56 57 58 59
  let register_election_ref = ref (fun _ -> assert false)

  (* We use an intermediate module S that will be passed to Templates
     and Web_election. S is not meant to leak and will be included
     in the returned module later. *)

  module S : SITE_SERVICES = struct
    include Auth.Services
Stephane Glondu's avatar
Stephane Glondu committed
60 61 62
    open Eliom_parameter

    let home = service
63
      ~path:(make_path [""])
Stephane Glondu's avatar
Stephane Glondu committed
64
      ~get_params:unit
65 66
      ()

Stephane Glondu's avatar
Stephane Glondu committed
67
    let source_code = service
68
      ~path:(make_path ["belenios.tar.gz"])
Stephane Glondu's avatar
Stephane Glondu committed
69 70 71 72
      ~get_params:unit
      ()

    let get_randomness = service
73
      ~path:(make_path ["get-randomness"])
Stephane Glondu's avatar
Stephane Glondu committed
74 75 76
      ~get_params:unit
      ()

77 78 79 80
    let saved_service = Eliom_reference.eref
      ~scope:Eliom_common.default_session_scope
      (module struct let s = home end : SAVED_SERVICE)

81 82 83 84 85
    let cont () =
      lwt x = Eliom_reference.get saved_service in
      let module X = (val x : SAVED_SERVICE) in
      return X.s

86 87 88 89 90
    let register_election config = !register_election_ref config

    let set_main_election x = main_election := Some x
    let unset_main_election () = main_election := None

Stephane Glondu's avatar
Stephane Glondu committed
91 92
  end

Stephane Glondu's avatar
Stephane Glondu committed
93 94
  include S

95
  module T = Web_templates.Make (S)
Stephane Glondu's avatar
Stephane Glondu committed
96

Stephane Glondu's avatar
Stephane Glondu committed
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
  let () = register_election_ref := fun config ->
    let registration = Web_election.make config in
    let module R = (val registration : Web_election.REGISTRATION) in
    let module W = R.W in
    let module X : EMPTY = R.Register (S) (T.Election (W)) in
    let election = (module W : WEB_ELECTION) in
    if W.featured then featured := election :: !featured;
    return election

  let () = let module X : EMPTY = Auth.Register (S) (T) in ()

  let () = Any.register ~service:home
    (fun () () ->
      Eliom_reference.unset saved_service >>
      match !main_election with
Stephane Glondu's avatar
Stephane Glondu committed
112
      | None ->
Stephane Glondu's avatar
Stephane Glondu committed
113 114 115 116 117 118 119 120 121
        T.home ~featured:!featured () >>= Html5.send
      | Some w ->
        let module W = (val w : WEB_ELECTION) in
        Redirection.send W.S.home
    )

  let () = File.register
    ~service:source_code
    ~content_type:"application/x-gzip"
122
    (fun () () -> return C.source_file)
Stephane Glondu's avatar
Stephane Glondu committed
123

Stephane Glondu's avatar
Stephane Glondu committed
124 125 126 127 128 129 130 131 132
  let do_get_randomness =
    let prng = Lazy.lazy_from_fun (Lwt_preemptive.detach (fun () ->
      Cryptokit.Random.(pseudo_rng (string secure_rng 16))
    )) in
    let mutex = Lwt_mutex.create () in
    fun () ->
      Lwt_mutex.with_lock mutex (fun () ->
        lwt prng = Lazy.force prng in
        return Cryptokit.Random.(string prng 32)
Stephane Glondu's avatar
Stephane Glondu committed
133 134
      )

Stephane Glondu's avatar
Stephane Glondu committed
135 136 137 138 139 140 141 142
  let () = String.register
    ~service:get_randomness
    (fun () () ->
      lwt r = do_get_randomness () in
      Cryptokit.(transform_string (Base64.encode_compact ()) r) |>
      (fun x -> string_of_randomness { randomness=x }) |>
      (fun x -> return (x, "application/json"))
    )
Stephane Glondu's avatar
Stephane Glondu committed
143 144

end