[plt-dev] Re: language dialog, some minor changes & bugfixes

On Jan 29, Robby Findler wrote:
> You are suggesting that planet and drscheme collaborate directly via
> some parameter that planet exports that tells it to parse the line
> but return a dummy info if the package is not installed? (and use
> various security measures to forbid network access in addition)
> 
> I think that makes sense.

No, I'm saying that if you forbid network access (via a security
guard), then you don't even need to extend planet.  It was a little
tricky since the first thing I tried got caught by planet (see big
comment), but the following should be a fine version.  It seems to me
like this works even better than a planet hook, since it will work
with any kind of network hook in the resolver (for example, some
future (require (url ...)) thing or whatever).

Any ideas about a good place to dump lang-related functions like this?
(More will be necessary, since the currentl available functionality is
pretty low level, and should be wrapped for more convenient user
consumption.)

  #lang scheme/base
  
  (define (call-without-network thunk on-network-attempt)
    ;; Could be done by throwing some specific exception and testing for its type
    ;; in the with-handlers, but planet will catch network errors and re-raise
    ;; its own errors.  (If it catches only `exn:fail:network?' then this could
    ;; be done with a separate kind of exception, but what if planet changes to
    ;; catch all errors?)
    (define orig-security (current-security-guard))
    (define connection-attempted #f)
    (with-handlers ([exn? (lambda (e)
                            (if connection-attempted
                              (on-network-attempt)
                              (raise e)))])
      (parameterize ([current-security-guard
                      (make-security-guard
                       orig-security
                       (lambda (what path modes) #t)
                       (lambda (what host port mode)
                         (set! connection-attempted #t)
                         (error 'poof "poof")))])
        (thunk))))
  
  (define (lang-text str #:allow-network [net-ok? #f])
    (define (get-it)
      (let* ([i (open-input-string str)]
             [l (read-language i (lambda () #f))]
             [l (and l (substring str 0 (file-position i)))]
             [l (and l (regexp-match #px"^\\s*#(?:!|lang ) *(.*\\S)\\s*$" l))]
             [l (and l (cadr l))])
        l))
    (if net-ok? (get-it) (call-without-network get-it (lambda () #f))))
  
  (lang-text "#lang at-exp scheme/base")
  (lang-text "#lang reader (lib \"scribble/reader.ss\")")
  (lang-text "#lang reader (planet planet/test-connection/test-connection)")
  (lang-text "#lang reader (planet planet/test-connection/test-connection)"
             #:allow-network #t)
  (lang-text "#lang reader (planet planet/test-connection/test-connection)")


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