├── .gitignore ├── test ├── dune └── test_living.ml ├── lib ├── dune ├── living_core.mli ├── living_core.ml ├── living_core_intf.ml └── living_ctypes.ml ├── dune-project ├── living.opam ├── LICENSE ├── CHANGES └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (libraries ctypes ounit2 ctypes-foreign living) 3 | (name test_living)) 4 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (modules Living_core Living_core_intf Living_ctypes) 3 | (name living) 4 | (public_name living) 5 | (libraries ctypes) 6 | (flags (:standard))) 7 | -------------------------------------------------------------------------------- /lib/living_core.mli: -------------------------------------------------------------------------------- 1 | module Default_living_config : Living_core_intf.LIVING_CONFIG 2 | 3 | module Make (_: Living_core_intf.LIVING_CONFIG) : Living_core_intf.LIVING_CORE 4 | 5 | module Types: Living_core_intf.LIVING_TYPES 6 | 7 | module Default: Living_core_intf.LIVING_CORE -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.15) 2 | 3 | (name living) 4 | 5 | (generate_opam_files true) 6 | 7 | (version 0.3.0) 8 | 9 | (source 10 | (github Fizzixnerd/ocaml-living)) 11 | 12 | (authors "Matt Walker") 13 | 14 | (maintainers "Matt Walker") 15 | 16 | (license MIT) 17 | 18 | (package 19 | (name living) 20 | (synopsis "A safer FFI interface") 21 | (description "An interface to Ctypes' ffi that lives harmoniously with the OCaml garbage collector.") 22 | (depends ocaml dune ctypes ounit2) 23 | (tags 24 | (ffi ctypes))) 25 | -------------------------------------------------------------------------------- /living.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.3.0" 4 | synopsis: "A safer FFI interface" 5 | description: 6 | "An interface to Ctypes' ffi that lives harmoniously with the OCaml garbage collector." 7 | maintainer: ["Matt Walker"] 8 | authors: ["Matt Walker"] 9 | license: "MIT" 10 | tags: ["ffi" "ctypes"] 11 | homepage: "https://github.com/Fizzixnerd/ocaml-living" 12 | bug-reports: "https://github.com/Fizzixnerd/ocaml-living/issues" 13 | depends: [ 14 | "ocaml" 15 | "dune" {>= "3.15"} 16 | "ctypes" 17 | "ounit2" 18 | "odoc" {with-doc} 19 | ] 20 | build: [ 21 | ["dune" "subst"] {dev} 22 | [ 23 | "dune" 24 | "build" 25 | "-p" 26 | name 27 | "-j" 28 | jobs 29 | "@install" 30 | "@runtest" {with-test} 31 | "@doc" {with-doc} 32 | ] 33 | ] 34 | dev-repo: "git+https://github.com/Fizzixnerd/ocaml-living.git" 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2024 Matthew Walker 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | # 0.2.0 2 | 3 | * Make setter functions create dependencies with the values they set. (#1) 4 | (Matt Walker) 5 | 6 | - Add tests for new setter functions. (#1) 7 | (Matt Walker) 8 | 9 | # 0.3.0 10 | 11 | * Add Living_core.Make functor 12 | (Matt Walker) 13 | 14 | * Add Living_core_intf module 15 | (Matt Walker) 16 | 17 | - Refactor Living_core 18 | (Matt Walker) 19 | 20 | * Add module configuration 21 | (Matt Walker) 22 | 23 | * Make dependencies a tree instead of a list (thanks @edwintorok for the idea!) 24 | (Matt Walker) 25 | 26 | * Add `Default` module to both Living_core and Living_ctypes, containing 27 | a default implementation of the functor, and remove that default implementation 28 | from being the modules themselves. ie. You will need to change `open Living_core` 29 | to `open Living_core.Default` if you want the same behaviour as before, etc. 30 | (Matt Walker) 31 | 32 | * Fix use-after-free errors in set functions by making dependencies mutable and adding 33 | to them during each `set`-like method. 34 | (Matt Walker) -------------------------------------------------------------------------------- /lib/living_core.ml: -------------------------------------------------------------------------------- 1 | include Living_core_intf 2 | module Default_living_config : LIVING_CONFIG = struct 3 | let log_leak name = 4 | Printf.sprintf 5 | {|Living_core.t value (with name %s) is being garbage collected without 6 | first being freed with Living_core.unsafe_free. 7 | This can cause undefined behaviour, so the collection 8 | of this object has been supressed. If you really wanted it collected, 9 | call Living_core.unsafe_free on it first. Otherwise, this message will display 10 | and you will leak the memory of this value and all its dependencies. To configure 11 | this behavior, see Living_core.LIVING_CONFIG and Living_core.Make. 12 | 13 | Hint: You can use Living_core.named_return to attempt to label this value for debugging 14 | purposes.|} 15 | (name |> Option.value ~default:"") 16 | |> prerr_endline 17 | let should_log = true 18 | let should_prevent_leaks = true 19 | end 20 | 21 | module Types = struct 22 | type dep = Dep : 'a -> dep 23 | 24 | type 'a t = { unsafe_value: 'a; mutable dependencies : dep; name: string option; mutable freed: bool} 25 | end 26 | 27 | module Make (Config: LIVING_CONFIG) : LIVING_CORE = struct 28 | open Types 29 | 30 | type nonrec dep = dep 31 | type nonrec 'a t = 'a t 32 | let _global = ref { unsafe_value = (); dependencies = Dep (); name = Some "_global"; freed = false } 33 | 34 | let construct ?name x deps = 35 | let ret = {unsafe_value = x; dependencies = deps; name; freed = false} in 36 | Gc.finalise (fun x -> 37 | if not x.freed then 38 | if Config.should_log then Config.log_leak x.name; 39 | if Config.should_prevent_leaks then !_global.dependencies <- Dep (x, !_global.dependencies)) 40 | ret; 41 | ret 42 | 43 | let return : 'a -> 'a t = 44 | fun x -> construct x (Dep x) 45 | 46 | let named_return : string -> 'a -> 'a t = 47 | fun name x -> construct ~name x (Dep x) 48 | 49 | let (=>) x y = construct x (Dep (x, y)) 50 | 51 | let add_dep : 'a t -> 'b -> unit = 52 | fun x y -> 53 | x.dependencies <- Dep (x.dependencies, y) 54 | 55 | let unsafe_free x = 56 | x.freed <- true; 57 | x.unsafe_value 58 | 59 | let bind : ('a -> 'b t) -> 'a t -> 'b t = 60 | fun f x -> 61 | let y = f (unsafe_free x) in 62 | y.dependencies <- Dep (y, x.dependencies, y.dependencies); 63 | y 64 | 65 | let (>>=) x f = bind f x 66 | 67 | let map : ('a -> 'b) -> 'a t -> 'b t = 68 | fun f x -> { x with unsafe_value = f x.unsafe_value } 69 | 70 | let keep_alive x = ignore (Sys.opaque_identity x) 71 | 72 | module Let_syntax = struct 73 | let (let*) x f = x |> bind f 74 | 75 | let (let+) x f = x |> map f 76 | 77 | let (let$) x f = 78 | let ret = f x in 79 | keep_alive x; 80 | ret 81 | end 82 | end 83 | 84 | 85 | module Default = Make (Default_living_config) -------------------------------------------------------------------------------- /lib/living_core_intf.ml: -------------------------------------------------------------------------------- 1 | module type LIVING_TYPES = sig 2 | (** A [dep] is a dependency of a value of type ['a t].*) 3 | type dep = Dep : 'a -> dep 4 | 5 | (** An ['a t] is an value of type ['a] along with its 6 | dependencies. In particular, the dependencies cannot be garbage 7 | collected while this structure lives. This makes it suitable for 8 | encoding dependencies between, say, FFI structures and pointers 9 | for the garbage collector. *) 10 | type 'a t 11 | end 12 | 13 | module type LIVING_CORE = sig 14 | type dep 15 | type 'a t 16 | 17 | (** [bind f x] returns the result of applying the function [f] to 18 | [x.unsafe_value], adding to it the dependencies of [x] itself. *) 19 | val bind : ('a -> 'b t) -> 'a t -> 'b t 20 | 21 | (** [return x] injects an ['a] into an ['a t], whose only dependency is itself.*) 22 | val return : 'a -> 'a t 23 | 24 | (** [named_return name x] injects an [x : 'a] into an ['a t], whose only dependency 25 | is itself. Provides an explicit [name : string] for help with debugging 26 | erroneous garbage collections without a call to [unsafe_free].*) 27 | val named_return : string -> 'a -> 'a t 28 | 29 | (** [unsafe_free x] allows [x] to be garbage collected, and prevents the normal warning 30 | that accompanies a ['a Living_core.t] being garbage collected. Beware: this 31 | is an unsafe operation that can lead to segfaults and bad data. It is 32 | recommended that you either bundle all structs and pointers that comprise the 33 | ['a]'s true dependencies into another type (in the case that you need to 34 | maintain access to foreign data), or marshall all the data you want to OCaml 35 | values directly (when you don't). 36 | 37 | Consider the use of this function an optimization that you should measure your 38 | need for before you reach for it. *) 39 | val unsafe_free : 'a t -> 'a 40 | 41 | (** [add_dep x y] mutates the dependencies of [x] to include [y].*) 42 | val add_dep : 'a t -> 'b -> unit 43 | 44 | (** [map f x] maps over the inner [x.unsafe_value] without modifying 45 | its dependencies. Note that since [bind], [return], and [(=>)] are 46 | the only safe ways of constructing an ['a t], that these dependencies 47 | always include the never-mapped-over original [unsafe_value]. *) 48 | val map : ('a -> 'b) -> 'a t -> 'b t 49 | 50 | (** [x => y] ensures that [y] lives at least as long as [x] does, by wrapping 51 | [x] in a ['a t] and adding both [x] and [y] as dependencies. Note that this 52 | operator works on OCaml lists, tuples, and arrays too, if you need to keep 53 | multiple objects as dependencies. *) 54 | val (=>): 'a -> 'b -> 'a t 55 | 56 | (** See [bind]. *) 57 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 58 | 59 | (** [keep_alive x] provides a weaker guarantee than ['a t] in that [x] (and not 60 | things [x] depends on, if [x] is not of type ['a t]) is kept alive up the 61 | point where this function is called. *) 62 | val keep_alive : 'a -> unit 63 | 64 | module Let_syntax : sig 65 | val (let*) : 'a t -> ('a -> 'b t) -> 'b t 66 | 67 | val (let+) : 'a t -> ('a -> 'b) -> 'b t 68 | 69 | (** This is a simple binding operator for keeping the bound variable alive for 70 | the whole time it is in scope.*) 71 | val (let$) : 'a -> ('a -> 'b) -> 'b 72 | end 73 | end 74 | 75 | module type LIVING_CONFIG = sig 76 | val log_leak : string option -> unit 77 | val should_log: bool 78 | val should_prevent_leaks: bool 79 | end 80 | 81 | -------------------------------------------------------------------------------- /test/test_living.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Living 3 | module Living_core = Living_core.Default 4 | module Living_ctypes = Living_ctypes.Default 5 | 6 | module Living_ctypes_tests = struct 7 | 8 | let strchr = Ctypes.(Foreign.foreign "strchr" (ptr char @-> char @-> returning (ptr char))) 9 | 10 | type t 11 | let s : t Ctypes.structure Ctypes.typ = Ctypes.structure "dummy" 12 | let x_f = Ctypes.field s "x" (Ctypes.ptr Ctypes.int) 13 | let () = Ctypes.seal s 14 | 15 | let test_deadness_simple = 16 | let open Ctypes in 17 | "Test should usually fail because of UB" >:: 18 | (fun _ -> 19 | let correct = ref 0 in 20 | for _i = 0 to 999 do 21 | let p = CArray.start (CArray.of_string "abc") in 22 | let q = strchr p 'a' in 23 | let () = Gc.compact () in 24 | let c = !@ q in 25 | if Char.(equal c 'a') then correct := !correct + 1 26 | done; 27 | if !correct = 1000 then assert_failure "q was fine!") 28 | 29 | let test_liveness_simple = 30 | (* Define a "safe" strchr *) 31 | let strchr xs c = Living_core.(strchr xs c => xs) in 32 | 33 | let open Living_core.Let_syntax in 34 | let open Living_ctypes in 35 | "Test should pass with Living" >:: 36 | (fun _ -> 37 | let correct = ref 0 in 38 | for _i = 0 to 999 do 39 | let x = 40 | let* p = CArray.start (CArray.of_string "abc") in 41 | let* q = strchr p 'a' in 42 | let () = Gc.compact () in 43 | let* c = !@ q in 44 | if Char.(equal c 'a') then correct := !correct + 1; 45 | Living_core.named_return "final value" () 46 | in Living_core.unsafe_free x 47 | done; 48 | assert_equal ~cmp:Int.equal ~msg:"At least one failure" !correct 1000) 49 | 50 | let test_deadness_set = 51 | let open Ctypes in 52 | "Test should usually fail because of UB" >:: 53 | (fun _ -> 54 | let correct = ref 0 in 55 | for _i = 0 to 999 do 56 | let y = allocate_n ~count:1 s in 57 | let x = allocate int 7 in 58 | let x' = y |-> x_f in 59 | let () = x' <-@ x in 60 | let () = Gc.compact () in 61 | let x'' = !@ !@ x' in 62 | if x'' = 7 then correct := !correct + 1 63 | done; 64 | if !correct = 1000 then assert_failure "x' didn't die!") 65 | 66 | let test_liveness_set = 67 | let open Living_core.Let_syntax in 68 | let open Living_ctypes in 69 | "Test pass with Living" >:: 70 | (fun _ -> 71 | let correct = ref 0 in 72 | for _i = 0 to 999 do 73 | let x = 74 | let* y = allocate_n ~count:1 s in 75 | let* x = allocate int 7 in 76 | let x' = y |-> x_f in 77 | let* () = x' <-@ x in 78 | let () = Gc.compact () in 79 | let* x'' = Living_core.bind (!@) (Living_core.bind (!@) x') in 80 | if x'' = 7 then correct := !correct + 1; 81 | Living_core.named_return "final value" () 82 | in Living_core.unsafe_free x 83 | done; 84 | assert_equal ~cmp:Int.equal ~msg:"At least one failure" !correct 1000) 85 | 86 | let test_ptr = Living_ctypes.allocate_n ~count:1 s 87 | 88 | let test_no_use_after_free = 89 | let open Living_core.Let_syntax in 90 | let open Living_ctypes in 91 | "Test avoids use-after-free bug present in https://fizzixnerd.com/blog/2024-07-17-touring-the-living-library/" >:: 92 | (fun _ -> 93 | let correct = ref 0 in 94 | for _i = 0 to 999 do 95 | let y = 96 | let n = Random.int 100 in 97 | let* x = allocate int n in 98 | let* test_ptr' = test_ptr in 99 | let x' = test_ptr' |-> x_f in 100 | let* () = x' <-@ x in 101 | let () = Gc.compact () in 102 | let* x'' = Living_core.bind (!@) (Living_core.bind (!@) x') in 103 | if x'' = n then correct := ! correct + 1; 104 | Living_core.named_return "final_value" () 105 | in Living_core.unsafe_free y 106 | done; 107 | assert_equal ~cmp:Int.equal ~msg:"At least one failure" !correct 1000) 108 | 109 | let suite = "Living_ctypes tests" >::: 110 | [ test_liveness_simple; 111 | test_deadness_simple; 112 | test_liveness_set; 113 | test_deadness_set; 114 | test_no_use_after_free ] 115 | 116 | end 117 | 118 | let suite = Living_ctypes_tests.suite 119 | 120 | let () = run_test_tt_main suite 121 | 122 | let () = Gc.compact() -------------------------------------------------------------------------------- /lib/living_ctypes.ml: -------------------------------------------------------------------------------- 1 | module Make (LCore: Living_core_intf.LIVING_CORE) = struct 2 | 3 | include Ctypes 4 | 5 | (** [!@ p] dereferences the pointer [p], wrapped in an [LCore.t]. 6 | The dependencies include the original pointer. If the reference 7 | type is a scalar type then dereferencing constructs a new value. 8 | If the reference type is an aggregate type then dereferencing 9 | returns a value that references the memory pointed to by p. *) 10 | let (!@) p = LCore.(!@ p => p) 11 | 12 | (** If [p] is a pointer to an array element then [p +@ n] computes 13 | the address of the [n]th next element, wrapped in an [LCore.t]. 14 | The dependencies include the original pointer. *) 15 | let (+@) p n = LCore.(p +@ n => p) 16 | 17 | (** If [p] is a pointer to an array element then [p +@ n] computes 18 | the address of the [n]th previous element, wrapped in an [LCore.t]. 19 | The dependencies include the original pointer. *) 20 | let (-@) p n = LCore.(p -@ n => p) 21 | 22 | (** [allocate t v] allocates a fresh value of type [t], initialises it 23 | with [v] and returns its address, wrapped in an [LCore.t]. 24 | The dependencies include the argument [v]. The argument [?finalise], 25 | if present, will be called just before the memory is freed. The value 26 | will be automatically freed after no references to the pointer remain 27 | within the calling OCaml program. *) 28 | let allocate ?finalise typ x = LCore.(allocate ?finalise typ x => x) 29 | 30 | (** [allocate_n ~count t] allocates [count] fresh values of type [t], and 31 | returns its address, wrapped in an [LCore.t]. The dependencies include 32 | only the returned value, but the value is returned within an [LCore.t] so 33 | that dependencies can be tracked when you later use [setf] or [(<-@)] with 34 | it. 35 | 36 | The argument [?finalise], if present, will be called just before the 37 | memory is freed. The value will be automatically freed after no references 38 | to the pointer remain within the calling OCaml program.*) 39 | let allocate_n ?finalise ~count typ = LCore.(return (allocate_n ?finalise ~count typ)) 40 | 41 | (** [getf s f] retrieves the value of the field [f] in the structure or 42 | union [s], wrapped in an [LCore.t]. The dependencies include the 43 | original structure. The semantics for non-scalar types are 44 | non-copying, as for [(!@)]. *) 45 | let getf s f = LCore.(getf s f => s) 46 | 47 | (** [setf s f v] overwrites the value of the field [f] in the structure or union 48 | [s] with [v], and returns a [unit] wrapped in an [LCore.t]. The dependencies 49 | include [v]. *) 50 | let setf s f x = 51 | LCore.add_dep s x; 52 | LCore.map (fun s' -> setf s' f x) s 53 | 54 | (** [s @. f] computes the address of the field [f] in the structure or 55 | union value [s], wrapped in an [LCore.t]. The dependencies include 56 | the original structure. *) 57 | let (@.) s f = LCore.(s @. f => s) 58 | 59 | (** [p |-> f] computes the address of the field [f] in the structure or 60 | union value pointed to by [p], wrapped in an [LCore.t]. The 61 | dependencies include the original pointer. *) 62 | let (|->) p f = LCore.(p |-> f => p) 63 | 64 | (** [p <-@ v] writes the value [v] to the address [p], and returns a [unit] 65 | wrapped in an [LCore.t]. The dependencies include [v]. *) 66 | let (<-@) p x = 67 | LCore.add_dep p x; 68 | LCore.map (fun p' -> p' <-@ x) p 69 | 70 | (** [addr s] returns the address of the structure or union [s], wrapped 71 | in a [LCore.t]. The dependencies include the original structure. *) 72 | let addr s = LCore.(addr s => s) 73 | 74 | (** Operations on C arrays. *) 75 | module CArray = struct 76 | include Ctypes.CArray 77 | 78 | (** [get a n] returns the [n]th element of the zero-indexed array [a], wrapped 79 | in a [LCore.t]. The dependencies include the original array. The 80 | semantics for non-scalar types are non-copying, as for {!(!@)}. 81 | 82 | If you rebind the [CArray] module to [Array] then you can also use the 83 | syntax [a.(n)] instead of [Array.get a n]. 84 | 85 | Raise [Invalid_argument "index out of bounds"] if [n] is outside of the 86 | range [0] to [(CArray.length a - 1)]. *) 87 | let get a n = LCore.(get a n => a) 88 | 89 | (** [set a n v] overwrites the [n]th element of the zero-indexed array [a] with [v]. 90 | 91 | If you rebind the [CArray] module to [Array] then you can also use the [a.(n) <- v] 92 | syntax instead of [Array.set a n v]. 93 | 94 | Raise [Invalid_argument "index out of bounds"] if [n] is outside of the range [0] 95 | to [(CArray.length a - 1)]. *) 96 | let set a n x = 97 | LCore.add_dep a x; 98 | LCore.map (fun a' -> set a' n x) a 99 | 100 | (** [map t f a] is analogous to [Array.map f a]: it creates a new array with 101 | element type [t] whose elements are obtained by applying [f] to the 102 | elements of [a], except the result is wrapped in an [LCore.t]. The 103 | dependencies include the original array. *) 104 | let map t f a = LCore.(=>) (map t f a) a 105 | 106 | (** [mapi] behaves like {!Array.mapi}, except that it also passes the 107 | index of each element as the first argument to [f] and the element 108 | itself as the second argument. The result is wrapped in an [LCore.t]. 109 | The dependencies include the original array. *) 110 | let mapi t f a = LCore.(mapi t f a => a) 111 | 112 | (** [CArray.fold_left (@) x a] computes 113 | [(((x @ a.(0)) @ a.(1)) ...) @ a.(n-1)] 114 | where [n] is the length of the array [a]. The result is wrapped in a 115 | [LCore.t]. The dependencies include the original array. *) 116 | let fold_left f x a = LCore.(fold_left f x a => a) 117 | 118 | (** [CArray.fold_right f a x] computes 119 | [a.(0) @ (a.(1) @ ( ... (a.(n-1) @ x) ...))] 120 | where [n] is the length of the array [a]. The result is wrapped in a 121 | [LCore.t]. The dependencies include the original array. *) 122 | let fold_right f a x = LCore.(fold_right f a x => a) 123 | 124 | (** Return the address of the first element of the given array, wrapped in a 125 | [LCore.t]. The dependencies include the original array. *) 126 | let start a = LCore.(start a => a) 127 | 128 | (** [from_ptr p n] creates an [n]-length array reference to the memory at 129 | address [p], wrapped in an [LCore.t]. The dependencies include 130 | the original pointer. *) 131 | let from_ptr p n = LCore.(from_ptr p n => p) 132 | 133 | end 134 | end 135 | 136 | module Default = Make(Living_core.Default) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Living 2 | 3 | This is an addon library for `Ctypes` that provides stronger guarantees about the lifetimes of foreign object allocated from OCaml. See [this blog post](https://fizzixnerd.com/blog/2024-07-11-a-possibly-safer-interface-to-the-ctypes-ffi/) for the original motivation. 4 | 5 | ## Classic Example of the Problem `Living` Solves 6 | 7 | Consider the following plain `Ctypes` code: 8 | 9 | ```ocaml 10 | open Ctypes 11 | 12 | (** Returns a pointer into the argument character string that points to the first 13 | instance of the argument character. *) 14 | let strchr : char ptr -> char -> char ptr = 15 | Foreign.foreign "strchr" (ptr char @-> char @-> returning (ptr char)) 16 | 17 | let () = 18 | let p = CArray.of_string "abc" |> CArray.start in 19 | let q = strchr p 'a' in 20 | let () = Gc.compact () in 21 | let c = !@ q in 22 | if Char.(equal c 'a') then print_endline "yay!" else print_endline "boo!" 23 | ``` 24 | 25 | This code will almost always print "boo!" (run `dune test` if you don't believe me!). The issue is that `p` does not appear after the `Gc.compact ()`, and since the garbage collector has no knowledge of the implicit dependency between `p`, `q`, and `c`, in that `q` points into `p` (and so its dereference `c` is only valid as long as `p` continues to live) it collects `p` during compaction. 26 | 27 | The idea of this library is to provide a way of encoding this dependency semi-automatically. 28 | 29 | The first step is to define a `strchr` that knows about the dependency of its return value on its argument. 30 | 31 | ```ocaml 32 | open Living 33 | open Living_ctypes 34 | 35 | let strchr : char ptr -> char -> char ptr Living_core.t = 36 | let strchr_unsafe = Foreign.foreign "strchr" (ptr char @-> char @-> returning (ptr char)) in 37 | fun s c -> Living_core.(strchr_unsafe s c => s) 38 | ``` 39 | 40 | Here, we have used `(=>)` operator to encode the information that `strchr_unsafe s c` being alive _implies_ that `s` must be alive too, in order for the program to be correct. Next, we replace any operations that can create dependant values in `Ctypes` with their `Living` counterparts, and replace the `let`s that bind them with `let*`s instead. We also need to return a value of type `'a Living.t`, so we just return a `unit` wrapped in this type. 41 | 42 | ```ocaml 43 | let _ = 44 | let open Living_core.Let_syntax in 45 | let* p = CArray.of_string "abc" |> Living_core.bind CArray.start in 46 | let* q = strchr p 'a' in 47 | let () = Gc.compact () in 48 | let* c = !@ q in 49 | if Char.(equal c 'a') then print_endline "yay!" else print_endline "boo!" 50 | Living_core.return () 51 | ``` 52 | 53 | Other than that, the code is now correct. Run it and it will _always_ print "yay!". That's all there is to it! 54 | 55 | ## Wrapping C Functions Properly 56 | 57 | The key step we needed to do manually is to encode the dependence of `strchr_unsafe`'s return value on its argument. This can take many forms, as C has many ways of returning values. The details are up to the FFI binding author to get right, but here are some hints: 58 | 59 | 1. Always add to pointers into structures their dependence on the structure. 60 | 2. Rewrite "output"-pointer-containing functions to return tuples instead, so that dependency is easier to track. 61 | 62 | ## Dropping Dependencies 63 | 64 | It is often useful to allow the GC to collect garbage, so you generally don't want your whole program to be wrapped in a `Living_core.t` containing every dependency in it. Remember however, that this is an _optimization_, and should only be attempted once you know you need to by measuring performance. If you mess this up, you can get segfaults, and often it's good enough to just let stuff fall out of scope. 65 | 66 | If you have measured performance and found you need to drop dependencies, you can do so by calling the `Living_core.unsafe_free` function. This returns the current value of the computation _without_ its dependencies. Some care must be taken however. 67 | 68 | The process looks like this: 69 | 70 | 1. Take your `'a Living_core.t` and figure out if it has any pointers or structures that have been allocated by `malloc`, `Ctypes.allocate`, `Ctypes.allocate_n` or the like. 71 | 2. If it does not, proceed to step 4. 72 | 3. If it does, then copy all that data into OCaml heap objects that can't be GC'd from underneath you like an off-heap pointer can be, by using `Living_core.map` or `Living_core.bind` to map the `'a` to a new, safer `'b` 73 | 4. Call `Living_core.unsafe_free`. 74 | 75 | It is important to do step 3. properly. Here are two examples; the first you should never do. 76 | 77 | ```ocaml 78 | (* Bad Example *) 79 | (*** NEVER DO THIS ***) 80 | let _ = 81 | let my_dependencyless_char = 82 | CArray.of_string "abc" 83 | |> Living_core.bind CArray.start 84 | |> Living_core.bind (fun q -> strchr p 'a') in 85 | (* Bad assumption: We don't care about q after we derefence it, since the char is copied to OCaml, so we use the non-wrapped version of !@ from base Ctypes on just the value. *) 86 | |> fun my_dependencyful_char_ptr -> Ctypes.(!@) (Living_core.unsafe_free my_dependencyful_char_ptr) 87 | in 88 | Printf.printf "%c\n" my_dependencyless_char 89 | ``` 90 | 91 | The problem is that, at least theoretically, `Ctypes.(!@)` could call the garbage collector _before_ it dereferences the pointer `q.unsafe_value`. This would land us back in hot water. Instead, prefer the following idiom: 92 | 93 | ```ocaml 94 | (* Good Example *) 95 | (*** DO THIS ***) 96 | let _ = 97 | let my_dependencyless_char = 98 | CArray.of_string "abc" 99 | |> Living_core.bind CArray.start 100 | |> Living_core.bind (fun p -> strchr p 'a') 101 | |> Living_core.map Ctypes.(!@) (* Key idea: map with !@ _inside_ the Living_core.t context! *) 102 | |> Living_core.unsafe_free (* And only the call unsafe_free *) 103 | in 104 | Printf.printf "%c\n" my_dependencyless_char 105 | ``` 106 | 107 | That is, you should do all the mapping you need to do to get to a safe, OCaml-copied value _within_ the context of the `Living_core.t`, before finally calling `Living_core.unsafe_free`. 108 | 109 | In this second example, even if `Ctypes.(!@)` calls the garbage collector, the `Living` library ensures that the C string "abc" will not be collected out from under you. 110 | 111 | ## Configuring the Library 112 | 113 | `Living_core` can be configured in a variety of ways using the `Living_core.Make` functor. 114 | 115 | 1. One may provide their own logging function `log_leak`, which is passed an `string option` possibly containing the name of the leaked `Living_core.t` 116 | 2. One may disable leak logging entirely by setting `should_log` to `false`. 117 | 3. One may disable the safety net of preventing leaking of `Living_core.t`s which haven't been `unsafe_free`d by setting `should_prevent_leaks` to false. This is an optimization and only recommended if you're sure you've got stuff right. Segfaults await the uncareful programmer. 118 | 119 | One my use default implementations of all of these things by accessing the `Living_core.Living_config_default` or even more simply by using the instantiated functor `Living_core.Default`. 120 | 121 | ## Using the Library 122 | 123 | If you choose to use `Living` library in a project `Foo` then please _also_ make it a functor of type `module Living_core_intf.LIVING_CORE -> module FOO`. This way users of your module can configure the `LIVING_CORE` implementation used to agree with other libraries they are using. Some users might prefer to disable logging, to log to some special logger, or to disable safety after optimizing their usage, for example. However, I would imagine many bindings would prefer to not expose their explicit dependence on `Living` at _all_, so if this is the case feel free to configure the module yourself -- just know you might be limiting some specific class of users. An alternative is to provide a default implementation, as `Living_ctypes` and `Living_core` do. --------------------------------------------------------------------------------