ocaml-gdocs: atomic-write store and truncate HTTP error bodies

Two corrections surfaced by reviewing the equivalent code in
[ocaml-gsheets]:

- [Store.save_file] used [Eio.Path.save ~create:(`Or_truncate 0o600)]
followed by [Unix.chmod 0o600]. [Or_truncate] only applies the mode
on file creation, so when an existing file at the target was at a
wider mode (left over from a different tool, or a buggy older
version), the new content was written and briefly observable at the
wider mode before [chmod] tightened it. There was also no atomicity:
a crash mid-write left a half-written or zero-byte file. Replace
with the standard pattern -- write to a sibling [<path>.tmp.<pid>]
with [`Exclusive 0o600], then [Eio.Path.rename] over the target.
The new content is never observable at a wider mode (the file
inherits the tmp file's [0o600]), and a crash before the rename
leaves the original target untouched. Best-effort [unlink] of any
stale [.tmp.<pid>] from a previous crash before the [Exclusive]
open.

- [err_http] in both [Gdocs] and [Comments] piped the upstream
response body straight into a [`Msg]. A 4xx/5xx body from a CDN
edge can be multi-KB of HTML, which then dumps unbounded onto the
user's stderr. Add a local [truncate_body] that caps at 256 bytes
and appends ["... [truncated; <N> bytes total]"] so the user has a
rough sense of what was elided.

Thomas Gazagnaire 1 month ago fe578515 59b67f7b

+40 -6

3 changed files

expand all

lib

comments.ml

gdocs.ml

store.ml

+16 -1

lib/comments.ml

··· 9 9 let err_json_decode e = 10 10 err_msg "comments JSON decode: %s" (Json.Error.to_string e) 11 11 12 - let err_http status body = err_msg "Drive comments HTTP %d: %s" status body 12 + (* Cap upstream error bodies before piping them into a user-visible message. 13 + A 4xx/5xx body from a CDN edge can be multi-KB of HTML; we don't want to 14 + propagate that to a CLI's stderr. *) 15 + let max_body_chars = 256 16 + 17 + let truncate_body s = 18 + let n = String.length s in 19 + if n <= max_body_chars then s 20 + else 21 + Fmt.str "%s... [truncated; %d bytes total]" 22 + (String.sub s 0 max_body_chars) 23 + n 24 + 25 + let err_http status body = 26 + err_msg "Drive comments HTTP %d: %s" status (truncate_body body) 27 + 13 28 let scope = "https://www.googleapis.com/auth/drive.readonly" 14 29 15 30 type t = {

+15 -1

lib/gdocs.ml

··· 11 11 12 12 (* Error helpers -- keep all [`Msg] shapes in one place. *) 13 13 let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt 14 - let err_http status body = err_msg "HTTP %d: %s" status body 14 + 15 + (* Cap upstream error bodies before piping them into a user-visible message. 16 + A 4xx/5xx body from a CDN edge can be multi-KB of HTML; we don't want to 17 + propagate that to a CLI's stderr. *) 18 + let max_body_chars = 256 19 + 20 + let truncate_body s = 21 + let n = String.length s in 22 + if n <= max_body_chars then s 23 + else 24 + Fmt.str "%s... [truncated; %d bytes total]" 25 + (String.sub s 0 max_body_chars) 26 + n 27 + 28 + let err_http status body = err_msg "HTTP %d: %s" status (truncate_body body) 15 29 let scope_readonly = "https://www.googleapis.com/auth/documents.readonly" 16 30 let scope_readwrite = "https://www.googleapis.com/auth/documents" 17 31 let api_root = "https://docs.googleapis.com/v1/documents/"

+9 -4

lib/store.ml

··· 19 19 |> Object.member "client_secret" string ~enc:(fun c -> c.client_secret) 20 20 |> Object.skip_unknown |> Object.seal 21 21 22 + (* Atomic write: create a sibling tmp file with O_CREAT|O_EXCL at 0600, 23 + write the body, then atomically rename it over the target. The result 24 + is never observed at a wider mode, and a crash before [rename] leaves 25 + the target untouched (instead of half-written or zero-byte). *) 22 26 let save_file path data = 23 - Eio.Path.save ~create:(`Or_truncate 0o600) path data; 24 - (* Tighten permissions on a pre-existing file -- [Or_truncate] only 25 - applies [0o600] on create, not on reuse. *) 26 - try Unix.chmod (snd path) 0o600 with Unix.Unix_error _ -> () 27 + let dir, base = path in 28 + let tmp = (dir, Fmt.str "%s.tmp.%d" base (Unix.getpid ())) in 29 + (try Eio.Path.unlink tmp with Eio.Io _ -> ()); 30 + Eio.Path.save ~create:(`Exclusive 0o600) tmp data; 31 + Eio.Path.rename tmp path 27 32 28 33 let load_file path = 29 34 if Eio.Path.is_file path then Some (Eio.Path.load path) else None

Configure Feed

Configure Feed