diff --git a/GNUmakefile b/GNUmakefile index 49a9445f..91548fda 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -28,7 +28,7 @@ pins: opam pin --no-action --yes add caqti-miou "git+https://github.com/swrup/ocaml-caqti.git#7838c29ffa9095d32b95affee26b22ef2ad302fd" opam pin --no-action --yes add caqti-mnet "git+https://github.com/swrup/ocaml-caqti.git#7838c29ffa9095d32b95affee26b22ef2ad302fd" opam pin --no-action --yes add caqti-driver-pgx "git+https://github.com/swrup/ocaml-caqti.git#7838c29ffa9095d32b95affee26b22ef2ad302fd" - opam pin --no-action --yes "git+https://github.com/swrup/mfat.git#3a98411c507fb38d9442cbf3fc079bd8be97fee6" + opam pin --no-action --yes "git+https://github.com/robur-coop/mfat.git#5b1204d914e853f0139c6d2776511f530b753550" .PHONY: vendors diff --git a/src/fat.ml b/src/fat.ml index cb9889ec..4d1cada4 100644 --- a/src/fat.ml +++ b/src/fat.ml @@ -1,3 +1,24 @@ +module Path = struct + let trim_left s = + let s = String.trim s in + if String.starts_with ~prefix:"/" s then String.sub s 1 (String.length s - 1) + else s + + let trim_right s = + let s = String.trim s in + if String.ends_with ~suffix:"/" s then String.sub s 0 (String.length s - 1) + else s + + let add a b = + let a = trim_right a in + let b = trim_left b in + Fmt.str "%s/%s" a b + + (* let ( / ) = add *) + let compare a b = String.compare (trim_right a) (trim_right b) + let equal a b = 0 = compare a b +end + module Fat = Mfat.Make (struct include Mkernel.Block @@ -5,12 +26,10 @@ module Fat = Mfat.Make (struct let write = atomic_write end) -module Sfn = Mfat.Sfn -module Spath = Mfat.Spath include Fat type entry = Mfat.entry = { - name: Sfn.t; + name: string; is_dir: bool; size: int32; } diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index ed5c63c0..a19bf55f 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -1,6 +1,5 @@ (* TODO ! use lock - !? Scanf not thread-safe schedule tasks sign: check timestamps before signing *) (* IMPROVE @@ -10,7 +9,7 @@ list_issue_date: save timestamp of key generation key validity period: more checks + do not exceed lookahead - refacto common parts with secmod_eddsa *) + refacto common parts with secmod_rsa *) let src = Logs.Src.create "mte.secmod_eddsa" module Log = (val Logs.src_log src : Logs.LOG) @@ -18,19 +17,12 @@ module Log = (val Logs.src_log src : Logs.LOG) (* - *) open Syntax open Time -module Sfn = Mfat.Sfn -module Spath = Mfat.Spath module Cfg = struct include Config.Exchange_secmod_eddsa - let to_spath s = - let open Fat.Spath in - match of_string s with Error (`Msg e) -> Fmt.failwith "%s" e | Ok v -> v - - (* 8.3 filenames for FAT *) - let key_dir = to_spath "/EDDSA" - let sm_key = to_spath "/SM_EDDSA" + let key_dir = "/EDDSA" + let sm_key = "/SM_EDDSA" end type key = { @@ -60,25 +52,23 @@ let key_bin = (* for sm_key only *) let read_eddsa fs spath = - Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "reading key file `%s`" spath); let* data = Fat.read fs spath |> unwrap_msg in let* priv = Eddsa.priv_of_octets data in let pub = Eddsa.pub_of_priv priv in Ok (priv, pub) let write_eddsa fs spath priv = - Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "writing key file `%s`" spath); let data = Eddsa.priv_to_octets priv in Fat.write fs spath data |> unwrap_msg let key_spath k = - let sfn_res = String.sub (Eddsa.pub_to_b32 k.pub) 0 8 |> Sfn.of_string in - match sfn_res with - | Error _ -> failwith "not possible" - | Ok sfn -> Spath.(Cfg.key_dir / sfn) + let sfn = String.sub (Eddsa.pub_to_b32 k.pub) 0 8 in + Fat.Path.add Cfg.key_dir sfn let read_key fs spath = - Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "reading key file `%s`" spath); let* data = Fat.read fs spath |> unwrap_msg in (* todo: catch failure *) let k = Bin.decode key_bin data (ref 0) in @@ -86,12 +76,12 @@ let read_key fs spath = let write_key fs k = let spath = key_spath k in - Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "writing key file `%s`" spath); let data = Bin.to_string key_bin k in Fat.write fs spath data |> unwrap_msg let delete_file fs spath = - Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "delete key file `%s`" spath); let+ () = Fat.remove fs spath |> unwrap_msg in () @@ -137,8 +127,8 @@ let load fs = else Fat.mkdir fs Cfg.key_dir |> unwrap_msg in let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in - let l = List.map (fun entry -> Spath.add Cfg.key_dir entry.Fat.name) l in - let l = List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_key) l in + let l = List.map (fun entry -> Fat.Path.add Cfg.key_dir entry.Fat.name) l in + let l = List.filter (fun spath -> not @@ String.equal spath Cfg.sm_key) l in let* keys = list_map (read_key fs) l in match keys with | [] -> Ok None diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 5b198aa9..de386492 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -5,8 +5,6 @@ module Log = (val Logs.src_log src : Logs.LOG) (* - *) open Syntax open Time -module Sfn = Mfat.Sfn -module Spath = Mfat.Spath module DenominationHash = Hash.DenominationHash module Coin_config = struct @@ -27,12 +25,8 @@ end module Cfg = struct include Config.Exchange_secmod_rsa - let to_spath s = - let open Fat.Spath in - match of_string s with Error (`Msg e) -> Fmt.failwith "%s" e | Ok v -> v - - let key_dir = to_spath "/RSA" - let sm_key = to_spath "/SM_RSA" + let key_dir = "/RSA" + let sm_key = "/SM_RSA" let coin_config_list = List.map Coin_config.of_coin Config.Coin.all_coins let get_coin_config ~section_name = @@ -74,39 +68,35 @@ let key_bin = |> sealr let key_spath k = - let sfn_res = - String.sub (DenominationHash.to_b32 k.h_pub) 0 8 |> Sfn.of_string - in - match sfn_res with - | Error _ -> failwith "not possible" - | Ok sfn -> Spath.(Cfg.key_dir / sfn) + let sfn = String.sub (DenominationHash.to_b32 k.h_pub) 0 8 in + Fat.Path.add Cfg.key_dir sfn let read_eddsa fs spath = - Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "reading key file `%s`" spath); let* data = Fat.read fs spath |> unwrap_msg in let* priv = Eddsa.priv_of_octets data in let pub = Eddsa.pub_of_priv priv in Ok (priv, pub) let write_eddsa fs spath priv = - Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "writing key file `%s`" spath); let data = Eddsa.priv_to_octets priv in Fat.write fs spath data |> unwrap_msg let read_key fs spath = - Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "reading key file `%s`" spath); let* data = Fat.read fs spath |> unwrap_msg in let k = Bin.decode key_bin data (ref 0) in Ok k let write_key fs k = let spath = key_spath k in - Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "writing key file `%s`" spath); let data = Bin.to_string key_bin k in Fat.write fs spath data |> unwrap_msg let delete_file fs spath = - Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath); + Log.debug (fun m -> m "delete key file `%s`" spath); let+ () = Fat.remove fs spath |> unwrap_msg in () @@ -156,8 +146,8 @@ let load fs = else Fat.mkdir fs Cfg.key_dir |> unwrap_msg in let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in - let l = List.map (fun entry -> Spath.add Cfg.key_dir entry.Fat.name) l in - let l = List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_key) l in + let l = List.map (fun entry -> Fat.Path.add Cfg.key_dir entry.Fat.name) l in + let l = List.filter (fun spath -> not @@ String.equal Cfg.sm_key spath) l in let* keys = list_map (read_key fs) l in match keys with | [] -> Ok None