Commit 5df632f1 authored by Stephane Glondu's avatar Stephane Glondu

Use base 58 tokens as UUIDs for shorter URLs (optional)

parent 1f5176c7
......@@ -38,6 +38,7 @@
</site>
<eliom module="_build/src/web/server.cma">
<maxmailsatonce value="1000"/>
<uuid length="14"/>
<!-- <contact uri="mailto:contact@example.org"/> -->
<server mail="noreply@belenios.org"/>
<auth name="demo"><dummy/></auth>
......
......@@ -79,8 +79,15 @@ let remove_dashes x =
module MakeDerive (G : GROUP) = struct
let derive uuid x =
let salt = remove_dashes (raw_string_of_uuid uuid) in
let derived = pbkdf2_hex ~iterations:1000 ~salt x in
let uuid = raw_string_of_uuid uuid in
let derived =
match Uuidm.of_string uuid with
| Some _ -> (* old-style UUIDs *)
let salt = remove_dashes uuid in
pbkdf2_hex ~iterations:1000 ~salt x
| None ->
pbkdf2_utf8 ~iterations:1000 ~salt:uuid x
in
Z.(of_string_base 16 derived mod G.q)
end
......@@ -22,6 +22,7 @@
val sha256_hex : string -> string
val sha256_b64 : string -> string
val pbkdf2_hex : iterations:int -> salt:string -> string -> string
val pbkdf2_utf8 : iterations:int -> salt:string -> string -> string
val aes_hex : key:string -> data:string -> string
......
......@@ -25,10 +25,25 @@ type number = Z.t
type uuid = string
type int_or_null = int option
let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let min_uuid_length = 14 (* at least 82 bits of entropy *)
let check token =
let n = String.length token in
n >= min_uuid_length &&
let rec loop i =
if i >= 0 then
let digit = try String.index digits token.[i] with Not_found -> -1 in
if digit >= 0 then loop (i-1) else false
else true
in loop (n-1)
let uuid_of_raw_string x =
match Uuidm.of_string x with
| Some s -> Uuidm.to_string s
| None -> Printf.ksprintf invalid_arg "%S is not a valid UUID" x
| None ->
if check x then x
else Printf.ksprintf invalid_arg "%S is not a valid UUID" x
let raw_string_of_uuid x = x
......
......@@ -25,6 +25,8 @@ type number = Z.t
type uuid
type int_or_null = int option
val min_uuid_length : int
val uuid_of_raw_string : string -> uuid
val raw_string_of_uuid : uuid -> string
......
......@@ -52,8 +52,8 @@ let sha256_b64 x =
| Some i -> String.sub raw 0 i
| None -> raw
let pbkdf2_hex ~iterations ~salt x =
let salt = hex_toBits salt in
let pbkdf2_generic toBits ~iterations ~salt x =
let salt = toBits salt in
let derived = Js.Unsafe.meth_call sjcl "misc.pbkdf2"
[|
Js.string x |> Js.Unsafe.inject;
......@@ -64,6 +64,9 @@ let pbkdf2_hex ~iterations ~salt x =
in
hex_fromBits derived
let pbkdf2_hex = pbkdf2_generic hex_toBits
let pbkdf2_utf8 = pbkdf2_generic utf8String_toBits
let aes_hex ~key ~data =
let key = hex_toBits key in
let data = hex_toBits data in
......
......@@ -63,12 +63,15 @@ let pbkdf2 ~prf ~salt ~iterations ~size password =
done;
Bytes.to_string result
let pbkdf2_hex ~iterations ~salt x =
let pbkdf2_generic toBits ~iterations ~salt x =
let open Cryptokit in
let salt = transform_string (Hexa.decode ()) salt in
let salt = toBits salt in
pbkdf2 ~prf:MAC.hmac_sha256 ~iterations ~size:1 ~salt x |>
transform_string (Hexa.encode ())
let pbkdf2_hex = pbkdf2_generic Cryptokit.(transform_string (Hexa.decode ()))
let pbkdf2_utf8 = pbkdf2_generic (fun x -> x)
let aes_hex ~key ~data =
let open Cryptokit in
let key = transform_string (Hexa.decode ()) key in
......
......@@ -169,7 +169,6 @@ let uuid =
Eliom_parameter.user_type ~of_string:uuid_of_raw_string ~to_string:raw_string_of_uuid
let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let token_length = 14
let prng = lazy (pseudo_rng (random_string secure_rng 16))
let random_char () =
......@@ -179,10 +178,10 @@ let random_char () =
in
return (int_of_char (random_string rng 1).[0])
let generate_token () =
let res = Bytes.create token_length in
let generate_token ?(length=14) () =
let res = Bytes.create length in
let rec loop i =
if i < token_length then (
if i < length then (
let%lwt digit = random_char () in
let digit = digit mod 58 in
Bytes.set res i b58_digits.[digit];
......
......@@ -86,7 +86,7 @@ val uuid :
[ `One of uuid ] Eliom_parameter.param_name)
Eliom_parameter.params_type
val generate_token : unit -> string Lwt.t
val generate_token : ?length:int -> unit -> string Lwt.t
val string_of_user : user -> string
......
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Lwt
open Serializable_builtin_t
open Web_serializable_j
open Web_common
......@@ -49,6 +50,12 @@ let () =
source_file := Some file
| Element ("maxmailsatonce", ["value", limit], []) ->
Web_site.maxmailsatonce := int_of_string limit
| Element ("uuid", ["length", length], []) ->
let length = int_of_string length in
if length >= min_uuid_length then
Web_site.uuid_length := Some length
else
failwith "UUID length is too small"
| Element ("contact", ["uri", uri], []) ->
Web_common.contact_uri := Some uri
| Element ("server", ["mail", mail], []) ->
......
......@@ -32,6 +32,7 @@ open Web_services
let source_file = ref "belenios.tar.gz"
let maxmailsatonce = ref 1000
let uuid_length = ref None
let ( / ) = Filename.concat
......@@ -355,7 +356,12 @@ let () = File.register ~service:source_code
let generate_uuid =
let gen = Uuidm.v4_gen (Random.State.make_self_init ()) in
fun () -> uuid_of_raw_string (Uuidm.to_string (gen ()))
fun () ->
match !uuid_length with
| Some length ->
let%lwt token = generate_token ~length () in
return @@ uuid_of_raw_string token
| None -> return @@ uuid_of_raw_string @@ Uuidm.to_string @@ gen ()
let redir_preapply s u () = Redirection.send (preapply s u)
......@@ -369,7 +375,7 @@ let create_new_election owner cred auth =
| `Dummy -> Some [{auth_system = "dummy"; auth_instance = "dummy"; auth_config = []}]
| `CAS server -> Some [{auth_system = "cas"; auth_instance = "cas"; auth_config = ["server", server]}]
in
let uuid = generate_uuid () in
let%lwt uuid = generate_uuid () in
let uuid_s = raw_string_of_uuid uuid in
let%lwt token = generate_token () in
let se_metadata = {
......
......@@ -21,3 +21,4 @@
val source_file : string ref
val maxmailsatonce : int ref
val uuid_length : int option ref
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment