Folks,
The attached file exp-serialize-continuation.rkt implements
“define-generator”, which defines a generator. The resultant generators
take a “key”, which allows several generator states to be saved for
later use (in a (key -> continuation) hash table).
So far, so good: It works as expected with standard continuations, as
well as serializable continuations (which means I can stuff the
continuations somewhere more permanent than a hash table).
I use them in exp-serialize-module-continuation.rkt (supported by
exp-serialized-continuation-tests.rkt). All tests pass.
I want to allow my users to write these generators and, as such, I need
to protect my code from their mistakes (and malice). Evaluators from
racket/sandbox are designed just for that. So I want to use code like
“sbx-1” in exp-serialize-sandbox-continuation.rkt .
This is where I encounter my problem... when it comes to de-serializing
the continuations; I get the following error report:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
error deserializing: ((3) 5 (((lib "web-server/lang/web-cells.rkt") .
deserialize-info:frame-v0) ((lib "web-server/lang/abort-resume.rkt") .
"lifted.3") ((quote program) . "lifted.376") ((quote program) .
"lifted.367") ((quote program) . "lifted.33")) 2 ((0 (h - ())) (1 (? .
0) ())) () (1 (? . 0) (c (v! (2 (? . 1)) #f #f) c (v! (3 tim (? . 1)) #f
#f) c (v! (4 (? . 1)) #f #f))))
dynamic-require: unknown module
module name: #<resolved-module-path:'program>
context...:
/usr/local/racket-6.2.900.12/share/racket/collects/racket/private/serialize.rkt:654:8:
loop
/usr/local/racket-6.2.900.12/share/racket/collects/racket/private/serialize.rkt:649:2:
deserialize
g22
G
/home/tim/tmp/exp-serialize-continuation-tests.rkt:6:0
/home/tim/tmp/exp-serialize-sandbox-continuation.rkt: [running body]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
My limited understanding is that dynamic-require is used to look up the
ANF function representing my continuation; and since I’m in a sandbox
there has been some disconnection between where the function was lodged
vs. how dynamic-require is attempting to find it.
Is there any way around this?
-- hinting dynamic-require, embellishing my sandbox, something else
Which ('program . "lifted.X") is likely to be causing the problem?
- the first one encountered? (3)
- the last one encountered? (33)
- the one after the first encountered? (376)
- the one before the last encountered? (367)
- one chosen at whim by dynamic-require? (?)
The reason I ask is to understand why my continuation in sbx-2 works.
The following continuation ALSO has a reference to 'program (although
I’ve only been able to engineer it to 1 deep:
'((3) 3 (((lib "web-server/lang/abort-resume.rkt") . "lifted.3") ((lib
"web-server/lang/web-cells.rkt") . deserialize-info:frame-v0) ('program
. "lifted.24")) 0 () () (0 (1 (h - ())) (c (v! (2) #f #f))))
But I can generate, persist, de-serialize and invoke this structure.
Why sbx-2, but not sbx-1?
I expect that I can avoid all of this by writing my code to a temporary
disk file and require'ing it into the sandbox; but that’s not pretty on
a number of levels.
Thanks, in advance, for your help,
Tim
--
Tim Brown CEng MBCS <tim.br...@cityc.co.uk>
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
City Computing Limited · www.cityc.co.uk
City House · Sutton Park Rd · Sutton · Surrey · SM1 2AE · GB
T:+44 20 8770 2110 · F:+44 20 8770 2130
────────────────────────────────────────────────────────────────────────
City Computing Limited registered in London No:1767817.
Registered Office: City House, Sutton Park Road, Sutton, Surrey, SM1 2AE
VAT No: GB 918 4680 96
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.
#lang web-server/base
(require (for-syntax racket/base
syntax/parse)
syntax/parse
racket/stxparam
racket/serialize
web-server/lang/abort-resume)
(provide define-generator yield)
(define use-serialize? #t)
(define-syntax-parameter yield
(λ (stx) (raise-syntax-error #f "use of a gen keyword not in a generator"
stx)))
(define current-konts# (make-hash))
(define (maybe-serialize v)
(cond
[(not use-serialize?) v]
[(serializable? v) (box (serialize v))]
[else v]))
(define (maybe-deserialize v)
(cond
[(not use-serialize?) v]
[(box? v)
(with-handlers
([exn:fail?
(lambda (x)
(eprintf "error deserializing: ~s~%" (unbox v))
(raise x))])
(deserialize (unbox v)))]
[else v]))
(define-syntax (let/ccwc stx)
(syntax-case stx ()
[(_ k b0 bs ...)
#'(call-with-web-prompt
(λ () (call-with-serializable-current-continuation (λ (k) b0 bs
...))))]))
(define-syntax (define-generator stx)
(syntax-parse stx
[(_ g:id e:expr ...+)
#`(define (g key)
(let/ccwc
ret-k
(let ((current-kont (hash-ref current-konts# key #f)))
(cond
[current-kont ((maybe-deserialize current-kont) ret-k)]
[else
(syntax-parameterize
([yield (syntax-parser
[(_ v)
#'(set!
ret-k
(call-with-serializable-current-continuation
(λ (s-kk)
(define s-kk/serialized (maybe-serialize s-kk))
(hash-set! current-konts# key s-kk/serialized)
(ret-k v))))])])
(begin e ...))]))
(ret-k 'generator-bottomed-out)))]))#lang racket
(require rackunit)
(provide test-through-to-2nd-loop)
(define ((test-through-to-2nd-loop gen-function) key)
(define (BID) (gen-function key))
(check-equal? (BID) 1)
(check-equal? (BID) 2)
(check-equal? (BID) 3)
(BID))
#lang racket/base
(require "exp-serialize-continuation-tests.rkt")
(module GEN web-server/lang/base
(require "exp-serialize-continuation.rkt")
(define-generator G
(yield 1)
(yield 2)
(yield 3)
(let loop ((i 3))
(yield i)
(loop (add1 i))))
(provide G))
(require 'GEN)
((test-through-to-2nd-loop G) 'tim)#lang racket/base
(require "exp-serialize-continuation-tests.rkt")
(require racket/sandbox)
(sandbox-eval-limits #f)
(define user-provided-expression
'((yield 1)
(yield 2)
(yield 3)
(let loop ((i 3))
(yield i)
(loop (add1 i)))))
(define sbx-1
(make-evaluator
'web-server/lang/base
#:allow-for-require '("exp-serialize-continuation.rkt")
'(require "exp-serialize-continuation.rkt")
`(define-generator G ,@user-provided-expression)))
(define sbx-2
(make-evaluator
'web-server/lang/base
'(require racket/serialize web-server/lang/abort-resume)
'(define srlz
(call-with-web-prompt
(λ ()
(call/cc (λ (ret)
(call-with-serializable-current-continuation
(λ (k)
(ret (cons (serialize k) 32)))) 33)))))))
(sbx-2 'srlz)
(sbx-2 '(call-with-web-prompt (λ () ((deserialize (car srlz))))))
(newline)
(newline)
(sbx-1 'G)
((test-through-to-2nd-loop (sbx-1 'G)) 'tim)
