[plt-scheme] continuation barrier

On Apr 18, DTNOIZR wrote:
> > This code runs without problems in PLT Scheme 4.1.5
> I use 4.1.4. because of 4.1.5. have some errors ...
> 
> i wanna create web scheme interpreter
> every user have its own sandbox with its own tweaks

So you wouldn't want the sandboxed code to be able to interfere with
your own server -- which is why its environment is isolated.  Below is
a sample quick web-server based evaluator that I once wrote -- if you
try it, you'll see that capturing continuations and calling them is
fine as long as it's user code that calls its own continuations.

If you want sandboxed code to be part of the web server, then you
should probably write some wrapper that will call a function inside
the sandbox with the query, and display the result it returned.  This
way the continuations that are captured inside the sandbox are kept
private, and no continuation barriers get in your way.

-------------------------------------------------------------------------------
#lang scheme

(require scheme/sandbox web-server/http/bindings web-server/servlet-env)

(define e
  (parameterize ([sandbox-output 'string]
                 [sandbox-error-output current-output-port])
    (make-module-evaluator '(module foo scheme/base))))

(define (show-values . vs)
  `(span ()
     ,@(apply append (map (lambda (v) (list "-> " (format "~s" v) "\n"))
                          (filter (lambda (x) (not (void? x))) vs)))))

(define (show-input str)
  `(span ([style "font-weight: bolder;"]) ">" nbsp ,str "\n"))

(define (show-output str)
  `(span ([style "font-style: italic;"])
     ,str ,(if (regexp-match? #rx"[^\n]$" str) "\n" "")))

(define (show-exception e)
  `(span ([style "font-style: italic; font-weight: bolder;"])
     (span ([style "color: #a22; text-decoration: underline;"]) "error")
     ": "
     ,(if (exn? e) (exn-message e) (format "~s" e))))

(define (serve req)
  (let* ([inp (extract-bindings 'expr (request-bindings req))]
         [inp (and (pair? inp) (car inp))]
         [res (if inp
                (with-handlers ([void show-exception])
                  (call-with-values (lambda () (e inp)) show-values))
                (banner))]
         [out (if inp (show-output (get-output e)) "")]
         [inp (if inp (show-input inp) "")])
    `(html (body ([style "font-family: Arial Black, arial, sans-serif;"])
             (pre ,inp ,out ,res)
             (form ([action "eval.ss"] [method "post"])
               (tt ([style "font-weight: bolder;"]) ">" nbsp)
               (input ([type "text"] [name "expr"] [border "0"]))
               (input ([type "submit"])))))))

(serve/servlet serve
               #:port 8080 #:listen-ip #f #:command-line? #t
               #:servlet-path "/" #:servlet-regexp #rx"")
-------------------------------------------------------------------------------

-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                  http://www.barzilay.org/                 Maze is Life!