My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** Secure API key storage for Eio applications using XDG directories *)
2
3(** {1 Exceptions} *)
4
5exception Key_not_found of string
6exception Profile_not_found of string
7exception Invalid_key_file of string
8
9(** {1 Profile Implementation} *)
10
11module Profile = struct
12 type t = {
13 service : string;
14 name : string;
15 data : (string * string) list;
16 }
17
18 let service t = t.service
19 let name t = t.name
20
21 let get t ~key = List.assoc_opt key t.data
22
23 let get_required t ~key =
24 match get t ~key with
25 | Some value -> value
26 | None ->
27 raise
28 (Key_not_found
29 (Printf.sprintf "Key '%s' not found in profile '%s' of service '%s'" key
30 t.name t.service))
31
32 let keys t = List.map fst t.data
33
34 let empty = { service = ""; name = ""; data = [] }
35
36 let to_toml t =
37 let table = Toml.Types.Table.empty in
38 List.fold_left
39 (fun tbl (k, v) -> Toml.Types.Table.add (Toml.Types.Table.Key.of_string k) (Toml.Types.TString v) tbl)
40 table
41 t.data
42
43 let pp ppf t =
44 let mask_sensitive key =
45 let lower = String.lowercase_ascii key in
46 String.contains lower 'k' && String.contains lower 'e' && String.contains lower 'y'
47 || String.contains lower 't' && String.contains lower 'o' && String.contains lower 'k'
48 || String.contains lower 'p'
49 && String.contains lower 'a'
50 && String.contains lower 's'
51 && String.contains lower 's'
52 in
53 Fmt.pf ppf "@[<v 2>Profile %s.%s:@," t.service t.name;
54 List.iter
55 (fun (k, v) ->
56 if mask_sensitive k then
57 Fmt.pf ppf " %s: %s@," k (String.sub v 0 (min 8 (String.length v)) ^ "***")
58 else Fmt.pf ppf " %s: %s@," k v)
59 t.data;
60 Fmt.pf ppf "@]"
61end
62
63(** {1 Service Implementation} *)
64
65module Service = struct
66 type t = {
67 name : string;
68 profiles : (string * Profile.t) list;
69 }
70
71 let name t = t.name
72 let profile_names t = List.map fst t.profiles
73 let get_profile t name = List.assoc_opt name t.profiles
74 let default_profile t = get_profile t "default"
75
76 let pp ppf t =
77 Fmt.pf ppf "@[<v 2>Service %s:@," t.name;
78 List.iter
79 (fun (pname, profile) -> Fmt.pf ppf "@[<v 2>%s:@,%a@]@," pname Profile.pp profile)
80 t.profiles;
81 Fmt.pf ppf "@]"
82end
83
84(** {1 Main Context} *)
85
86type backend = Filesystem of { keys_dir : Eio.Fs.dir_ty Eio.Path.t }
87
88type t = { xdg : Xdge.t; backend : backend }
89
90let create xdg =
91 (* Keys are stored in a "keys" subdirectory of the config directory *)
92 let config_dir = Xdge.config_dir xdg in
93 let keys_dir = Eio.Path.(config_dir / "keys") in
94
95 (* Create keys directory with restrictive permissions *)
96 (try Eio.Path.mkdir ~perm:0o700 keys_dir with
97 | Eio.Io (Eio.Fs.E (Already_exists _), _) -> ());
98
99 { xdg; backend = Filesystem { keys_dir } }
100
101(** {1 TOML Parsing Helpers} *)
102
103let parse_profile ~service ~profile_name table =
104 let data =
105 Toml.Types.Table.fold
106 (fun key value acc ->
107 match value with
108 | Toml.Types.TString s ->
109 let key_str = Toml.Types.Table.Key.to_string key in
110 (key_str, s) :: acc
111 | _ -> acc)
112 table
113 []
114 in
115 { Profile.service; name = profile_name; data }
116
117let parse_service_file ~service toml_table =
118 let profiles =
119 Toml.Types.Table.fold
120 (fun key value acc ->
121 match value with
122 | Toml.Types.TTable profile_table ->
123 let profile_name = Toml.Types.Table.Key.to_string key in
124 (profile_name, parse_profile ~service ~profile_name profile_table) :: acc
125 | _ -> acc)
126 toml_table
127 []
128 in
129 if profiles = [] then
130 raise
131 (Invalid_key_file (Printf.sprintf "Service file '%s.toml' contains no valid profile tables" service))
132 else
133 { Service.name = service; profiles }
134
135(** {1 File Operations} *)
136
137let create_default_keyfile t ~service ~profile ~data =
138 match t.backend with
139 | Filesystem { keys_dir } ->
140 let service_file = Eio.Path.(keys_dir / (service ^ ".toml")) in
141 (try
142 (* Load existing service file if it exists, otherwise start fresh *)
143 let existing_profiles =
144 try
145 let content = Eio.Path.load service_file in
146 let toml = Toml.Parser.(from_string content |> unsafe) in
147 let svc = parse_service_file ~service toml in
148 svc.Service.profiles
149 with
150 | Eio.Io (Eio.Fs.E (Not_found _), _) -> []
151 in
152
153 (* Create or update the profile *)
154 let new_profile = { Profile.service; name = profile; data } in
155 let updated_profiles =
156 (* Remove existing profile with same name if present *)
157 List.filter (fun (name, _) -> name <> profile) existing_profiles
158 @ [(profile, new_profile)]
159 in
160
161 (* Build TOML structure *)
162 let toml_table = Toml.Types.Table.empty in
163 let toml_table =
164 List.fold_left
165 (fun tbl (prof_name, prof) ->
166 let prof_table = Profile.to_toml prof in
167 Toml.Types.Table.add
168 (Toml.Types.Table.Key.of_string prof_name)
169 (Toml.Types.TTable prof_table)
170 tbl)
171 toml_table
172 updated_profiles
173 in
174
175 (* Convert to TOML string *)
176 let toml_str = Toml.Printer.string_of_table toml_table in
177
178 (* Write to file with restrictive permissions *)
179 Eio.Path.save ~create:(`Or_truncate 0o600) service_file toml_str;
180
181 Ok ()
182 with
183 | Toml.Parser.Error (msg, _) ->
184 Error (`Msg (Printf.sprintf "Invalid TOML in existing %s.toml: %s" service msg))
185 | exn ->
186 Error (`Msg (Printf.sprintf "Error creating key file: %s" (Printexc.to_string exn))))
187
188let load_service t ~service =
189 match t.backend with
190 | Filesystem { keys_dir } ->
191 let service_file = Eio.Path.(keys_dir / (service ^ ".toml")) in
192 (try
193 (* Read and parse the TOML file *)
194 let content = Eio.Path.load service_file in
195 let toml = Toml.Parser.(from_string content |> unsafe) in
196 let service_data = parse_service_file ~service toml in
197 Ok service_data
198 with
199 | Eio.Io (Eio.Fs.E (Not_found _), _) ->
200 Error (`Msg (Printf.sprintf "Service file not found: %s.toml" service))
201 | Toml.Parser.Error (msg, _) ->
202 Error (`Msg (Printf.sprintf "Invalid TOML in %s.toml: %s" service msg))
203 | Invalid_key_file msg -> Error (`Msg msg)
204 | exn -> Error (`Msg (Printf.sprintf "Error loading service: %s" (Printexc.to_string exn))))
205
206let list_services t =
207 match t.backend with
208 | Filesystem { keys_dir } ->
209 (try
210 let entries = Eio.Path.read_dir keys_dir in
211 let services =
212 List.filter_map
213 (fun entry ->
214 if String.ends_with ~suffix:".toml" entry then
215 Some (String.sub entry 0 (String.length entry - 5))
216 else None)
217 entries
218 in
219 Ok (List.sort String.compare services)
220 with
221 | Eio.Io (Eio.Fs.E (Not_found _), _) ->
222 (* Keys directory doesn't exist yet *)
223 Ok []
224 | exn -> Error (`Msg (Printf.sprintf "Error listing services: %s" (Printexc.to_string exn))))
225
226let pp ppf t =
227 match t.backend with
228 | Filesystem { keys_dir } ->
229 Fmt.pf ppf "@[<v 2>Keyeio:@,";
230 Fmt.pf ppf "Keys directory: %s@," (Eio.Path.native_exn keys_dir);
231 Fmt.pf ppf "Application: %s@," (Xdge.app_name t.xdg);
232 Fmt.pf ppf "@]"
233
234(** {1 Cmdliner Integration} *)
235
236module Cmd = struct
237 type keyeio_t = t
238
239 let term ~app_name ~fs ~service ?profile:(default_profile = "default")
240 ?(key_file = true) () =
241 let open Cmdliner in
242 (* Profile selection flag *)
243 let profile_flag =
244 let doc = Printf.sprintf "Profile name to use for %s service" service in
245 Arg.(value & opt string default_profile & info [ "profile" ] ~docv:"NAME" ~doc)
246 in
247
248 (* Optional key file override *)
249 let key_file_flag =
250 if key_file then
251 let doc = Printf.sprintf "Override with direct path to %s key file" service in
252 Some Arg.(value & opt (some file) None & info [ "key-file" ] ~docv:"FILE" ~doc)
253 else None
254 in
255
256 (* Term that loads the profile *)
257 let load_profile profile_name key_file_path =
258 (* If key_file path is provided, load from there *)
259 match key_file_path with
260 | Some path ->
261 (try
262 let content = In_channel.with_open_bin path In_channel.input_all in
263 let toml = Toml.Parser.(from_string content |> unsafe) in
264 match parse_service_file ~service toml with
265 | svc ->
266 (match Service.get_profile svc profile_name with
267 | Some prof -> prof
268 | None ->
269 failwith
270 (Printf.sprintf "Profile '%s' not found in %s" profile_name path))
271 | exception exn ->
272 failwith
273 (Printf.sprintf "Error loading key file %s: %s" path
274 (Printexc.to_string exn))
275 with
276 | Sys_error msg -> failwith (Printf.sprintf "Cannot read key file: %s" msg))
277 | None ->
278 (* Load from XDG directory *)
279 let xdg = Xdge.create fs app_name in
280 let keyeio = create xdg in
281 (match load_service keyeio ~service with
282 | Ok svc ->
283 (match Service.get_profile svc profile_name with
284 | Some prof -> prof
285 | None ->
286 failwith
287 (Printf.sprintf "Profile '%s' not found in service '%s'" profile_name
288 service))
289 | Error (`Msg msg) -> failwith msg)
290 in
291
292 (* Build the term *)
293 match key_file_flag with
294 | Some kf_flag -> Term.(const load_profile $ profile_flag $ kf_flag)
295 | None -> Term.(const load_profile $ profile_flag $ const None)
296
297 let create_term ~app_name ~fs ~service ~default_data
298 ?profile:(default_profile = "default") () =
299 let open Cmdliner in
300
301 (* Profile name flag *)
302 let profile_flag =
303 let doc = Printf.sprintf "Profile name to create for %s service" service in
304 Arg.(value & opt string default_profile & info [ "profile" ] ~docv:"NAME" ~doc)
305 in
306
307 (* Create flags for each key in default_data *)
308 let key_flags =
309 List.map
310 (fun (key, default_val) ->
311 let flag_name = String.map (fun c -> if c = '_' then '-' else c) key in
312 let doc = Printf.sprintf "Value for %s" key in
313 let term =
314 Arg.(value & opt (some string) default_val & info [ flag_name ] ~docv:(String.uppercase_ascii key) ~doc)
315 in
316 (key, term))
317 default_data
318 in
319
320 (* Helper to prompt for a value if not provided *)
321 let prompt_for_value key =
322 Printf.printf "Enter %s: %!" key;
323 try
324 input_line stdin
325 with End_of_file ->
326 failwith (Printf.sprintf "Failed to read %s from stdin" key)
327 in
328
329 (* Term that creates the keyfile *)
330 let create_keyfile profile_name key_values =
331 try
332 (* Build the data list, prompting for missing values *)
333 let data =
334 List.map
335 (fun (key, value_opt) ->
336 match value_opt with
337 | Some v -> (key, v)
338 | None ->
339 let prompted = prompt_for_value key in
340 (key, prompted))
341 (List.combine (List.map fst default_data) key_values)
342 in
343
344 (* Create the keyfile *)
345 let xdg = Xdge.create fs app_name in
346 let keyeio = create xdg in
347 match create_default_keyfile keyeio ~service ~profile:profile_name ~data with
348 | Ok () ->
349 let keys_dir = match keyeio.backend with
350 | Filesystem { keys_dir } -> Eio.Path.native_exn keys_dir
351 in
352 Printf.printf "Created %s profile in %s/%s.toml\n" profile_name keys_dir service;
353 0
354 | Error (`Msg msg) ->
355 Printf.eprintf "Failed to create key file: %s\n" msg;
356 1
357 with exn ->
358 Printf.eprintf "Error: %s\n" (Printexc.to_string exn);
359 1
360 in
361
362 (* Build the term by applying all key flags *)
363 let rec build_term acc_term = function
364 | [] -> Term.(const create_keyfile $ profile_flag $ acc_term)
365 | (_, flag_term) :: rest ->
366 build_term Term.(const (fun lst x -> lst @ [x]) $ acc_term $ flag_term) rest
367 in
368 build_term (Term.const []) key_flags
369
370 let env_docs ~app_name ~service () =
371 Printf.sprintf
372 {|ENVIRONMENT
373 Keys are stored in the XDG config directory under a 'keys' subdirectory.
374 The location is determined by the XDG Base Directory Specification:
375
376 XDG_CONFIG_HOME
377 Base directory for configuration files. If not set, defaults to
378 $HOME/.config. Keys for %s will be stored in:
379 $XDG_CONFIG_HOME/%s/keys/%s.toml
380
381 Example locations:
382 ~/.config/%s/keys/%s.toml (default)
383 /custom/config/%s/keys/%s.toml (if XDG_CONFIG_HOME=/custom/config)
384
385 File permissions should be 0600 (owner read/write only) for security.
386|}
387 app_name app_name service app_name service app_name service
388end