The cl-isolated from kanru

Quicklisp?

Hello! I am very interested in this project because I'm making a sort-of-web browser that uses common lisp instead of javascript.

You can find the quicklisp request here: quicklisp/quicklisp-projects#1785

eval-return-values branch discussion

To make cl-isolated to work better as a scripting engine we need the following changes. I have implemented those changes in the eval-return-values branch.

Please comment.

I might have gone a bit over board with code etc in the discussion but since its the first majour change to cl-isolated in many moons I would like the communication to be clear.

Easily "allow" an additional set of functionality to be add to an instance of cl-isolate before trying to run/eval code with cl-isolate. Adding additional symbols is not enough we need to be able to add functions and/or even whole packages.

For that to work I need to make a compatibility breaking change.

(defvar *allowed-extra-symbols* nil) needs to be replaced by

(defvar *allowed-isolated-symbols* nil)
(defvar *allowed-isolated-functions* nil)

Functions etc to add functionality to cl-isolated:

(defvar *allowed-packages-symbols* nil)
(defvar *allowed-packages-functions* nil)

(defun set-allowed-symbol (symbol)
  (if (fboundp symbol)
      (push symbol *allowed-packages-functions*)
      (push symbol *allowed-packages-symbols*)))

(defun get-package-symbols (packages &optional excluded-symbols)
  (let (symbols)
    (dolist (package packages)
      (do-external-symbols (s (find-package package))
    (unless (find s excluded-symbols :test 'equalp)
      (push s symbols))))
    symbols))

(defun allow-symbols (symbols)
  (dolist (symbol symbols)
      (set-allowed-symbol symbol)))

(defun allow-package-symbols (packages &optional excluded-symbols)
  (unless *allowed-packages-symbols*
    (dolist (package packages)
    (do-external-symbols (symbol (find-package package))
      (unless (find symbol excluded-symbols :test 'equalp)
        (set-allowed-symbol symbol))))))

We need translate-form to do a touch more checking/validation ie checks before eval

a. Throw an error if something is not allowed by cl-isolate

To not have to loop each time the check needs to be done we need the following convenience function and vars

(defvar *allowed-isolated-symbols* nil)
(defvar *allowed-isolated-functions* nil)

(defun isolated-allowed-symbols ()
  (loop :for symbol :being :the :symbol :in (find-package 'isolated-cl)
     :when (not (get symbol :isolated-locked))
     :do
       (if (fboundp symbol)
       (push symbol *allowed-isolated-functions*)
       (push symbol *allowed-isolated-symbols*))))

b. Differentiate between symbols and functions when translating code and throwing errors.

(defun translate-form (form)
  (when (and (consp form)
             (circular-tree-p form))
    (error 'circular-list))
  (let ((cons-count 0))
    (labels ((translate (form)
               (typecase form
                 (cons (if (> (incf cons-count) *max-elements*)
                           (error 'dimension-error)
                           (cons (translate (car form))
                                 (translate (cdr form)))))
                 (number form)
                 (character form)
                 (pathname form)
                 (array (if (> (array-total-size form) *max-elements*)
                            (error 'dimension-error)
                            (let ((arr (make-array (array-dimensions form)
                                                   :element-type
                                                   (array-element-type form))))
                              (dotimes (i (array-total-size arr) arr)
                                (setf (row-major-aref arr i)
                                      (translate-validate-form
                                       (row-major-aref form i)))))))
                 (keyword form)
                 (symbol (if (fboundp form)
                 (or (find form *allowed-isolated-functions*)
                 (find form *allowed-packages-functions*)
                 (error 'undefined-function :name form))
                 (if (or (find form *allowed-isolated-symbols*)
                     (find form *allowed-packages-symbols*))
                 form
                 (intern (symbol-name form) *env*))))
                 (t (error 'unsupported-type :type (type-of form))))))
      (translate form))))

Allow code to be passed to cl-isolate that is not in a string but in sexp already. Working with strings is just no fun because you have to deal with " etc when creating the code to be feed to cl-isolated.

Return/Expose the results of one or more of the sexps in the code fed to cl-isolated.

(isolated-allowed-symbols)

(defun reset ()
  (setf isolated-impl::*allowed-isolated-symbols* nil)
  (setf isolated-impl::*allowed-isolated-functions* nil)
  (setf isolated-impl::*allowed-packages-symbols* nil)
  (setf isolated-impl::*allowed-packages-functions* nil)

  (isolated-allowed-symbols)
  
  (ignore-errors
    (delete-package *env*))
  (make-package *env* :use '(#:isolated-cl))
  (loop :for name :in '("+" "++" "+++" "*" "**" "***" "/" "//" "///" "-")
     :do (eval `(defparameter ,(intern name *env*) nil)))
  (loop :for fn :in '(+ - * /)
     :for symbol := (intern (symbol-name fn) *env*)
     :do (setf (get symbol :isolated-locked) t)
       (eval `(defun ,symbol (&rest args)
                (apply ',fn args))))
  *env*)

(defun read-no-eval (forms &key packages exclude-symbols)
  "Returns forms and/or any messages."
  (unless (or (find-package *env*) (reset))   
    (return-from read-no-eval "ISOLATED-PACKAGE-ERROR: Isolated package not found."))

  (allow-package-symbols packages exclude-symbols)

  (let ((validated-forms)
    (msg))

    (labels ((sexp-read (sexps)
           (let (values)
         (if (listp (car sexps))            
             (dolist (sexp sexps)         
               (push (translate-form sexp) values))
             (push (translate-form sexps) values))
         (reverse values)))

         (sread (string)
           (let (values)
         (with-input-from-string (s string)         
           (loop for sexp = (read s nil)
              while sexp
              do
            (if (listp (car sexp))
                (dolist (sexpx sexp)
                  (push (translate-form sexpx)
                    values))
                (push (translate-form sexp)
                  values))))
         (reverse values))))
     
      (setf validated-forms
        (if (stringp forms)
        (sread forms)
        (sexp-read forms))))
    (values validated-forms msg)))

(defun read-eval (forms &key packages exclude-symbols)
  "Returns eval values and/or any messages."

  (unless (or (find-package *env*) (reset))
    (return-from read-eval (values nil "ISOLATED-PACKAGE-ERROR: Isolated package not found.")))

  (allow-package-symbols packages exclude-symbols)

  (with-isolated-env
    (let ((values)
      (msg))
      
      (flet ((sexp-read (sexps)
           (let (values)
         (if (listp (car sexps))
             (dolist (sexp sexps)
               (push (multiple-value-list
                  (eval
                   (translate-form sexp)))
                 values))
             (push (multiple-value-list
                (eval
                 (translate-form sexps)))
               values))  
         (reverse values)))
         (sread (string)
           (let (values)
         (with-input-from-string (s string)         
           (loop for sexp = (read s nil)
              while sexp
              do
            (multiple-value-list
             (if (listp (car sexp))
                 (dolist (sexpx sexp)
                   (push (multiple-value-list
                      (eval
                       (translate-form sexpx)))
                     values))
                 (push (multiple-value-list
                    (eval
                     (translate-form sexp)))
                   values)))))
         (reverse values))))
    (setf values (if (stringp forms)
             (sread forms)
             (sexp-read forms))))
      (values values msg))))


(defun ssetq (name value)
  (setf (symbol-value (find-symbol (string-upcase name) *env*))
               value))


(defun read-eval-print (forms &optional (stream *standard-output*))
  (unless (or (find-package *env*) (reset))
    (msge stream "ISOLATED-PACKAGE-ERROR: Isolated package not found.")
    (return-from read-eval-print nil))

  (with-isolated-env
    (let (form)
   
      (flet ((sexp-read (sexps)
           (let (values)
         (if (listp (car sexps))
             (dolist (sexp sexps)
               (push (multiple-value-list
                  (eval
                   (translate-form sexp)))
                 values))
             (push (multiple-value-list
                (eval
                 (translate-form sexps)))
               values))  
         (reverse values)))

         (sread (string)
           (let (values)
         (with-input-from-string (s string)         
           (loop for sexp = (read s nil)
              while sexp
              do
            (multiple-value-list
             (if (listp (car sexp))                  
                 (dolist (sexpx sexp)
                   (setf form (translate-form sexpx))
                   (push (multiple-value-list
                      (eval
                       (prog1
                       form
                     (ssetq "-" form))))
                     values))
                 (progn
                   (setf form (translate-form sexp))
                   (push (multiple-value-list
                      (eval
                       (prog1
                       form
                     (ssetq "-" form))
                       ))
                     values))))))
         (reverse values)))

         (muffle (c)
           (declare (ignore c))
           (when (find-restart 'muffle-warning)
         (muffle-warning))))

    (let (form values)

      (handler-case
          (handler-bind ((warning #'muffle))

        (setf values (if (stringp forms)
                 (sread forms)
                 (sexp-read forms)))
        (dolist (value values)
          (isolated-print value stream)))

        (undefined-function (c)
          (msge stream "~A: The function ~A is undefined."
            (type-of c) (cell-error-name c)))

        (end-of-file (c)
          (msge stream "~A" (type-of c)))

        (reader-error ()
          (msge stream "READER-ERROR"))

        (package-error ()
          (msge stream "PACKAGE-ERROR"))

        (stream-error (c)
          (msge stream "~A" (type-of c)))

        (storage-condition ()
          (msge stream "STORAGE-CONDITION"))

        (t (c)
          (msge stream "~A: ~A" (type-of c) c)))

      (flet ((svalue (string)
           (symbol-value (find-symbol string *env*))))
        (ssetq "///" (svalue "//"))
        (ssetq "//"  (svalue "/"))
        (ssetq "/"   values)
        (ssetq "***" (svalue "**"))
        (ssetq "**"  (svalue "*"))
        (ssetq "*"   (first values))
        (ssetq "+++" (svalue "++"))
        (ssetq "++"  (svalue "+"))
        (ssetq "+"   form))))))
  nil)

Examples:

(isolated::read-no-eval (list '(princ-to-string '(hello world))
                                            '(princ-to-string '(eish world))))

((PRINC-TO-STRING '(ISOLATED/LOCAL::HELLO ISOLATED/LOCAL::WORLD))
 (PRINC-TO-STRING '(ISOLATED/LOCAL::EISH ISOLATED/LOCAL::WORLD)))
NIL

(isolated::read-eval (list '(princ-to-string '(hello world))
                                      '(princ-to-string '(eish world))))
(("(HELLO WORLD)") ("(EISH WORLD)"))
NIL

(isolated::read-eval-print (list '(princ-to-string '(hello world))
                                               '(princ-to-string '(eish world))))
=> "(HELLO WORLD)"
=> "(EISH WORLD)"
NIL

(isolated:read-eval-print "(princ-to-string '(hello world)) (princ-to-string '(eish world))")
=> "(HELLO WORLD)"
=> "(EISH WORLD)"
NIL

Examples Allowing additional functions:

CL-USER> (defun do-eish (eish) eish)
DO-EISH

CL-USER> (isolated:read-eval-print "(do-eish 'eish)")
;; UNDEFINED-FUNCTION: The function DO-EISH is undefined.

CL-USER>  (isolated-impl:allow-symbols (list 'do-eish))

CL-USER> (isolated::read-no-eval "(cl-user::do-eish 'cl-user::eish)")
((DO-EISH 'ISOLATED/LOCAL::EISH))
NIL

CL-USER>  (isolated-impl:allow-symbols (list 'do-eish 'eish))

CL-USER> (isolated::read-no-eval "(cl-user::do-eish 'cl-user::eish)")
((DO-EISH 'EISH))
NIL

(isolated::read-eval-print "(cl-user::do-eish 'eish)")
=> EISH
NIL
CL-USER> (isolated::read-eval-print "(cl-user::do-eish 'cl-user::eish)")
=> COMMON-LISP-USER::EISH
NIL

When there is broken syntax like missing bracket or such read-eval-print returns no value instead of a an error. That is because read returns a EOF error for that kind of thing and read-eval-print thinks that all is ok on EOF error.

I did a hack to raise a syntax error instead but it uses read-line which introduces other constraints like (list 123) (list 321) only returns first list where as (list 123) \n (list 321) returns both.

Do you maybe have a better solution?

kanru / cl-isolated Goto Github PK

cl-isolated's People

Contributors

Stargazers

Watchers

Forkers

cl-isolated's Issues

Quicklisp?

eval-return-values branch discussion

End of File

Recommend Projects

React

Vue.js

Typescript

TensorFlow

Django

Laravel

D3

Recommend Topics

javascript

web

server

Machine learning

Visualization

Game

Recommend Org

Facebook

Microsoft

Google

Alibaba

D3

Tencent