Source file `dl.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
# 1 "src/ctypes-foreign/dl.ml.unix"
(*
 * Copyright (c) 2013 Jeremy Yallop.
 *
 * This file is distributed under the terms of the MIT License.
 * See the file LICENSE for details.
 *)

[@@@ocaml.warning "-16"]

type library

type flag = 
    RTLD_LAZY
  | RTLD_NOW
  | RTLD_GLOBAL
  | RTLD_LOCAL
  | RTLD_NODELETE
  | RTLD_NOLOAD
  | RTLD_DEEPBIND

exception DL_error of string

(* void *dlopen(const char *filename, int flag); *)
external _dlopen : ?filename:string -> flags:int -> library option
  = "ctypes_dlopen"
    
(* void *dlsym(void *handle, const char *symbol); *)
external _dlsym : ?handle:library -> symbol:string -> nativeint option
  = "ctypes_dlsym"

(* int dlclose(void *handle); *)
external _dlclose : handle:library -> int
  = "ctypes_dlclose"

(* char *dlerror(void); *)
external _dlerror : unit -> string option
  = "ctypes_dlerror"

external resolve_flag : flag -> int
  = "ctypes_resolve_dl_flag"

let _report_dl_error noload =
  match _dlerror () with
    | Some error -> raise (DL_error (error))
    | None       ->
      if noload then
        raise (DL_error "library not loaded")
      else
        failwith "dl_error: expected error, but no error reported"

let crush_flags f : 'a list -> int = List.fold_left (fun i o -> i lor (f o)) 0

[@@@warning "-16"]
let dlopen ?filename ~flags =
  match _dlopen ?filename ~flags:(crush_flags resolve_flag flags) with
    | Some library -> library
    | None         -> _report_dl_error (List.mem RTLD_NOLOAD flags)

let dlclose ~handle =
  match _dlclose ~handle with
    | 0 -> ()
    | _ -> _report_dl_error false

let dlsym ?handle ~symbol =
  match _dlsym ?handle ~symbol with
    | Some symbol -> symbol
    | None        -> _report_dl_error false