Source file Cap.ml

(**************************************************************************)
(* Prelude *)
(**************************************************************************)
(* Capabilities implemented as simple abstract types and explicit
 * arguments/parameters, "Lambda the ultimate security tool".
 *
 * references:
 *  - https://en.wikipedia.org/wiki/Capability-based_security
 *  - "Computer Systems Security Session 6: Capabilities" accessible at
 *    https://www.youtube.com/watch?v=TQhmua7Z2cY
 *    by Zeldovich and Mickens, Fall 2014. Good introduction.
 *  - https://roscidus.com/blog/blog/2023/04/26/lambda-capabilities/
 *
 * related work:
 *  - TODO: https://www.redox-os.org/news/nlnet-cap-nsmgr-cwd/
 *  - TODO: recent OCaml lib for openBSD:
 *    https://codeberg.org/removewingman/restricted
 *  - https://en.wikipedia.org/wiki/E_(programming_language) which
 *    itself led to Emily which was about adding capabilities in OCaml
 *    https://www.hpl.hp.com/techreports/2006/HPL-2006-116.html
 *  - EIO capabilities for network, fs, io, etc.
 *    see especially Eio_unix.Stdenv.base, (see the blog post above)
 *  - Android's permissions, iphone permissions; every mobile OS is
 *    using capabilities/permissions
 *  - Capability-based version of the Rust standard library
 *    https://github.com/bytecodealliance/cap-std
 *    I actually defined independently almost the same list of capabilities
 *    (tmp, random, fs, net) than they have
 *  - deno (a nodejs fork) sandboxed environment
 *  - TODO: "A Security Kernel Based on the Lambda-Calculus", Jonathan A. Rees,
 *    https://dspace.mit.edu/handle/1721.1/5944
 *  - TODO: "Effects, Capabilities, and Boxes"
 *    https://dl.acm.org/doi/pdf/10.1145/3527320
 *  - Effects as capabilities
 *    https://dl.acm.org/doi/10.1145/3428194
 *  - Effects in Scala
 *    https://dotty.epfl.ch/docs/reference/experimental/canthrow.html
 *  - ... lots of related work
 *
 * alt:
 *  - use an effect system, but not ready yet for OCaml
 *  - use semgrep rules, but this would be more of a blacklist approach
 *    whereas here it is more a whitelist approach
 *    update: we actually combine Cap with semgrep rules now, see
 *    the use-caps and do-not-use-xxx rules in semgrep.jsonnet.
 *
 * history:
 *  - use plain records to encode caps statically
 *  - use object types of OCaml as extensible records to encode caps statically
 *    (as done originally in EIO but they later switched to (ugly) open variants
 *     because of Jane Street's hate of objects)
 *    Using plain records was simpler, however, objects,
 *    which can be seen as extensible records, are nice because you can have
 *    signatures like <network: Cap.Network.t; fs: Cap.FS.t> without having
 *    to name this type and without having to introduce yet another record
 *    for the combination of those two capabilities.
 *    Objects are a bit to records what polymorphic variants are to variants,
 *    that is [ taint | search ] allow to merge variants without introducing
 *    an intermediate name. Polymorphic variants are extensible Sum types,
 *    objects are extensible Product types!
 *  - use intermediate types like shortcut 'type open_in = <open_in: FS.open_in>'
 *    that can be combined (and even concatenated) easily with
 *    '<Cap.open_in; Cap.stdout; Cap.forkew>'
 *  - use '..' as in '< Cap.open_in; Cap.stdout; ..>'
 *  - add dynamic checks too so one can override also dynamically caps!
 *    Thx to the new 'type open_in = <open_in: string -> FS.open_in>'.
 *    Now we need to access the caps in CapSys.ml for example to give the
 *    opportunity to raise an exn in some overriden caps.
 *
 * LATER:
 *  - could move in xix/lib_system/ at some point
 *  - exn caps (ability to throw or not certain exn) that you can see
 *    in the type?
 *  - comparison caps? forbid polymorphic equal, forbid compare, force deriving
 *  - refs? (and globals)
 *
 * Assumed (ambient) capabilities:
 *  - The RAM (see Memory_limit.ml for some limits)
 *  - The CPU (see Time_limit.ml for some limits)
 *)

(**************************************************************************)
(* Core type *)
(**************************************************************************)

(* Note that it is important for this type to NOT be exported in Cap.mli!
 * Each capability must be seen as an independent abstract type.
 *)
type cap = unit

(**************************************************************************)
(* Network *)
(**************************************************************************)

(* TODO: sub caps? host, url, ports, get vs post? or restrict dynamically ?*)
module Network = struct
  type t = cap
end

(**************************************************************************)
(* FS *)
(**************************************************************************)

module FS_ = struct
  type readdir = cap
  type tmp = cap
  type open_in = cap
  type open_out = cap
end

(**************************************************************************)
(* Files *)
(**************************************************************************)
(* The OCaml in_channel and out_channel are already good capabilities we
 * can reuse.
 *)

(**************************************************************************)
(* Exec *)
(**************************************************************************)

(* TODO: sub caps exec a particular program 'git_cmd Exec.t' or dynamic? *)
module Exec = struct
  type t = cap
end

(**************************************************************************)
(* Process *)
(**************************************************************************)

module Process = struct
  (* basic stuff *)
  type argv = cap
  type env = cap

  (* advanced stuff *)
  type exit = cap
  type chdir = cap

  (* TODO: split signal? use subtypes to make alarm a subtype of signal?*)
  type signal = cap

  (* multi processes *)
  type fork = cap
  type wait = cap
  type kill = cap
  (* pipe? not sure it requires a cap; it's a local thing *)

  (* old: was alarm, but better rename to be consistent with memory_limit
   * See libs/process_limits/
   *)
  type time_limit = cap
  type memory_limit = cap

  (* plan9 caps *)
  type mount = cap
  type bind = cap
end

(**************************************************************************)
(* Console *)
(**************************************************************************)

(* TODO: ugly: but I had to rename Console and FS to add an underscore
 * because ocamldep in ocaml-light does not handle nested module well
 * and if I use Console below I then get a cycle when compiling.
 * This seems to be an issue only if the file Console.ml or FS.ml
 * exist. Otherwise like for Process.ml it does not generate the
 * dependency, even if it's a nested module like the other.
 * WEIRD
 *)
(* alt: could be part of Process *)
module Console_ = struct
  type stdin = cap
  type stdout = cap
  type stderr = cap

  (* plan9 caps *)
  type draw = cap
  type keyboard = cap
  type mouse = cap
end

(**************************************************************************)
(* Misc *)
(**************************************************************************)

module Misc = struct
  (* useful to be sure the program is deterministic and is not calling
   * any random generator functions.
   *)
  type random = cap

  (* supposedely important for side-channel attack *)
  (* type time = cap *)
end

(**************************************************************************)
(* Shortcuts *)
(**************************************************************************)

(* fs *)
type readdir = < readdir : string (* path *) -> FS_.readdir >
type tmp = < tmp : FS_.tmp >
type open_in = < open_in : string (* path *) -> FS_.open_in >
type open_out = < open_out : string (* path *) -> FS_.open_out >
type fs = < readdir ; tmp; open_in; open_out >

(* console *)
type stdin = < stdin : Console_.stdin >
type stdout = < stdout : Console_.stdout >
type stderr = < stderr : Console_.stderr >
type draw = < draw : Console_.draw >
type keyboard = < keyboard : Console_.keyboard >
type mouse = < mouse : Console_.mouse >
type console = < stdin ; stdout ; stderr; draw; keyboard; mouse >


(* process *)
type argv = < argv : Process.argv >
type env = < env : Process.env >
type signal = < signal : Process.signal >
type time_limit = < time_limit : Process.time_limit >
type memory_limit = < memory_limit : Process.memory_limit >
type exit = < exit : Process.exit >
type chdir = < chdir : Process.chdir >
type fork = < fork : Process.fork >
type wait = < wait : Process.wait >
type kill = < kill : Process.kill >
type mount = < mount : Process.mount >
type bind = < bind: Process.bind >
type process_multi = < fork; wait; kill >
type process_single = < signal ; time_limit ; memory_limit ; exit ; chdir; mount; bind >
type process = < argv ; env; process_single ; process_multi >

(* exec *)
type exec = < exec : string (* cmd *) -> Exec.t >
(* shortcut *)
type forkew = < fork; exec; wait >

(* networl *)
type network = < network : string (* IP *) -> Network.t >

(* misc *)
type random = < random : Misc.random >
type misc = < random >

(* alt: called "Stdenv.Base.env" in EIO *)
type all_caps =
  < console
  ; process
  ; fs (* a mix of fs and process_multi as it requires both *)
  ; exec
  ; network
  ; misc >

type no_caps = < >

let no_caps : no_caps = object end

(**************************************************************************)
(* The powerbox *)
(**************************************************************************)
(* Entry point giving all the authories, a.k.a. the "Powerbox"
 *
 * references:
 *  - "How Emily Tamed the Caml"
 *     https://www.hpl.hp.com/techreports/2006/HPL-2006-116.html
 *
 * Note that you can further restrict dynamically capabilities by
 * overriding the passed object. For example, here is some code from
 * oed to further restrict exec/open:
 *
 *    type caps = < Cap.exec; Cap.open_in; Cap.open_out; Cap.fork; Cap.stdin>
 *    let restrict_caps rflag (x : < caps; ..>) =
 *      object
 *        method exec _cmd = 
 *          if rflag then failwith "!restricted mode on!"
 *          else x#exec cmd
 *        method open_in file = 
 *          if rflag && not (Fpath.is_seg file)
 *          then failwith (spf "!restricted mode on, can't read %s!" file)
 *          else x#open_in file
 *        method open_out file = 
 *          if rflag && not (Fpath.is_seg file) &&
 *             (* need open_out to delete tmp file in Commands.quit() *)
 *             not (file = !!Env.tfname)
 *          then failwith (spf "!restricted mode on, can't write %s!" file)
 *          else x#open_out file
 *        method fork = x#fork
 *        ...
 *      end
 *)

let powerbox : all_caps =
  object
    (* fs *)
    method readdir _path = ()
    method tmp = ()
    method open_in _path = ()
    method open_out _path = ()

    (* console *)
    method stdin = ()
    method stdout = ()
    method stderr = ()
    method draw = ()
    method keyboard = ()
    method mouse = ()

    (* process *)
    method argv = ()
    method env = ()
    method chdir = ()
    method signal = ()
    method time_limit = ()
    method memory_limit = ()
    method fork = ()
    method wait = ()
    method kill = ()
    method exit = ()
    method mount = ()
    method bind = ()

    (* misc *)
    method random = ()

    (* dangerous stuff *)
    method exec _cmd = ()
    method network _ip = ()
  end

(**************************************************************************)
(* Temporary unsafe caps to help migration *)
(**************************************************************************)

(* !!DO NOT USE!! *)
let tmp_caps_UNSAFE () =
  object
    method tmp = ()
  end


(*
-let network_caps_UNSAFE () =
-  object
-    method network = ()
-  end
-(* !!DO NOT USE!! *)
-let stdout_caps_UNSAFE () =
-  object
-    method stdout = ()
-  end
-
-(* !!DO NOT USE!! *)
-let caps_for_js_UNSAFE () =
-  object
-    method fork = ()
-    method time_limit = ()
-    method memory_limit = ()
-    method readdir = ()
-  end
-
-(* !!DO NOT USE!! *)
-let exec_and_tmp_caps_UNSAFE () =
-  object
-    method exec = ()
-    method tmp = ()
-  end
-
-let readdir_UNSAFE () =
-  object
-    method readdir = ()
- end
*)

(**************************************************************************)
(* Entry point *)
(**************************************************************************)

let already_called_main = ref false

(* In addition to the dynamic check below, we could also
 * write a semgrep rule to forbid any call to Cap.main() except
 * in Main.ml (via a nosemgrep or paths: exclude:)
 *)
let main (f : all_caps -> 'a) : 'a =
  (* can't cheat :) can't nest them *)
  if !already_called_main then failwith "Cap.main() already called"
  else (
    already_called_main := true;
    f powerbox)