Prototype of object capability in Emacs

Prototype of object capability in Emacs

[Qiantan Hong]

Here is a very rudimentary prototype.
Does it look hopeful?

The way it works: ocaps-make-world makes a “powerless” isolated object graph
(except initially passed in capability). 
ocaps-import takes an object from ambient environment, and remove any capability
not presented in the world bound to special variable ocaps-world. 
It therefore return a proper citizen in ocaps-world without implicitly carrying any additional capability.

See demo at the end.

Also to make a full one I probably need some help on how to properly instrument byte code.
Can someone help?

The code:

;;; ocaps.el --- Object Capabilities  -*- lexical-binding: t; -*-

;; Copyright (C) 2021 Free Software Foundation, Inc.

;; Author: Qiantan Hong <qhong@alum.mit.edu>
;; Maintainer: Qiantan Hong <qhong@alum.mit.edu>
;; URL: https://code.librehq.com/qhong/crdt.el
;; Keywords: internal
;; Version: 0.3.0

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;; This package provides a capability-secure bytecode evaluator.

;;; Code:

(require 'cl-lib)

(cl-defstruct (ocaps-world (:constructor ocaps--make-world))
  obarray symbol-lazy-import-function)

(defvar ocaps-world nil)

(defun ocaps-default-symbol-lazy-import-function (symbol)
  (if (or (keywordp symbol) (memq symbol '(nil t))) ;; what are other constants?
      symbol
    (let ((local-symbol (intern (symbol-name symbol) (ocaps-world-obarray ocaps-world))))
      (when (or (get symbol 'side-effect-free) (get symbol 'safe-local-eval-function))
        (defalias local-symbol symbol))
      local-symbol)))

;; I don't know how to instrument bytecode properly
;; so I'm not implementing read-only capability for now
(defun ocaps-make-world (writable-symbols function-bindings &optional symbol-lazy-import-function)
  "Create a new capability-secure world.
WRITABLE-SYMBOLS is a list of symbols to initially grant writable capability.
FUNCTION-BINDINGS is a list of symbols or conses of the form (symbol . proxy).
If SYMBOL-LAZY-IMPORT-FUNCTION is NIL, use OCAPS-DEFAULT-SYMBOL-LAZY-IMPORT-FUNCTION."
  (let ((ocaps-world
         (ocaps--make-world :obarray (make-vector 15121 0)
                            :symbol-lazy-import-function
                            (or symbol-lazy-import-function #'ocaps-default-symbol-lazy-import-function))))
    (dolist (symbol writable-symbols)
      (defvaralias (intern (symbol-name symbol) (ocaps-world-obarray ocaps-world)) symbol))
    (dolist (function-binding function-bindings)
      (let (symbol proxy)
        (if (consp function-binding)
            (setq symbol (car function-binding) proxy (cdr function-binding))
          (setq symbol function-binding proxy (symbol-function function-binding)))
        (defalias (intern (symbol-name symbol) (ocaps-world-obarray ocaps-world)) proxy)))
    ocaps-world))

(defsubst ocaps--byte-code-map (byte-code function)
  (cl-flet ((map-arglist (arglist) ;; I heard that sometimes arglist is actually a string
              (if (listp arglist) (mapcar function arglist) arglist)))
    (if (consp byte-code)
        (apply #'make-byte-code
               (map-arglist (nth 1 byte-code))
               (nth 2 byte-code)
               (map 'vector function (nth 3 byte-code))
               (nthcdr 4 byte-code))
      (apply #'make-byte-code (map-arglist (aref byte-code 0)) (aref byte-code 1)
             (map 'vector function (aref byte-code 2))
             (aref byte-code 3)
             (when (> (length byte-code) 4) (aref byte-code 4))
             (when (> (length byte-code) 5) (aref byte-code 5))))))

(defvar ocaps-subr-to-symbol-map
  (let (result)
    (mapatoms
     (lambda (symbol)
       (when (and (fboundp symbol) (subrp (symbol-function symbol)))
         (unless (string-equal (subr-name (symbol-function symbol)) (symbol-name symbol))
           (push (cons (symbol-function symbol) symbol) result)))))
    result))

(defun ocaps-import (object)
  (cond ((byte-code-function-p object)
         (ocaps--byte-code-map object #'ocaps-import))
        ((subrp object)
         (ocaps-import
          (or (cdr (assq object ocaps-subr-to-symbol-map))
              (intern-soft (subr-name object)))))
        ((symbolp object)
         (or (intern-soft (symbol-name object) (ocaps-world-obarray ocaps-world))
             (funcall (ocaps-world-symbol-lazy-import-function ocaps-world) object)))
        ((functionp object)
         (ocaps-import (byte-compile object)))
        ((consp object)
         (cons (ocaps-import (car object)) (ocaps-import (cdr object))))
        ((vectorp object)
         (map 'vector #'ocaps-import object))
        (t object)))

;;; demo
(defvar public-variable nil)
(defvar private-variable nil)
(defvar untrusted-world
  (ocaps-make-world '(public-variable) '(message)))
(defvar untrusted-function-1
  (let ((ocaps-world untrusted-world))
    (ocaps-import (lambda (x) (+ x 2))))
  "some harmless calculation.")
(funcall untrusted-function-1 5) ;; => 7
(defvar untrusted-function-2
  (let ((ocaps-world untrusted-world))
    (ocaps-import
     (lambda ()
       (setq public-variable
             (lambda () (setq private-variable :whoops)))
       (message "do useful stuff!"))))
  "It's trying to do very tricky thing! Will it succeed?")
(funcall untrusted-function-2) ;; do useful stuff!
;; It did it's stuff!
public-variable  ;; => <a bytecode object>
;; And it does have right to write to PUBLIC-VARIABLE!
;; But what about the tricky stuff?
(funcall public-variable)
private-variable ;; => nil
;; private-variable is not tampered because UNTRUSTED-WORLD doesn't have capability!

Re: Prototype of object capability in Emacs

[dick]

Well, well.  From the mouths of babes dost I slow my roll.  I continue to
believe your endeavor a fruitless one, but I concede a level of erudition
heretofore unappreciated, and rare on this forum.

Re: Prototype of object capability in Emacs

[Stefan Monnier]

> The way it works: ocaps-make-world makes a “powerless” isolated object graph
> (except initially passed in capability). 
> ocaps-import takes an object from ambient environment, and remove any capability
> not presented in the world bound to special variable ocaps-world.

I don't quite understand where are the capabilities in your system.
Maybe it's just a question of vocabulary.
For me a capability is bit like a pointer, and I need to provide it
whenever I want to do a particular operation which requires special
authorization, as evidence that I have the right to perform it.

AFAICT, what your package does is something more like what I'd call
a container.

A big problem with the approach you're following is that it's very
difficult to make sure the container doesn't leak.

E.g. providing access to the `current-global-map` function would already
end up giving access directly or indirectly to a vast array of functions
from the main obarray.

Something along these lines might be appropriate for insecure
containers, designed to avoid accidentally stepping on each other's toes
(maybe for concurrency purposes, for example), but if the purpose is to
run potentially dangerous code, I wouldn't ... trust it.


        Stefan