-
Notifications
You must be signed in to change notification settings - Fork 14
/
sandboxed-server.rkt
77 lines (66 loc) · 3.14 KB
/
sandboxed-server.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#lang racket
(require racket/sandbox
racket/runtime-path
setup/dirs
racket/cmdline
(for-syntax racket/base)
"compiler-service.rkt")
(define current-port (make-parameter 8080))
(define current-memory-limit (make-parameter 256))
(define current-extra-module-providers (make-parameter '()))
(void (command-line
#:once-each
[("-p" "--port") p "Port (default 8080)"
(current-port (string->number p))]
[("--memory-limit") memlimit "Memory limit in MB (default 256)"
(current-memory-limit (string->number memlimit))]
[("--extra-module-provider")
mp
"The path of a module, relative to current-directory, that provides an additional 'module-provider"
(current-extra-module-providers
(cons mp (current-extra-module-providers)))]))
(write-runtime-files)
(define-runtime-path server-path (build-path "compiler-service.rkt"))
(define (my-network-guard name str port role)
(printf "I see: ~s ~s ~s ~s\n" name str port role)
#t)
(let sandbox-loop ()
(with-handlers ([exn:fail:resource?
(lambda (exn)
(printf "server died from resource limits? ~s\n"
(exn-message exn)))]
[exn:fail:sandbox-terminated?
(lambda (exn)
(printf "server died prematurely due to sandbox? ~s\n"
(exn-message exn)))]
[exn:fail?
;; We should never hit this case, but never say never
(lambda (exn)
(printf "server died prematurely? ~s\n"
(exn-message exn)))])
(let loop ()
(parameterize ([sandbox-memory-limit (current-memory-limit)]
[sandbox-eval-limits '(+inf.0 256)]
[sandbox-output (current-output-port)]
[sandbox-network-guard my-network-guard]
[sandbox-path-permissions (list (list 'read (build-path "/"))
(list 'exists (build-path "/"))
(list 'read-bytecode (build-path "/")))])
(printf "memory limit: ~s mb\n" (sandbox-memory-limit))
(define eval
(make-module-evaluator server-path
#:allow-read (list (build-path "/"))))
(printf "starting server thread\n")
(eval
`(begin (define server-thread (thread (lambda ()
(start-server #:port ,(current-port)
#:extra-module-providers ',(current-extra-module-providers)))))
(printf "thread started\n")
(with-handlers ([exn:fail?
(lambda (exn)
(printf "server died prematurely? ~s\n"
(exn-message exn)))])
(sync server-thread))))
(printf "restarting server\n")
(loop))))
(sandbox-loop))