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!