Minimal SQLite key-value store for OCaml
Fix 5 auth/oauth/sqlite security bugs
1. Sqlite: silent data loss on corrupt DB — Store.v caught all exceptions
and fell back to Sqlite.v (which truncates). Now only catches Eio.Io
(file not found). Remove Sqlite.v; add Sqlite.open_ ~create flag.
2. Sign-out: now revokes server-side session via Store.delete_session.
Previously only cleared the browser cookie — copied sid stayed valid.
Changed to POST /auth/signout with header-based session lookup.
3. OAuth: authorization URL now includes response_type=code per RFC 6749.
4. OAuth: token exchange/refresh now uses application/x-www-form-urlencoded
per RFC 6749, not JSON. Removed JSON-body functions, added form_encode
helper and exchange_form_body/refresh_form_body returning strings.
5. Auth: callback now uses provider.userinfo_url instead of hardcoded
GitHub API. Added userinfo_url to Oauth.provider type. Google, GitLab,
and custom providers can now complete login.
+79
-75
+1
-2
bin/sql.ml
+1
-2
bin/sql.ml
···
6
6
7
7
(* -- write subcommand -- *)
8
8
9
-
let open_or_create ~sw path =
10
-
try Sqlite.open_ ~sw path with Failure _ | Eio.Io _ -> Sqlite.v ~sw path
9
+
let open_or_create ~sw path = Sqlite.open_ ~sw ~create:true path
11
10
12
11
let write_entry t (k, v) =
13
12
Log.info (fun m -> m "put %s=%s" k v);
+63
-59
lib/sqlite.ml
+63
-59
lib/sqlite.ml
···
377
377
try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 Eio.Path.(fs / dir)
378
378
with Eio.Io _ -> ())
379
379
380
-
let v ~sw path =
380
+
let create_new ~sw path =
381
381
mkdirs_for path;
382
382
let file =
383
-
Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644) path |> fun f ->
383
+
Eio.Path.open_out ~sw ~create:(`If_missing 0o644) path |> fun f ->
384
384
(f :> Eio.File.rw_ty Eio.Resource.t)
385
385
in
386
386
let pager = Btree.Pager.v ~page_size file in
···
435
435
rebuild_page1 t;
436
436
t
437
437
438
-
let open_ ~sw path =
439
-
let file =
440
-
Eio.Path.open_out ~sw ~create:`Never path |> fun f ->
441
-
(f :> Eio.File.rw_ty Eio.Resource.t)
442
-
in
443
-
let pager = Btree.Pager.v ~page_size file in
444
-
if Btree.Pager.page_count pager = 0 then failwith "Database file is empty";
445
-
(* Read page 1 and validate *)
446
-
let page1 = Btree.Pager.read pager 1 in
447
-
if String.sub page1 0 16 <> magic then failwith "Not a SQLite database";
448
-
let ps = Btree.Page.u16_be page1 16 in
449
-
if ps <> page_size then Fmt.failwith "Unsupported page size: %d" ps;
450
-
(* Parse sqlite_master at offset 100 *)
451
-
let header = Btree.Page.parse_header page1 100 in
452
-
let ptrs = Btree.Page.cell_pointers page1 100 header in
453
-
let raw_tables = ref [] in
454
-
for i = 0 to header.Btree.Page.cell_count - 1 do
455
-
let cell, _ =
456
-
Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size
438
+
let open_ ~sw ?(create = true) path =
439
+
try
440
+
let file =
441
+
Eio.Path.open_out ~sw ~create:`Never path |> fun f ->
442
+
(f :> Eio.File.rw_ty Eio.Resource.t)
457
443
in
458
-
match Btree.Record.decode cell.Btree.Cell.payload with
459
-
| [
460
-
Btree.Record.Vtext "table";
461
-
Btree.Record.Vtext name;
462
-
_;
463
-
Btree.Record.Vint root;
464
-
Btree.Record.Vtext sql;
465
-
] ->
466
-
raw_tables := (name, Int64.to_int root, sql) :: !raw_tables
467
-
| _ -> ()
468
-
done;
469
-
let raw_tables = List.rev !raw_tables in
470
-
(* Build generic_table for every table *)
471
-
let all_tables =
472
-
List.map
473
-
(fun (name, root, sql) ->
474
-
let btree = Btree.Table.open_ pager ~root_page:root in
475
-
let columns = parse_create_table sql in
476
-
let schema = { tbl_name = name; columns; sql } in
477
-
{ g_btree = btree; g_schema = schema })
478
-
raw_tables
479
-
in
480
-
(* Try to find "kv" table for backward compat *)
481
-
let data =
482
-
match List.find_opt (fun gt -> gt.g_schema.tbl_name = "kv") all_tables with
483
-
| None -> None
484
-
| Some gt ->
485
-
let keys, next_rowid = scan_table gt.g_btree in
486
-
Some { btree = gt.g_btree; keys; next_rowid }
487
-
in
488
-
let named = extract_named_kv_tables all_tables in
489
-
{
490
-
pager;
491
-
data;
492
-
named_tables = named;
493
-
all_tables;
494
-
insert_rowids = Hashtbl.create 8;
495
-
}
444
+
let pager = Btree.Pager.v ~page_size file in
445
+
if Btree.Pager.page_count pager = 0 then failwith "Database file is empty";
446
+
(* Read page 1 and validate *)
447
+
let page1 = Btree.Pager.read pager 1 in
448
+
if String.sub page1 0 16 <> magic then failwith "Not a SQLite database";
449
+
let ps = Btree.Page.u16_be page1 16 in
450
+
if ps <> page_size then Fmt.failwith "Unsupported page size: %d" ps;
451
+
(* Parse sqlite_master at offset 100 *)
452
+
let header = Btree.Page.parse_header page1 100 in
453
+
let ptrs = Btree.Page.cell_pointers page1 100 header in
454
+
let raw_tables = ref [] in
455
+
for i = 0 to header.Btree.Page.cell_count - 1 do
456
+
let cell, _ =
457
+
Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size
458
+
in
459
+
match Btree.Record.decode cell.Btree.Cell.payload with
460
+
| [
461
+
Btree.Record.Vtext "table";
462
+
Btree.Record.Vtext name;
463
+
_;
464
+
Btree.Record.Vint root;
465
+
Btree.Record.Vtext sql;
466
+
] ->
467
+
raw_tables := (name, Int64.to_int root, sql) :: !raw_tables
468
+
| _ -> ()
469
+
done;
470
+
let raw_tables = List.rev !raw_tables in
471
+
(* Build generic_table for every table *)
472
+
let all_tables =
473
+
List.map
474
+
(fun (name, root, sql) ->
475
+
let btree = Btree.Table.open_ pager ~root_page:root in
476
+
let columns = parse_create_table sql in
477
+
let schema = { tbl_name = name; columns; sql } in
478
+
{ g_btree = btree; g_schema = schema })
479
+
raw_tables
480
+
in
481
+
(* Try to find "kv" table for backward compat *)
482
+
let data =
483
+
match
484
+
List.find_opt (fun gt -> gt.g_schema.tbl_name = "kv") all_tables
485
+
with
486
+
| None -> None
487
+
| Some gt ->
488
+
let keys, next_rowid = scan_table gt.g_btree in
489
+
Some { btree = gt.g_btree; keys; next_rowid }
490
+
in
491
+
let named = extract_named_kv_tables all_tables in
492
+
{
493
+
pager;
494
+
data;
495
+
named_tables = named;
496
+
all_tables;
497
+
insert_rowids = Hashtbl.create 8;
498
+
}
499
+
with Eio.Io _ when create -> create_new ~sw path
496
500
497
501
(* Get the kv_table, raising if no kv table exists *)
498
502
let kv t =
+8
-7
lib/sqlite.mli
+8
-7
lib/sqlite.mli
···
46
46
47
47
(** {1 Database Lifecycle} *)
48
48
49
-
val v : sw:Eio.Switch.t -> Eio.Fs.dir_ty Eio.Path.t -> t
50
-
(** [v ~sw path] creates a new database at [path]. If a file already exists at
51
-
[path], it will be truncated. The switch [sw] controls the lifetime of the
52
-
underlying file handle. *)
53
-
54
49
val in_memory : unit -> t
55
50
(** [in_memory ()] creates a purely in-memory database. No file I/O is
56
51
performed. Useful for testing. *)
57
52
58
-
val open_ : sw:Eio.Switch.t -> Eio.Fs.dir_ty Eio.Path.t -> t
59
-
(** [open_ ~sw path] opens an existing database at [path]. Works with any SQLite
53
+
val open_ : sw:Eio.Switch.t -> ?create:bool -> Eio.Fs.dir_ty Eio.Path.t -> t
54
+
(** [open_ ~sw ?create path] opens a database at [path].
55
+
56
+
If [create] is [true] (the default), the database is created if it does not
57
+
exist. If [create] is [false], the file must already exist or [Sys_error] is
58
+
raised.
59
+
60
+
{b Warning}: does {b not} truncate existing files. Works with any SQLite
60
61
database, not just ones created by this library. If the database contains a
61
62
[kv] table, the KV API functions below will work; otherwise, use the generic
62
63
read API.
+7
-7
test/test_sqlite.ml
+7
-7
test/test_sqlite.ml
···
11
11
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
12
12
let path = Eio.Path.(tmp_dir / Fmt.str "test_%d.db" (Random.int 1_000_000)) in
13
13
Eio.Switch.run @@ fun sw ->
14
-
let db = Sqlite.v ~sw path in
14
+
let db = Sqlite.open_ ~sw ~create:true path in
15
15
Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> f fs db)
16
16
17
17
(* Basic operations *)
···
262
262
in
263
263
(* Create and write *)
264
264
Eio.Switch.run (fun sw ->
265
-
let db = Sqlite.v ~sw path in
265
+
let db = Sqlite.open_ ~sw ~create:true path in
266
266
Sqlite.put db "key1" "value1";
267
267
Sqlite.put db "key2" "value2";
268
268
Sqlite.close db);
···
285
285
in
286
286
(* Create, write, delete *)
287
287
Eio.Switch.run (fun sw ->
288
-
let db = Sqlite.v ~sw path in
288
+
let db = Sqlite.open_ ~sw ~create:true path in
289
289
Sqlite.put db "keep" "value1";
290
290
Sqlite.put db "delete" "value2";
291
291
Sqlite.delete db "delete";
···
309
309
in
310
310
(* Create with tables *)
311
311
Eio.Switch.run (fun sw ->
312
-
let db = Sqlite.v ~sw path in
312
+
let db = Sqlite.open_ ~sw ~create:true path in
313
313
let t1 = Sqlite.Table.create db ~name:"blocks" in
314
314
let t2 = Sqlite.Table.create db ~name:"refs" in
315
315
Sqlite.Table.put t1 "cid1" "data1";
···
720
720
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
721
721
let path = Eio.Path.(tmp_dir / Fmt.str "spec_%d.db" (Random.int 1_000_000)) in
722
722
Eio.Switch.run @@ fun sw ->
723
-
let db = Sqlite.v ~sw path in
723
+
let db = Sqlite.open_ ~sw ~create:true path in
724
724
Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> f path db)
725
725
726
726
(* Section 1.2: Database header byte-level verification *)
···
832
832
let large = String.make 10000 'Y' in
833
833
(* Write *)
834
834
Eio.Switch.run (fun sw ->
835
-
let db = Sqlite.v ~sw path in
835
+
let db = Sqlite.open_ ~sw ~create:true path in
836
836
Sqlite.put db "big" large;
837
837
Sqlite.close db);
838
838
(* Read back *)
···
961
961
in
962
962
(* Write *)
963
963
Eio.Switch.run (fun sw ->
964
-
let db = Sqlite.v ~sw path in
964
+
let db = Sqlite.open_ ~sw ~create:true path in
965
965
Sqlite.create_table db ~sql:"CREATE TABLE items (name TEXT, qty INTEGER)";
966
966
let _ =
967
967
Sqlite.insert db ~table:"items"