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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
#lang racket/base
(require racket/contract
racket/match
racket/serialize
web-server/managers/manager
web-server/managers/timeouts
web-server/managers/none
web-server/lang/stuff-url
web-server/stuffers/stuffer
(only-in web-server/lang/web
initialize-servlet
make-stateless-servlet)
web-server/http
web-server/servlet/web
web-server/configuration/namespace
web-server/servlet/servlet-structs
web-server/private/web-server-structs
web-server/private/servlet
web-server/private/util)
(define path->servlet/c (path? . -> . servlet?))
(provide/contract
[path->servlet/c contract?]
[make-default-path->servlet
(->* ()
(#:make-servlet-namespace make-servlet-namespace/c
#:timeouts-default-servlet number?)
path->servlet/c)])
(define (v0.response->v1.lambda response response-path)
(lambda (initial-request)
response))
(define (make-v1.servlet directory timeout start)
(make-v2.servlet
directory
(create-timeout-manager
#f timeout timeout)
(lambda (initial-request)
(adjust-timeout! timeout)
(start initial-request))))
(define (make-v2.servlet directory manager start)
(make-servlet
(current-custodian)
(current-namespace)
manager
directory
(lambda (req)
(define uri (request-uri req))
(with-handlers ([exn:fail:servlet-manager:no-instance?
(lambda (the-exn)
((exn:fail:servlet-manager:no-instance-expiration-handler the-exn) req))]
[exn:fail:servlet-manager:no-continuation?
(lambda (the-exn)
((exn:fail:servlet-manager:no-continuation-expiration-handler the-exn) req))])
(define-values (instance-id handler)
(cond
[(continuation-url? uri)
=> (match-lambda
[(list instance-id k-id salt)
(values instance-id
(custodian-box-value ((manager-continuation-lookup manager) instance-id k-id salt)))])]
[else
(define eh (exit-handler))
(values ((manager-create-instance manager) (λ () (eh #f)))
start)]))
(parameterize ([current-servlet-instance-id instance-id])
(handler req))))))
(define (make-stateless.servlet directory stuffer manager start)
(define eh (exit-handler))
(define instance-id
((manager-create-instance manager) (λ () (eh #f))))
(define ses
(make-stateless-servlet
(current-custodian) (current-namespace)
manager
directory
(lambda (req) (error "Session not initialized"))
stuffer))
(parameterize ([current-directory directory]
[current-servlet-instance-id instance-id]
[current-servlet ses])
(set-servlet-handler! ses (initialize-servlet start)))
ses)
(require racket/runtime-path)
(define-runtime-module-path web-server/private/servlet:module-path web-server/private/servlet)
(define-runtime-module-path web-server/http:module-path web-server/http)
(define common-module-specs
(list web-server/private/servlet:module-path
web-server/http:module-path))
(define-runtime-module-path web-server/servlet/web:module-path web-server/servlet/web)
(define-runtime-module-path web-server/servlet/web-cells:module-path web-server/servlet/web-cells)
(define servlet-module-specs
(list 'web-server/servlet/web
#;web-server/servlet/web:module-path ; XXX Enabling results in error
web-server/servlet/web-cells:module-path))
(define-runtime-module-path web-server/lang/web-cells:module-path web-server/lang/web-cells)
(define-runtime-module-path web-server/lang/web:module-path web-server/lang/web)
(define-runtime-module-path web-server/lang/abort-resume:module-path web-server/lang/abort-resume)
(define lang-module-specs
(list web-server/lang/web-cells:module-path
#;web-server/lang/abort-resume:module-path ; XXX Enabling results in error
'web-server/lang/abort-resume
#;web-server/lang/web:module-path ; XXX Enabling results in error
'web-server/lang/web))
(define default-module-specs
(append common-module-specs
servlet-module-specs
lang-module-specs))
(provide/contract
[make-v1.servlet (path-string? integer? (request? . -> . can-be-response?) . -> . servlet?)]
[make-v2.servlet (path-string? manager? (request? . -> . can-be-response?) . -> . servlet?)]
[make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . can-be-response?) . -> . servlet?)]
[default-module-specs (listof (or/c resolved-module-path? module-path?))])
(define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
#:timeouts-default-servlet [timeouts-default-servlet 30])
(lambda (a-path)
(parameterize ([current-namespace (make-servlet-namespace
#:additional-specs
default-module-specs)]
[current-custodian (make-servlet-custodian)])
(let* ([path-string (path->string a-path)]
[path-sym (string->symbol path-string)]
[neg-blame 'web-server]
[pos-blame path-sym]
[module-name `(file ,path-string)]
[loc (make-srcloc a-path #f #f #f #f)]
[s (load/use-compiled a-path)])
(cond
[(void? s)
(let ([version
(contract (symbols 'v1 'v2 'stateless)
(dynamic-require module-name 'interface-version)
pos-blame neg-blame
"interface-version" loc)])
(case version
[(v1)
(let ([timeout (contract number?
(dynamic-require module-name 'timeout)
pos-blame neg-blame
"timeout" loc)]
[start (contract (request? . -> . can-be-response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)])
(make-v1.servlet (directory-part a-path) timeout start))]
[(v2)
(let ([start (contract (request? . -> . can-be-response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)]
[manager (contract manager?
(dynamic-require module-name 'manager)
pos-blame neg-blame
"manager" loc)])
(make-v2.servlet (directory-part a-path) manager start))]
[(stateless)
(let ([start (contract (request? . -> . can-be-response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)]
[manager (contract manager?
(dynamic-require module-name 'manager
(lambda () (create-none-manager (lambda (req) (error "No continuations!")))))
pos-blame neg-blame
"manager" loc)]
[stuffer (contract (stuffer/c serializable? bytes?)
(dynamic-require module-name 'stuffer (lambda () default-stuffer))
pos-blame neg-blame
"stuffer" loc)])
(make-stateless.servlet (directory-part a-path) stuffer manager start))]))]
[else
(make-v1.servlet (directory-part a-path) timeouts-default-servlet
(v0.response->v1.lambda
(contract response? (response/xexpr s)
pos-blame neg-blame
path-string loc)
a-path))])))))
|
