This file is indexed.

/usr/lib/ocaml/findlib/findlib.mli is in libfindlib-ocaml-dev 1.4-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
(* $Id: findlib.mli 189 2013-01-14 17:10:28Z gerd $
 * ----------------------------------------------------------------------
 *
 *)

(** The primary findlib interface
 *
 * The Findlib module is the primary interface of the findlib library. It
 * contains functions to look up packages, to interpret META
 * files, and to determine the ancestors of packages.
 *
 * This module must be initialized before it can be used: Call either
 * [init] or [init_manually] for this.
 *)

exception No_such_package of string * string
  (** First arg is the package name not found, second arg contains additional
   * info for the user
   *)

exception Package_loop of string
  (** A package is required by itself. The arg is the name of the 
   * package 
   *)


val init : 
      ?env_ocamlpath: string ->
      ?env_ocamlfind_destdir: string ->
      ?env_ocamlfind_metadir: string ->
      ?env_ocamlfind_commands: string ->
      ?env_ocamlfind_ignore_dups_in: string ->
      ?env_camllib: string ->
      ?env_ldconf: string ->
      ?config: string -> 
      ?toolchain: string ->
      unit ->
	unit
  (** Initializes the library from the configuration file and the environment. 
   * By default the
   * function reads the file specified at compile time, but you can also
   * pass a different file name in the [config] argument.
   *   Furthermore, the environment variables OCAMLPATH, OCAMLFIND_DESTDIR, 
   * OCAMLFIND_COMMANDS, and CAMLLIB are interpreted. By default, the function takes
   * the values found in the environment, but you can pass different values
   * using the [env_*] arguments. By setting these values to empty strings 
   * they are no longer considered.
   *     The result of the initialization is determined as follows:
   * - The default installation directory is the env variable OCAMLFIND_DESTDIR
   *   (if present and non-empty), and otherwise the variable [destdir] of the
   *   configuration file.
   * - The installation directory for META files is read from the env 
   *   variable OCAMLFIND_METADIR (if present and non-empty), and otherwise
   *   from the variable [metadir] of the configuration file, and otherwise
   *   no such directory is used.
   *   The special value ["none"] turns this feature off.
   * - The search path is the concatenation of the env variable OCAMLPATH
   *   and the variable [path] of the config file
   * - The executables of (ocamlc|ocamlopt|ocamlcp|ocamlmklib|ocamlmktop) are
   *   determined as follows: if the env variable OCAMLFIND_COMMANDS is set
   *   and non-empty, its contents specify the executables. Otherwise, if the
   *   config file variables [ocamlc], [ocamlopt], [ocamlcp], [ocamlmklib] and
   *   [ocamlmktop] are set, their contents specify the executables. Otherwise,
   *   the obvious default values are chosen: ["ocamlc"] for [ocamlc],
   *   ["ocamlopt"] for [ocamlopt], and so on.
   * - The directory of the standard library is the value of the environment
   *   variable CAMLLIB (or OCAMLLIB), or if unset or empty, the value of
   *   the configuration variable [stdlib], or if unset the built-in location
   * - The [ld.conf] file (configuring the dynamic loader) is the value of
   *   the environment variable OCAMLFIND_LDCONF, or if unset or empty, the
   *   value of the configuration variable [ldconf], or if unset the
   *   built-in location.
   *)


val init_manually : 
      ?ocamlc_command: string ->       (* default: "ocamlc"     *)
      ?ocamlopt_command: string ->     (* default: "ocamlopt"   *)
      ?ocamlcp_command: string ->      (* default: "ocamlcp"    *)
      ?ocamloptp_command: string ->    (* default: "ocamloptp"   *)
      ?ocamlmklib_command: string ->   (* default: "ocamlmklib" *)
      ?ocamlmktop_command: string ->   (* default: "ocamlmktop" *)
      ?ocamldep_command: string ->     (* default: "ocamldep"   *)
      ?ocamlbrowser_command: string -> (* default: "ocamlbrowser"   *)
      ?ocamldoc_command: string ->     (* default: "ocamldoc"   *)
      ?ignore_dups_in:string ->        (* default: None *)
      ?stdlib: string ->               (* default: taken from Findlib_config *)
      ?ldconf: string ->
      install_dir: string ->
      meta_dir: string ->
      search_path: string list ->
      unit ->
	unit
  (** This is an alternate way to initialize the library directly. 
   * Environment variables and configuration files are ignored.
   *)


val default_location : unit -> string
  (** Get the default installation directory for packages *)

val meta_directory : unit -> string
  (** Get the META installation directory for packages.
   * Returns [""] if no such directory is configured.
   *)

val search_path : unit -> string list
  (** Get the search path for packages *)

val command : [ `ocamlc | `ocamlopt | `ocamlcp | `ocamloptp | `ocamlmklib 
	      | `ocamlmktop | `ocamldep | `ocamlbrowser | `ocamldoc
	      ] -> 
              string
  (** Get the name/path of the executable *)

val ocaml_stdlib : unit -> string
  (** Get the directory of the standard library *)

val ocaml_ldconf : unit -> string
  (** Get the file name of [ld.conf] *)

val package_directory : string -> string
  (** Get the absolute path of the directory where the given package is
   * stored.
   *
   * Raises [No_such_package] if the package cannot be found.
   *)

val ignore_dups_in : unit -> string option
  (** If [Some d], duplicate packages below [d] are ignored, and do not
    * produce warnings.  (Only affects the generation of warnings.)
   *)

val package_property : string list -> string -> string -> string
  (** [package_property predlist pkg propname]:
   * Looks up the property [propname] of package [pkg] under the assumption
   * that the predicates in [predlist] are true.
   *
   * Raises [No_such_package] if the package, and [Not_found] if the property
   * cannot be found.
   *
   * EXAMPLES:
   * - [package_property [] "p" "requires":]
   *   get the value of the [requires] clause of package [p]
   * - [package_property [ "mt"; "byte" ] "p" "archive":]
   *   get the value of the [archive] property of package [p] for multi-
   *   threaded bytecode applications.
   *)

val package_ancestors : string list -> string -> string list
  (** [package_ancestors predlist pkg:]
   * Determines the direct ancestors of package [pkg] under the assumption
   * that the predicates in [predlist] are true, i.e. the names of the
   * packages required by [pkg].
   * The returned list is unsorted.
   *
   * Raises [No_such_package] if the package [pkg] or one of its ancestors
   * could not be found.
   *)

val package_deep_ancestors : string list -> string list -> string list
  (** [package_deep_ancestors predlist pkglist:]
   * determines the list of direct or indirect ancestors of the packages
   * named in [pkglist] under the assumption that the predicates in [predlist]
   * are true. 
   *
   * The returned list is topologically sorted: The first element is the
   * deepest ancestor; the last element is one of [pkglist].
   *
   * Raises [No_such_package] if one of the packages in [pkglist] or one of
   * the ancestors cannot be found. Raises [Package_loop] if there is a
   * cyclic dependency.
   *)

val resolve_path : ?base:string -> string -> string
  (** Resolves findlib notation in filename paths. The notation 
   * [ +name/path ] can be used to refer to the subdirectory [name]
   * of the standard library directory; the continuation [ /path ] is
   * optional. The notation [ \@name/path ] can be used to refer to
   * the directory of the package [name]; the continuation [ /path ]
   * is optional. For these two notations, absolute paths are returned.
   * 
   * @param base When the function is applied on a relative path, the
   *   [base] path is prepended. Otherwise, the path is returned as
   *   it is.
   *)

val list_packages : ?tab:int -> ?descr:bool -> out_channel -> unit
  (** Prints the list of available packages to the [out_channel].
   *
   * @param tab The tabulator width, by default 20
   * @param descr Whether package descriptions are printed. Default: false
   *)