mfat path: keep it simple

This commit is contained in:
swrup 2026-03-21 07:38:29 +01:00 committed by Swrup
parent cbae1c773a
commit ec4e166173
4 changed files with 46 additions and 47 deletions

View file

@ -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

View file

@ -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;
}

View file

@ -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

View file

@ -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