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
|
;; Derived from plai/web/server, which was based on an older version
;; of this Also derived from planet/untyped/instaservlet
#lang racket/base
(require (prefix-in net: net/sendurl)
racket/match
racket/local
racket/contract
racket/async-channel
racket/list
(only-in racket/tcp listen-port-number?)
racket/unit
racket/serialize
net/url)
(require web-server/web-server
web-server/managers/lru
web-server/managers/manager
web-server/configuration/namespace
web-server/configuration/responders
web-server/http
web-server/stuffers
web-server/servlet/setup
web-server/servlet/servlet-structs
web-server/dispatchers/dispatch
web-server/safety-limits
(prefix-in filter: web-server/dispatchers/dispatch-filter)
(prefix-in servlets: web-server/dispatchers/dispatch-servlets))
(define send-url (make-parameter net:send-url))
(provide/contract
[dispatch/servlet (((request? . -> . can-be-response?))
(#:regexp regexp?
#:current-directory path-string?
#:stateless? boolean?
#:stuffer (stuffer/c serializable? bytes?)
#:manager manager?
#:responders-servlet-loading (url? any/c . -> . can-be-response?)
#:responders-servlet (url? any/c . -> . can-be-response?))
. ->* .
dispatcher/c)]
[serve/launch/wait (((semaphore? . -> . dispatcher/c))
(#:launch-path (or/c #f string?)
#:connection-close? boolean?
#:banner? boolean?
#:listen-ip (or/c #f string?)
#:port listen-port-number?
#:max-waiting timeout/c
#:safety-limits safety-limits?
#:ssl-cert (or/c #f path-string?)
#:ssl-key (or/c #f path-string?))
. ->* .
any)])
(define (dispatch/servlet
start
#:regexp
[servlet-regexp #rx""]
#:current-directory
[servlet-current-directory (current-directory)]
#:stateless?
[stateless? #f]
#:stuffer
[stuffer default-stuffer]
#:responders-servlet-loading
[responders-servlet-loading servlet-loading-responder]
#:responders-servlet
[responders-servlet servlet-error-responder]
#:manager
[manager
(make-threshold-LRU-manager
(lambda (request)
(response/xexpr
`(html (head (title "Page Has Expired."))
(body (p "Sorry, this page has expired. Please go back.")))))
(* 64 1024 1024))])
(define servlet-box (box #f))
(define namespace-now (current-namespace))
(filter:make
servlet-regexp
(servlets:make
#:responders-servlet-loading responders-servlet-loading
#:responders-servlet responders-servlet
(lambda (url)
(or (unbox servlet-box)
(let ([servlet
(parameterize ([current-custodian (make-custodian)]
[current-namespace namespace-now])
(if stateless?
(make-stateless.servlet servlet-current-directory stuffer manager start)
(make-v2.servlet servlet-current-directory manager start)))])
(set-box! servlet-box servlet)
servlet))))))
(define (serve/launch/wait
dispatcher
#:connection-close?
[connection-close? #f]
#:launch-path
[launch-path #f]
#:banner?
[banner? #t]
#:listen-ip
[listen-ip "127.0.0.1"]
#:port
[port-arg 8000]
#:max-waiting [_max-waiting 511]
#:safety-limits [limits (make-safety-limits #:max-waiting _max-waiting)]
#:ssl-cert
[ssl-cert #f]
#:ssl-key
[ssl-key #f])
(define ssl? (and ssl-cert ssl-key))
(define sema (make-semaphore 0))
(define confirm-ch (make-async-channel 1))
(define shutdown-server
(serve #:confirmation-channel confirm-ch
#:connection-close? connection-close?
#:dispatch (dispatcher sema)
#:listen-ip listen-ip
#:port port-arg
#:safety-limits limits
#:dispatch-server-connect@ (if ssl?
(make-ssl-connect@ ssl-cert ssl-key)
raw:dispatch-server-connect@)))
(define serve-res (async-channel-get confirm-ch))
(if (exn? serve-res)
(begin
(when banner? (eprintf "There was an error starting the Web server.\n"))
(match serve-res
[(app exn-message (regexp "tcp-listen: listen on .+ failed \\(Address already in use; errno=.+\\)" (list _)))
(when banner? (eprintf "\tThe TCP port (~a) is already in use.\n" port-arg))]
[_
(void)]))
(local [(define port serve-res)
(define server-url
(string-append (if ssl? "https" "http")
"://localhost"
(if (and (not ssl?) (= port 80))
"" (format ":~a" port))))]
(when launch-path
((send-url) (string-append server-url launch-path) #t))
(when banner?
(printf "Your Web application is running at ~a.\n"
(if launch-path
(string-append server-url launch-path)
server-url))
(printf "Stop this program at any time to terminate the Web Server.\n")
(flush-output))
(let ([bye (lambda ()
(when banner? (printf "\nWeb Server stopped.\n"))
(shutdown-server))])
(with-handlers ([exn:break? (lambda (exn) (bye))])
(semaphore-wait/enable-break sema)
; Give the final response time to get there
(sleep 2)
;; We can get here if a /quit url is visited
(bye))))))
|
