From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Newsgroups: gmane.lisp.guile.devel Subject: Re: RFC: (ice-9 sandbox) Date: Fri, 31 Mar 2017 13:33:30 +0200 Message-ID: <871std65px.fsf@gnu.org> References: <87r31daj8n.fsf@pobox.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Trace: blaine.gmane.org 1490960036 20879 195.159.176.226 (31 Mar 2017 11:33:56 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 31 Mar 2017 11:33:56 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1 (gnu/linux) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Fri Mar 31 13:33:52 2017 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ctuoM-0004dL-Vo for guile-devel@m.gmane.org; Fri, 31 Mar 2017 13:33:47 +0200 Original-Received: from localhost ([::1]:40168 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ctuoS-0005eK-Uz for guile-devel@m.gmane.org; Fri, 31 Mar 2017 07:33:52 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40925) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ctuoN-0005eB-PL for guile-devel@gnu.org; Fri, 31 Mar 2017 07:33:49 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ctuoJ-00022t-Bq for guile-devel@gnu.org; Fri, 31 Mar 2017 07:33:47 -0400 Original-Received: from [195.159.176.226] (port=35190 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ctuoJ-00022d-3y for guile-devel@gnu.org; Fri, 31 Mar 2017 07:33:43 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1ctuo9-0003VD-Ji for guile-devel@gnu.org; Fri, 31 Mar 2017 13:33:33 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 115 Original-X-Complaints-To: usenet@blaine.gmane.org X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 11 Germinal an 225 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-unknown-linux-gnu Cancel-Lock: sha1:syLpDt5QMSaAJpp4FFkY/YIR774= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 195.159.176.226 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.org gmane.lisp.guile.devel:19077 Archived-At: Hello! Andy Wingo skribis: > Any thoughts? I would like something like this for a web service that > has to evaluate untrusted code. Would be nice! > (define (call-with-allocation-limit limit thunk limit-reached) > "Call @var{thunk}, but cancel it if @var{limit} bytes have been > allocated. If the computation is cancelled, call @var{limit-reached} in > tail position. @var{thunk} must not disable interrupts or prevent an > abort via a @code{dynamic-wind} unwind handler. > > This limit applies to both stack and heap allocation. The computation > will not be aborted before @var{limit} bytes have been allocated, but > for the heap allocation limit, the check may be postponed until the next garbage collection." > (define (bytes-allocated) (assq-ref (gc-stats) 'heap-total-allocated)) > (let ((zero (bytes-allocated)) > (tag (make-prompt-tag))) > (define (check-allocation) > (when (< limit (- (bytes-allocated) zero)) > (abort-to-prompt tag))) > (call-with-prompt tag > (lambda () > (dynamic-wind > (lambda () > (add-hook! after-gc-hook check-allocation)) > (lambda () > (call-with-stack-overflow-handler > ;; The limit is in "words", which used to be 4 or 8 but now > ;; is always 8 bytes. > (floor/ limit 8) > thunk > (lambda () (abort-to-prompt tag)))) > (lambda () > (remove-hook! after-gc-hook check-allocation)))) > (lambda (k) > (limit-reached))))) The allocations that trigger ‘after-gc-hook’ could be caused by a separate thread, right? That’s probably an acceptable limitation, but one to be aware of. Also, if the code does: (make-bytevector (expt 2 32)) then ‘after-gc-hook’ run too late, as the comment notes. > (define (make-sandbox-module bindings) > "Return a fresh module that only contains @var{bindings}. > > The @var{bindings} should be given as a list of import sets. One import > set is a list whose car names an interface, like @code{(ice-9 q)}, and > whose cdr is a list of imports. An import is either a bare symbol or a > pair of @code{(@var{out} . @var{in})}, where @var{out} and @var{in} are > both symbols and denote the name under which a binding is exported from > the module, and the name under which to make the binding available, > respectively." > (let ((m (make-fresh-user-module))) > (purify-module! m) > ;; FIXME: We want to have a module that will be collectable by GC. > ;; Currently in Guile all modules are part of a single tree, and > ;; once a module is part of that tree it will never be collected. > ;; So we want to sever the module off from that tree. However the > ;; psyntax syntax expander currently needs to be able to look up > ;; modules by name; being severed from the name tree prevents that > ;; from happening. So for now, each evaluation leaks memory :/ > ;; > ;; (sever-module! m) > (module-use-interfaces! m > (map (match-lambda > ((mod-name . bindings) > (resolve-interface mod-name > #:select bindings))) > bindings)) > m)) IIUC ‘@@’ in unavailable in the returned module, right? --8<---------------cut here---------------start------------->8--- scheme@(guile-user)> (eval '(@@ (guile) resolve-interface) (let ((m (make-fresh-user-module))) (purify-module! m) m)) ERROR: In procedure %resolve-variable: ERROR: Unbound variable: @@ --8<---------------cut here---------------end--------------->8--- Isn’t make-fresh-user-module + purify-module! equivalent to just (make-module)? > ;; These can only form part of a safe binding set if no mutable > ;; pair is exposed to the sandbox. > (define *mutating-pair-bindings* > '(((guile) > set-car! > set-cdr!))) When used on a literal pair (mapped read-only), these can cause a segfault. Now since the code is ‘eval’d, the only literal pairs it can see are those passed by the caller I suppose, so this may be safe? > (define *all-pure-and-impure-bindings* > (append *all-pure-bindings* Last but not least: why all the stars? :-) I’m used to ‘%something’. Thank you! Ludo’.