Removing unit servlets
svn: r6101
This commit is contained in:
Jay McCarthy
parent
ea004857cf
commit
00f2c671a3
|
|
@ -1,9 +1,8 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(lib "date.ss"))
|
||||
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
(module add mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
; request-number : str -> num
|
||||
(define (request-number which-number)
|
||||
|
|
@ -22,9 +21,10 @@
|
|||
(input ([type "text"] [name "number"] [value ""]))
|
||||
(input ([type "submit"] [name "enter"] [value "Enter"])))))))
|
||||
|
||||
(define (start initial-request)
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html (head (title "Sum"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "The sum is "
|
||||
,(number->string (+ (request-number "first") (request-number "second")))))))))
|
||||
,(number->string (+ (request-number "first") (request-number "second"))))))))))
|
||||
|
|
@ -1,15 +1,15 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(lib "date.ss"))
|
||||
|
||||
(let ([count 0]
|
||||
[date (date->string (seconds->date (current-seconds)) 'time-too)])
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
(module count mzscheme
|
||||
(require (lib "date.ss"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
(define count 0)
|
||||
(define a-date (date->string (seconds->date (current-seconds)) 'time-too))
|
||||
(define (start initial-request)
|
||||
(set! count (add1 count))
|
||||
|
||||
`(html (head (title "Counter"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "This servlet was called " ,(number->string count)
|
||||
" times since loaded on " ,date ".")))))
|
||||
" times since loaded on " ,a-date ".")))))
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
(module hello mzscheme
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
(define the-text "Hello, Web!")
|
||||
|
||||
(define (start initial-request)
|
||||
`(html (head (title ,the-text))
|
||||
(body ([bgcolor "white"])
|
||||
(p ,the-text))))
|
||||
(p ,the-text)))))
|
||||
|
|
@ -1 +1,30 @@
|
|||
<html><head><title>PLT Servlet Examples</title></head><body bgcolor="white"><img src="/Defaults/documentation/web-server.gif" width="61" height="57" /><h2>PLT Servlet Examples</h2><p>The table below links to small example servlets.<br />The configuration tool is a larger example.<br />The `go' links only work when served from the PLT Web server.</p><table><tr><th>Source Code</th><th>Evaluate</th></tr><tr><td><a href="examples/add.ss">add.ss</a></td><td><a href="/servlets/examples/add.ss">go</a></td></tr><tr><td><a href="examples/count.ss">count.ss</a></td><td><a href="/servlets/examples/count.ss">go</a></td></tr><tr><td><a href="examples/hello.ss">hello.ss</a></td><td><a href="/servlets/examples/hello.ss">go</a></td></tr></table><p>Powered by <a href="http://www.plt-scheme.org/"><img width="53" height="19" src="/Defaults/documentation/plt-logo.gif" /></a></p></body></html>
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
|
||||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<title>PLT Servlet Examples</title>
|
||||
</head>
|
||||
<body bgcolor="white">
|
||||
<img src="/Defaults/documentation/web-server.gif" width="61" height="57"><h2>PLT Servlet Examples</h2>
|
||||
<p>The table below links to small example servlets.<br>The configuration tool is a larger example.<br>The `go' links only work when served from the PLT Web server.</p>
|
||||
<table>
|
||||
<tr>
|
||||
<th>Source Code</th>
|
||||
<th>Evaluate</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="examples/add.ss">add.ss</a></td>
|
||||
<td><a href="/servlets/examples/add.ss">go</a></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="examples/count.ss">count.ss</a></td>
|
||||
<td><a href="/servlets/examples/count.ss">go</a></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="examples/hello.ss">hello.ss</a></td>
|
||||
<td><a href="/servlets/examples/hello.ss">go</a></td>
|
||||
</tr>
|
||||
</table>
|
||||
<p>Powered by <a href="http://www.plt-scheme.org/"><img width="53" height="19" src="/Defaults/documentation/plt-logo.gif"></a></p>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -1,34 +1,63 @@
|
|||
<html><head><title>PLT Web Server: Servlet Interface</title></head><body bgcolor="white"><img src="/Defaults/documentation/web-server.gif" width="61" height="57" /><h2>PLT Web Server: Servlet Interface</h2><p>Instead of serving files from a special directory verbatim, the Web server executes the contained Scheme code and serves the output. By default, the special directory is named "servlets" within the "default-web-root" of the "web-server" collection directory. Each file in that directory must evaluate to a servlet.
|
||||
A servlet is a <code>unit/sig</code> that imports the <code>servlet^</code>
|
||||
signature and exports nothing. (Search in <code>help-desk</code> for more information on <code>unit/sig</code> and on signatures.) To construct a <code>unit/sig</code> with the appropriate imports, the servlet must require the two modules providing<code>unit/sig</code>s and the <code>servlet^</code> signature:</p><blockquote><code><pre>
|
||||
(require (lib "unitsig.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
(unit/sig ()
|
||||
(import servlet^)
|
||||
</pre> ...insert servlet code here...<code>)</code></code></blockquote><p>The last value in the <code>unit/sig</code> must be a <em>response</em> to an HTTP request.</p><p>A <code>Response</code> is one of the following:
|
||||
</p><ul><li>an <code>X-expression</code> representing HTML <br />
|
||||
(Search for XML in <code>help-desk</code>.)</li><li>a <code>(listof string)</code> where
|
||||
<ul><li>The first string is the mime type (often "text/html", but see <a href="http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc2822.html">RFC 2822</a> for other options).The rest of the strings provide the document's content.</li></ul></li><li><code>(make-response/full</code> code message seconds mime extras body<code>)</code> where
|
||||
<ul><li>code is a natural number indicating the HTTP response code</li><li>message is a string describing the code to a human</li><li>seconds is a natural number indicating the time the resource was
|
||||
created. Use (current-seconds) for dynamically created responses.</li><li>mime is a string indicating the response type.</li><li>extras is a <code>(listof (cons symbol string))</code> containing extra headers for redirects, authentication, or cookies.</li><li>body is a <code>(listof string)</code></li></ul></li></ul><p>Evaluating <code>(require (lib "servlet-sig.ss" "web-server"))</code> loads
|
||||
the <code>servlet^</code> signature consisting of the following imports:</p><ul><li>initial-request : <code>request</code>, where a request is <br /><code>(make-request method uri headers bindings host-ip client-ip)</code>, where
|
||||
<ul><li> method : <code>(Union 'get 'post)</code></li><li> uri : <code>URL</code> <br />
|
||||
see the <code>net</code> collection in <code>help-desk</code> for details</li><li> headers : <code>(listof (cons symbol string))</code> <br />
|
||||
optional HTTP headers for this request</li><li> bindings : <code>(listof (cons symbol string))</code> <br />
|
||||
name value pairs from the form submitted or the query part of the URL.</li></ul></li></ul><p>The <code>path</code> part of the URL suplies the file path to the servlet relative to the "servlets" directory. However, paths may also contain extra path components that servlets may use as additional input. For example all of the following URLs refer to the same servlet: <ul><li><code>http://www.plt-scheme.org/servlets/my-servlet</code></li><li><code>http://www.plt-scheme.org/servlets/my-servlet/extra</code></li><li><code>http://www.plt-scheme.org/servlets/my-servlet/extra/directories</code></li></ul></p><p>The above imports support handling a single input from a Web form. To ease the development of more interactive servlets, the <code>servlet^</code> signature also provides the following functions:
|
||||
</p><ul><li><code>send/suspend : (str -> Response) -> request</code></li></ul>The argument, a function that consumes a string, is given a <code>URL</code> that can be used in the document. The argument function must produce a
|
||||
response corresponding to the document's body. Requests to the
|
||||
given <code>URL</code> resume the computation at the point
|
||||
<code>send/suspend</code> was invoked. Thus, the argument function normally
|
||||
produces an HTML form with the "action" attribute set to the provided
|
||||
<code>URL</code>. The result of <code>send/suspend</code> represents the
|
||||
next request.
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
|
||||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
|
||||
<title>PLT Web Server: Servlet Interface</title>
|
||||
</head>
|
||||
<body bgcolor="white">
|
||||
<img src="/Defaults/documentation/web-server.gif" width="61" height="57" />
|
||||
<h2>PLT Web Server: Servlet Interface</h2>
|
||||
<p>Instead of serving files from a special directory
|
||||
verbatim, the Web server executes the contained
|
||||
Scheme code and serves the output. By default,
|
||||
the special directory is named "servlets" within
|
||||
the "default-web-root" of the "web-server"
|
||||
collection directory. Each file in that directory
|
||||
must evaluate to a servlet.</p>
|
||||
|
||||
<ul><li><code>send/finish : Response -></code> doesn't return <br />This provides a convenient way to report an error or otherwise produce a final response. Once called, all URLs generated by send/suspend become invalid. Calling send/finish allows the system to reclaim resources consumed by the servlet.</li><li><code>adjust-timeout! : Nat -> Void</code><br />
|
||||
The server will shutdown each instance of a servlet after an unspecified default amount of time since the last time that servlet instance handled a request. Calling adjust-timeout! allows programmers to choose this number of seconds. Larger numbers consume more resources
|
||||
while smaller numbers force servlet users to restart computations more often.
|
||||
</li></ul><p>The <code>servlet-helpers</code> module, required with <blockquote><code>(require (lib "servlet-helpers.ss" "web-server"))</code></blockquote> provides a few additional functions helpful for constructing servlets: <ul><li><code>extract-binding/single : sym (listof (cons sym str)) -> str</code>This extracts a single value associated with sym in the form bindings. If multiple or zero values are associated with the name, it raises an exception.</li><li>extract-bindings : sym (listof (cons sym str)) -> (listof str)returns a list of values assocaited with the name sym.</li><li><code>extract-user-pass : (listof (cons sym str)) -> (U #f (cons str str))</code><br /><code>(define (extract-user-pass headers) ...)</code>Servlets may easily implement password based authentication by extracting password information from the HTTP headers. The return value is either a pair consisting of the username and password from the headers or #f if no password was provided.</li></ul></p><h3>Special URLs</h3><p>The Web server caches passwords and servlets for performance reasons. Requesting the URL<blockquote><a href="/conf/refresh-passwords"><code>http://my-host/conf/refresh-passwords</code></a></blockquote>reloads the password file. After updating a servlet, loading the URL <blockquote><a href="/conf/refresh-servlets"><code>http://my-host/conf/refresh-servlets</code></a></blockquote>causes the server to reload each servlet on the next invocation. This loses any per-servlet state (not per servlet instance state) computed before the unit invocation.</p>
|
||||
<p>A servlet is a <code>module</code> that provides
|
||||
three values: an
|
||||
<code>interface-version</code>,
|
||||
a <code>timeout</code>, and a
|
||||
<code>start</code> procedure:</p>
|
||||
<blockquote><code><pre>
|
||||
(module servlet mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide interface-version timeout start)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
...))
|
||||
</pre></code></blockquote>
|
||||
|
||||
<p>The Web server's garbage collect may be invoked at the URL: <blockquote><a href="/conf/collect-garbage"><code>http://my-host/conf/collect-garbage</code></a></blockquote></p>
|
||||
<p>The <code>start</code> procedure should produce a
|
||||
a <em>response</em> to an HTTP request. Please
|
||||
refer to the documentation available via the Help
|
||||
Desk for more information about working with these
|
||||
values and programming servlets.</p>
|
||||
|
||||
<p><a href="servlet-examples.html">Examples of Servlets</a></p><p>Powered by <a href="http://www.plt-scheme.org/"><img width="53" height="19" src="/Defaults/documentation/plt-logo.gif" /></a></p></body></html>
|
||||
<h3>Special URLs</h3>
|
||||
<p>The Web server caches passwords and servlets for
|
||||
performance reasons. Requesting the URL</p>
|
||||
<blockquote><a
|
||||
href="/conf/refresh-passwords"><code>http://my-host/conf/refresh-passwords</code></a></blockquote>
|
||||
<p>reloads the password file. After updating a
|
||||
servlet, loading the
|
||||
URL</p>
|
||||
<blockquote><a
|
||||
href="/conf/refresh-servlets"><code>http://my-host/conf/refresh-servlets</code></a></blockquote>
|
||||
<p>causes the server to reload each servlet on the
|
||||
next invocation. This loses any per-servlet state (not
|
||||
per servlet instance state) computed before the unit
|
||||
invocation.</p>
|
||||
|
||||
<p>The Web server's garbage collect may be invoked at
|
||||
the URL: </p>
|
||||
<blockquote><a href="/conf/collect-garbage"><code>http://my-host/conf/collect-garbage</code></a></blockquote>
|
||||
|
||||
<p><a href="servlet-examples.html">Examples of Servlets</a></p>
|
||||
<p>Powered by <a href="http://www.plt-scheme.org/">
|
||||
<img width="53" height="19"
|
||||
src="/Defaults/documentation/plt-logo.gif" /></a></p>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
; unless you never want to reconfigure the Web server again.
|
||||
; The servlet accepts requests only from the *same machine* as the Web server
|
||||
; for security purposes.
|
||||
|
||||
(module configure mzscheme
|
||||
(require (lib "configure.ss" "web-server" "private"))
|
||||
|
||||
servlet
|
||||
(provide (all-from (lib "configure.ss" "web-server" "private"))))
|
||||
|
|
@ -1,9 +1,8 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(lib "date.ss"))
|
||||
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
(module add mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
; request-number : str -> num
|
||||
(define (request-number which-number)
|
||||
|
|
@ -22,7 +21,8 @@
|
|||
(input ([type "text"] [name "number"] [value ""]))
|
||||
(input ([type "submit"] [name "enter"] [value "Enter"])))))))
|
||||
|
||||
(define (start initial-request)
|
||||
`(html (head (title "Sum"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "The sum is "
|
||||
,(number->string (+ (request-number "first") (request-number "second")))))))
|
||||
,(number->string (+ (request-number "first") (request-number "second"))))))))
|
||||
|
|
@ -1,20 +1,12 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
"helper-sig.ss")
|
||||
|
||||
(define main@
|
||||
(unit
|
||||
(import servlet^ my-servlet-helpers^)
|
||||
(export)
|
||||
(module add mzscheme
|
||||
(require "helper.ss")
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
(define (start initial-request)
|
||||
`(html (head (title "Sum"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "The sum is "
|
||||
,(number->string (+ (get-number "the first number to add")
|
||||
(get-number "the second number to add"))))))))
|
||||
|
||||
(compound-unit (import (S : servlet^))
|
||||
(export)
|
||||
(link
|
||||
(((H : my-servlet-helpers^)) ((load-relative "helper.ss") S))
|
||||
(() main@ S H)))
|
||||
|
|
|
|||
|
|
@ -1,5 +0,0 @@
|
|||
(module helper-sig mzscheme
|
||||
(provide my-servlet-helpers^)
|
||||
(require (lib "unit.ss"))
|
||||
|
||||
(define-signature my-servlet-helpers^ (get-number)))
|
||||
|
|
@ -1,11 +1,6 @@
|
|||
(require (lib "xml.ss" "xml")
|
||||
(lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
"helper-sig.ss")
|
||||
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export my-servlet-helpers^)
|
||||
(module helper mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
; get-number : string -> number
|
||||
; to prompt the user for a number
|
||||
|
|
|
|||
|
|
@ -1,12 +1,10 @@
|
|||
(require (lib "servlet-sig.ss" "web-server")
|
||||
(lib "unit.ss")
|
||||
(module multiply mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "etc.ss")
|
||||
"helper-sig.ss")
|
||||
|
||||
(define multiply@
|
||||
(unit
|
||||
(import servlet^ my-servlet-helpers^)
|
||||
(export)
|
||||
"helper.ss")
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
; matrix = (listof (listof num))
|
||||
|
||||
|
|
@ -79,6 +77,7 @@
|
|||
m)))
|
||||
|
||||
; main
|
||||
(define (start initial-request)
|
||||
`(html (head (title "Matrix Product"))
|
||||
(body
|
||||
(p "The matrix product is"
|
||||
|
|
@ -86,9 +85,3 @@
|
|||
(let-values ([(r c) (get-dimentions)])
|
||||
(matrix-multiply (get-matrix r c)
|
||||
(get-matrix c r)))))))))
|
||||
|
||||
(compound-unit (import (S : servlet^))
|
||||
(export)
|
||||
(link
|
||||
(((H : my-servlet-helpers^)) ((load-relative "helper.ss") S))
|
||||
(() multiply@ S H)))
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(lib "date.ss"))
|
||||
|
||||
(let ([count 0]
|
||||
[date (date->string (seconds->date (current-seconds)) 'time-too)])
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
(module count mzscheme
|
||||
(require (lib "date.ss"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define count 0)
|
||||
(define a-date (date->string (seconds->date (current-seconds)) 'time-too))
|
||||
(define (start initial-request)
|
||||
(define other-count 0)
|
||||
|
||||
(set! other-count (add1 other-count))
|
||||
|
|
@ -15,4 +15,4 @@
|
|||
(body ([bgcolor "white"])
|
||||
(p "This servlet was called " ,(number->string count)
|
||||
" times and " ,(number->string other-count)
|
||||
" times since loaded on " ,date ".")))))
|
||||
" times since loaded on " ,a-date ".")))))
|
||||
|
|
@ -1,13 +1,11 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(lib "date.ss"))
|
||||
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
|
||||
(module dir mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(send/back
|
||||
`(html (head (title "Current Directory Page"))
|
||||
(body
|
||||
(h1 "Current Directory Page")
|
||||
(p "The current directory is: " (em ,(path->string (current-directory))))))))
|
||||
|
||||
(p "The current directory is: " (em ,(path->string (current-directory)))))))))
|
||||
|
|
@ -1,11 +1,10 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
|
||||
(module hello mzscheme
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(define the-text "Hello, Web!")
|
||||
|
||||
`(html (head (title ,the-text))
|
||||
(body ([bgcolor "white"])
|
||||
(p ,the-text))))
|
||||
(p ,the-text)))))
|
||||
|
|
@ -11,21 +11,20 @@
|
|||
;; choices = (listof string), possible answers to the question
|
||||
;; correct-answer = integer, index into choices
|
||||
;;
|
||||
|
||||
(module quiz mzscheme
|
||||
;; Configuration
|
||||
(define *data-file*
|
||||
(build-path (collection-path "web-server")
|
||||
"default-web-root" "servlets" "examples" "english-measure-questions.ss"))
|
||||
(define *questions-per-quiz* 5)
|
||||
|
||||
|
||||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "list.ss")
|
||||
(lib "etc.ss"))
|
||||
|
||||
(unit (import servlet^)
|
||||
(export)
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
;; Accessors into question sexp's
|
||||
(define question-text car)
|
||||
|
|
@ -201,8 +200,6 @@
|
|||
(run-quiz))
|
||||
|
||||
;; Entry point into servlet.
|
||||
(run-quiz)
|
||||
|
||||
)
|
||||
|
||||
(define (start initial-request)
|
||||
(run-quiz)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
5)
|
||||
(module bad-return mzscheme
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
5))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
(raise 'kablooie))
|
||||
(module broken mzscheme
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(raise 'kablooie)))
|
||||
|
|
@ -1,10 +1,9 @@
|
|||
(require (lib "servlet-sig.ss" "web-server")
|
||||
(lib "unit.ss"))
|
||||
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
|
||||
(module incremental mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(send/finish
|
||||
(make-html-response/incremental
|
||||
(lambda (output-chunk)
|
||||
|
|
@ -12,4 +11,4 @@
|
|||
"my-title</title></head>\n")
|
||||
(output-chunk "<body><p>The first paragraph</p>\n")
|
||||
(sleep 4)
|
||||
(output-chunk "<p>The second paragraph</p></body></html>\n")))))
|
||||
(output-chunk "<p>The second paragraph</p></body></html>\n"))))))
|
||||
|
|
@ -1,8 +1,9 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
(module mime mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
`("text/uber-format"
|
||||
"uber uber uber"
|
||||
"-de-doo"))
|
||||
"-de-doo")))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(module bad-xexpr mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start initial-request)
|
||||
(send/back
|
||||
`(html (a ([href url])
|
||||
"Title")))))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(module bus-error mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 120)
|
||||
|
||||
(define (end request)
|
||||
`(html (body "End")))
|
||||
|
||||
(define (start request)
|
||||
(send/suspend/callback
|
||||
`(html (body (p (a ([href ,start]) "Forward"))
|
||||
(p (a ([href ,end]) "End")))))))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(module button mzscheme
|
||||
(require (lib "mred.ss" "mred")
|
||||
(lib "class.ss"))
|
||||
(provide interface-version timeout start)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(let ([b (new button% (label "Button"))])
|
||||
(list #"text/plain" "Button"))))
|
||||
|
|
@ -0,0 +1 @@
|
|||
/Users/jay/Development/Projects/papers/web-cells/cell-example.ss
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
(module counter-cells mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start _)
|
||||
(main-page))
|
||||
|
||||
(define the-counter (make-web-cell:local 0))
|
||||
(define the-header (make-web-cell:local (box "Main page")))
|
||||
|
||||
(define (counter)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 ,(number->string (web-cell:local-ref the-counter)))
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(web-cell:local-mask the-counter
|
||||
(add1 (web-cell:local-ref the-counter)))
|
||||
(counter)))])
|
||||
"Increment")
|
||||
(br)
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
'exit))])
|
||||
"Exit")))))
|
||||
|
||||
(define (main-page)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 ,(unbox (web-cell:local-ref the-header)))
|
||||
(form ([method "POST"]
|
||||
[action ,(embed/url
|
||||
(lambda (req)
|
||||
(set-box! (web-cell:local-ref the-header)
|
||||
(extract-binding/single 'header (request-bindings req)))
|
||||
(main-page)))])
|
||||
(input ([type "text"] [name "header"]))
|
||||
(input ([type "submit"])))
|
||||
(br)
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(counter)
|
||||
(main-page)))])
|
||||
"View Counter"))))))
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
(module counter-cps mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start _)
|
||||
(main-page))
|
||||
|
||||
(define the-counter (make-parameter 0))
|
||||
|
||||
(define (counter k)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 ,(number->string (the-counter)))
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(parameterize ([the-counter (add1 (the-counter))])
|
||||
(counter k))))])
|
||||
"Increment")
|
||||
(br)
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(k 'exit)))])
|
||||
"Exit")))))
|
||||
|
||||
(define (main-page)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 "Main page")
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(counter
|
||||
(lambda (v)
|
||||
(main-page)))))])
|
||||
"View Counter"))))))
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
(module counter mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start _)
|
||||
(main-page))
|
||||
|
||||
(define the-counter (make-parameter 0))
|
||||
|
||||
(define (counter)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 ,(number->string (the-counter)))
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(parameterize ([the-counter (add1 (the-counter))])
|
||||
(counter))))])
|
||||
"Increment")
|
||||
(br)
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
'exit))])
|
||||
"Exit")))))
|
||||
|
||||
(define (main-page)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 "Main page")
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(counter)
|
||||
(main-page)))])
|
||||
"View Counter"))))))
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
(module cust mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define servlet-cust (current-custodian))
|
||||
(define timeout 30)
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define (start ir)
|
||||
`(html
|
||||
(head (title "Custodian test"))
|
||||
(body
|
||||
(p ,(if (eq? (current-custodian) servlet-cust)
|
||||
"It didn't work."
|
||||
"It did work."))))))
|
||||
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
(module expiration mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define timeout (* 60 3))
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define (start initial-request)
|
||||
(parameterize ([current-servlet-continuation-expiration-handler
|
||||
(lambda (request-for-expired)
|
||||
(send/back
|
||||
`(html (body (p "You lose! (Default)")))))])
|
||||
(let loop ([request initial-request])
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html
|
||||
(head (title "Expiration demo"))
|
||||
(body (p "Open each of the links below in a new window. Then click the link in 'Forget' window. Then reload each window.")
|
||||
(p (a ([href ,(embed/url loop)])
|
||||
"Loop"))
|
||||
(p (a ([href ,(embed/url
|
||||
loop
|
||||
(lambda (request-for-expired)
|
||||
(send/back
|
||||
`(html (head (title "Expiration demo"))
|
||||
(body (p "You win! (Special)"))))))])
|
||||
"Loop w/ Expiration"))
|
||||
(p (a ([href ,(embed/url
|
||||
(lambda (request)
|
||||
(loop
|
||||
(send/forward
|
||||
(lambda (k-url)
|
||||
`(html (head (title "Expiration demo"))
|
||||
(body (p (a ([href ,k-url]) "Forget the past.")))))))))])
|
||||
"Prepare to forget the past."))))))))))
|
||||
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
(module fault mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout 30)
|
||||
(define X 0)
|
||||
(define (start request)
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(a ([href ,k-url]) "Click")))
|
||||
(set! X (add1 X))
|
||||
(format "~a" "fault")))
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
(module form mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "pretty.ss"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start _)
|
||||
(define req
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html
|
||||
(body
|
||||
(form ([action ,k-url] [method "POST"])
|
||||
(input ([type "checkbox"] [name "checkbox"]))
|
||||
(input ([type "text"] [name "text"]))
|
||||
(input ([type "submit"] [name "submit"]))))))))
|
||||
(define binds
|
||||
(request-bindings req))
|
||||
(define sport
|
||||
(open-output-string))
|
||||
(define pp
|
||||
(parameterize ([current-output-port sport])
|
||||
(pretty-print binds)))
|
||||
`(html
|
||||
(body
|
||||
(pre
|
||||
,(get-output-string sport))))))
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
(module fupload mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "plt-match.ss"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define timeout 60)
|
||||
(define interface-version 'v1)
|
||||
(define (start initial-request)
|
||||
(send/suspend/callback
|
||||
`(html (head)
|
||||
(body
|
||||
(form ([action
|
||||
,(lambda (request)
|
||||
(define b (request-bindings/raw request))
|
||||
(match (bindings-assq #"file" b)
|
||||
[(struct binding:file (_ filename _))
|
||||
`(html
|
||||
(body
|
||||
,(bytes->string/utf-8 filename)))]))]
|
||||
[method "post"]
|
||||
[enctype "multipart/form-data"])
|
||||
(h3 "Submit for an Assignment")
|
||||
(input ([name "file"] [type "file"] [size "30"]))
|
||||
(input ([type "submit"] [value "Submit"]))))))))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
(module hang mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
|
||||
(define (start initial-request)
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html (a ([href ,k-url]) "Next"))))
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html (a ([href ,k-url]) "Error"))))
|
||||
(/ 1 0)))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
(module hod-0618 mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout 30)
|
||||
(define (start _)
|
||||
`(html
|
||||
(body
|
||||
,(extract-binding/single
|
||||
'test:case
|
||||
(request-bindings
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html
|
||||
(body
|
||||
(form ([method "POST"]
|
||||
[action ,k-url])
|
||||
(input ([type "text"] [name "test:case"]))
|
||||
(input ([type "submit"])))))))))))))
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
(module inf-essence mzscheme
|
||||
(define a (alarm-evt +inf.0))
|
||||
|
||||
(let loop ()
|
||||
(sync
|
||||
(handle-evt a
|
||||
(lambda _
|
||||
(printf "Infinity has passed.~n")))
|
||||
(handle-evt (alarm-evt (+ (current-inexact-milliseconds)
|
||||
(* 1000 1)))
|
||||
(lambda _
|
||||
(printf "One second has passed.~n"))))
|
||||
(loop)))
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
(module inf mzscheme
|
||||
(provide interface-version timeout start)
|
||||
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define timeout +inf.0)
|
||||
|
||||
; start : request -> response
|
||||
(define (start initial-request)
|
||||
`(html (head (title "A Test Page"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "This is a simple module servlet.")))))
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
(module instance-expiration-2 mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define timeout 5)
|
||||
(define interface-version 'v2)
|
||||
|
||||
(define (instance-expiration-handler expired-request)
|
||||
; Not allowed to call any (lib "servlet.ss" "web-server") methods
|
||||
; (I can't enforce this, however, so if you accidentally do weird things will happen.)
|
||||
(send/suspend (lambda (k)
|
||||
`(html (head (title "You win.")) (body "You win.")))))
|
||||
|
||||
(define (start initial-request)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html
|
||||
(head (title "Instance expiration demo"))
|
||||
(body (p (a ([href ,(embed/url
|
||||
(lambda (request)
|
||||
`(html (head (title "Instance expiration demo"))
|
||||
(body (p "Reload in a few minutes.")
|
||||
(p "(or change the instance id to something made up.")))))])
|
||||
"Click this link."))))))))
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
(module instance-expiration mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define timeout 5)
|
||||
(define interface-version 'v2)
|
||||
|
||||
(define (instance-expiration-handler expired-request)
|
||||
; Not allowed to call any (lib "servlet.ss" "web-server") methods
|
||||
; (I can't enforce this, however, so if you accidentally do weird things will happen.)
|
||||
`(html (head (title "You win.")) (body "You win.")))
|
||||
|
||||
(define (start initial-request)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html
|
||||
(head (title "Instance expiration demo"))
|
||||
(body (p (a ([href ,(embed/url
|
||||
(lambda (request)
|
||||
`(html (head (title "Instance expiration demo"))
|
||||
(body (p "Reload in a few minutes.")
|
||||
(p "(or change the instance id to something made up.")))))])
|
||||
"Click this link."))))))))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(module jas01-fix-param mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide get-time)
|
||||
|
||||
(define load-time
|
||||
(make-web-cell:local #f))
|
||||
|
||||
(define (get-time)
|
||||
(web-cell:local-ref load-time))
|
||||
|
||||
(web-cell:local-set! load-time (current-seconds)))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(module jas01-fix mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
"jas01-fix-param.ss")
|
||||
|
||||
(provide interface-version timeout start)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
; start : request -> response
|
||||
(define (start initial-request)
|
||||
(report-errors-to-browser send/finish)
|
||||
`(html (head (title "Servlet Parameter Test"))
|
||||
(body (h1 "Servlet Parameter Test")
|
||||
,(number->string (get-time))))))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(module jas01-param mzscheme
|
||||
(provide get-time)
|
||||
|
||||
(define load-time (make-parameter #f))
|
||||
|
||||
(define (get-time)
|
||||
(load-time))
|
||||
|
||||
(load-time (current-seconds)))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(module jas01-test mzscheme
|
||||
(define start #f)
|
||||
(thread-wait
|
||||
(thread
|
||||
(lambda ()
|
||||
(set! start (dynamic-require "jas01.ss" 'start)))))
|
||||
(thread-wait
|
||||
(thread
|
||||
(lambda ()
|
||||
(printf "~S~n" (start 'foo))))))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(module jas01 mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
"jas01-param.ss")
|
||||
|
||||
(provide interface-version timeout start)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
; start : request -> response
|
||||
(define (start initial-request)
|
||||
(report-errors-to-browser send/finish)
|
||||
`(html (head (title "Servlet Parameter Test"))
|
||||
(body (h1 "Servlet Parameter Test")
|
||||
,(number->string (get-time))))))
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
(module lock mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v2-transitional)
|
||||
(define timeout 60)
|
||||
(define (instance-expiration-handler _)
|
||||
`(html (body "Error")))
|
||||
(define (start _)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (body
|
||||
(p (a ([href ,(embed/url
|
||||
(lambda _
|
||||
(sleep 5)
|
||||
(second "Slow")))])
|
||||
"Slow"))
|
||||
(p (a ([href ,(embed/url
|
||||
(lambda _
|
||||
(second "Fast")))])
|
||||
"Fast")))))))
|
||||
(define (second label)
|
||||
`(html (body ,label
|
||||
,(number->string (current-seconds))))))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(module none-test mzscheme
|
||||
(require (lib "none.ss" "web-server" "managers"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v2-transitional)
|
||||
(define manager (create-none-manager
|
||||
(lambda (failed-request)
|
||||
`(html (body (h2 "Error"))))))
|
||||
(define (start initial-request)
|
||||
`(html (body (h2 "Look Ma, No Instance!")))))
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
(module plus mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "pretty.ss"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start _)
|
||||
(define req
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html
|
||||
(body
|
||||
(form ([action ,k-url] [method "POST"])
|
||||
(input ([type "checkbox"] [name "checkbox"]))
|
||||
(input ([type "text"] [name "text+foo"]))
|
||||
(input ([type "submit"] [name "submit"]))))))))
|
||||
(define binds
|
||||
(request-bindings req))
|
||||
(define sport
|
||||
(open-output-string))
|
||||
(define pp
|
||||
(parameterize ([current-output-port sport])
|
||||
(pretty-print binds)))
|
||||
`(html
|
||||
(body
|
||||
(pre
|
||||
,(get-output-string sport))))))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
(module pr5490 mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 120)
|
||||
(define (start ireq)
|
||||
(send/finish '(("paul") "..."))))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
(module pr5565 mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 120)
|
||||
(define (start ireq)
|
||||
(define p
|
||||
(send/suspend
|
||||
(build-suspender `("Test of Page 2")
|
||||
`((input ([type "submit"][value "pls test with and without topping"]))))))
|
||||
(define q
|
||||
(send/suspend
|
||||
(build-suspender `("Bug")
|
||||
`((input ([type "text"][name "x"]))))))
|
||||
(define r (extract-binding/single `x (request-bindings q)))
|
||||
(send/suspend
|
||||
(build-suspender `("Result of test")
|
||||
(list r)))))
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
(module pr7359 mzscheme
|
||||
(require (lib "serialize.ss")
|
||||
(lib "servlet.ss" "web-server"))
|
||||
(provide interface-version timeout start)
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
(define-serializable-struct foo ())
|
||||
(define (start req)
|
||||
(deserialize (serialize (make-foo)))
|
||||
`(html (body "Made it"))))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
(module pr7533 mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start initial-request)
|
||||
(define start-time (current-seconds))
|
||||
(let loop ((last-time start-time))
|
||||
(let ((time (current-seconds)))
|
||||
(send/suspend
|
||||
(lambda (k)
|
||||
`(html
|
||||
(form ((action ,k) (method "post"))
|
||||
(p ,(format "It has been ~a seconds since starting (~a seconds since last iteration)."
|
||||
(- time start-time)
|
||||
(- time last-time)))
|
||||
(input ((type "submit")))))))
|
||||
(loop time)))))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(module pr7935-other mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
|
||||
(define (start initial-request)
|
||||
;(report-errors-to-browser send/back)
|
||||
(/ 1 0)))
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
(module ssd mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout 120)
|
||||
(define (start ir)
|
||||
(printf "X~n")
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (head)
|
||||
(body
|
||||
(ul
|
||||
,@(map (lambda (i)
|
||||
`(li (a ([href ,(embed/url
|
||||
(lambda (r)
|
||||
`(html (head) (body ,i))))])
|
||||
,(number->string i))))
|
||||
`(1 2 3 4 5 6 7 8 9 0)))))))))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(module static mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide interface-version timeout start)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(list
|
||||
#"text/html"
|
||||
"<html><head></head><body>Foo</body><html>")))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(module update mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define timeout 60)
|
||||
(define interface-version 'v1)
|
||||
(define (start initial-request)
|
||||
(send/back
|
||||
`(html (head)
|
||||
(body
|
||||
(h1 "Hey"))))))
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
(module utf8 mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start initial-request)
|
||||
(extract-binding/single
|
||||
'name
|
||||
(request-bindings
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html
|
||||
(body
|
||||
(form ([action ,k-url])
|
||||
(input ([type "text"] [name "name"]))
|
||||
(input ([type "submit"])))))))))))
|
||||
|
|
@ -1,19 +1,19 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
(module size mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
(let* ([line-size 80]
|
||||
[build-a-str
|
||||
(lambda (n)
|
||||
(define line-size 80)
|
||||
(define (build-a-str n)
|
||||
(list->string (let loop ([n n])
|
||||
(cond
|
||||
[(zero? n) (list #\newline)]
|
||||
[else (cons #\a (loop (sub1 n)))]))))]
|
||||
[line (build-a-str (sub1 line-size))]
|
||||
[html-overhead 68])
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
|
||||
[else (cons #\a (loop (sub1 n)))]))))
|
||||
(define line (build-a-str (sub1 line-size)))
|
||||
(define html-overhead 68)
|
||||
(define (start initial-request)
|
||||
(define bindings (request-bindings initial-request))
|
||||
(define size (- (string->number (cdr (assq 'size bindings))) html-overhead))
|
||||
(define nlines (quotient size line-size))
|
||||
(define extra (remainder size line-size))
|
||||
|
|
|
|||
|
|
@ -1,9 +1,11 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server"))
|
||||
(let ([count 0])
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
(module test mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define count 0)
|
||||
|
||||
(define (start initial-request)
|
||||
(with-handlers ([void (lambda (exn) `(html (body (p ,(exn-message exn)))))])
|
||||
(set! count (add1 count))
|
||||
`(html (head (title "Testing 1...2...3"))
|
||||
|
|
|
|||
|
|
@ -1,10 +1,13 @@
|
|||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(module url mzscheme
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "url.ss" "net"))
|
||||
(let ([count 0])
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
||||
(define count 0)
|
||||
|
||||
(define (start initial-request)
|
||||
(set! count (add1 count))
|
||||
`(html (head (title "URL Test"))
|
||||
(body (p "The method requested is: " ,(format "~s" (request-method initial-request)))
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
(require (lib "url.ss" "net")
|
||||
(lib "kw.ss")
|
||||
(lib "plt-match.ss")
|
||||
(lib "unit.ss")
|
||||
(lib "string.ss")
|
||||
(lib "contract.ss"))
|
||||
(require "dispatch.ss"
|
||||
|
|
@ -11,7 +10,6 @@
|
|||
"../private/response.ss"
|
||||
"../response-structs.ss"
|
||||
"../servlet.ss"
|
||||
"../sig.ss"
|
||||
"../private/configuration.ss"
|
||||
"../private/util.ss"
|
||||
"../managers/manager.ss"
|
||||
|
|
@ -308,14 +306,6 @@
|
|||
;;;;;; (XXX: I don't know what 'typed-model-split-store0 was, so it was removed.)
|
||||
;;;; A response
|
||||
(define (load-servlet/path a-path)
|
||||
(define (v0.servlet->v1.lambda servlet)
|
||||
(lambda (initial-request)
|
||||
(define servlet@ (unit-from-context servlet^))
|
||||
(invoke-unit
|
||||
(compound-unit
|
||||
(import) (export)
|
||||
(link (((S : servlet^)) servlet@)
|
||||
(() servlet S))))))
|
||||
(define (v0.response->v1.lambda response-path response)
|
||||
(define go
|
||||
(box
|
||||
|
|
@ -333,16 +323,6 @@
|
|||
; XXX load/use-compiled breaks errortrace
|
||||
(define s (load/use-compiled a-path))
|
||||
(cond
|
||||
;; signed-unit servlet
|
||||
; MF: I'd also like to test that s has the correct import signature.
|
||||
[(unit? s)
|
||||
(make-servlet (current-custodian)
|
||||
(current-namespace)
|
||||
(create-timeout-manager
|
||||
default-servlet-instance-expiration-handler
|
||||
timeouts-servlet-connection
|
||||
timeouts-default-servlet)
|
||||
(v0.servlet->v1.lambda s))]
|
||||
; FIX - reason about exceptions from dynamic require (catch and report if not already)
|
||||
;; module servlet
|
||||
[(void? s)
|
||||
|
|
@ -359,7 +339,7 @@
|
|||
timeouts-servlet-connection
|
||||
timeout)
|
||||
(v1.module->v1.lambda timeout start)))]
|
||||
[(v2-transitional) ; XXX: Undocumented
|
||||
[(v2 v2-transitional) ; XXX: Undocumented
|
||||
(let ([start (dynamic-require module-name 'start)]
|
||||
[manager (with-handlers
|
||||
([exn:fail:contract?
|
||||
|
|
|
|||
|
|
@ -1,22 +1,22 @@
|
|||
(module configure mzscheme
|
||||
(require (lib "unit.ss")
|
||||
(lib "servlet-sig.ss" "web-server")
|
||||
(require (lib "servlet.ss" "web-server")
|
||||
(lib "url.ss" "net")
|
||||
(lib "etc.ss")
|
||||
(lib "list.ss")
|
||||
(lib "pretty.ss")
|
||||
(lib "file.ss")
|
||||
(lib "contract.ss")
|
||||
(only (lib "configuration.ss" "web-server")
|
||||
default-configuration-table-path)
|
||||
(lib "configuration-table-structs.ss" "web-server" "private")
|
||||
(lib "parse-table.ss" "web-server" "private")
|
||||
(lib "configuration-util.ss" "web-server" "private")
|
||||
(lib "util.ss" "web-server" "private"))
|
||||
(provide/contract
|
||||
[servlet unit?]
|
||||
; XXX contract
|
||||
[servlet-maker (string? . -> . unit?)])
|
||||
(provide
|
||||
interface-version timeout
|
||||
start)
|
||||
|
||||
(define timeout (* 12 60 60))
|
||||
(define interface-version 'v1)
|
||||
|
||||
;; FIX
|
||||
; - fuss with changing absolute paths into relative ones internally
|
||||
|
|
@ -30,18 +30,13 @@
|
|||
; - change all configuration paths (in the configure servlet and in the server) to
|
||||
; use a platform independent representation (i.e. a listof strings)
|
||||
|
||||
; servlet-maker : str -> (unit/sig servlet^ -> ())
|
||||
(define (servlet-maker default-configuration-path)
|
||||
(unit
|
||||
(import servlet^)
|
||||
(export)
|
||||
(define default-configuration-path default-configuration-table-path)
|
||||
(define (set-config-path! new)
|
||||
(set! default-configuration-path new))
|
||||
|
||||
(define CONFIGURE-SERVLET-NAME "configure.ss")
|
||||
(define WIDE "70")
|
||||
|
||||
(adjust-timeout! (* 12 60 60))
|
||||
(error-print-width 800) ; 10-ish lines
|
||||
|
||||
; passwords = (listof realm)
|
||||
; realm = (make-realm str str (listof user-pass))
|
||||
(define-struct realm (name pattern allowed))
|
||||
|
|
@ -84,8 +79,6 @@
|
|||
(send/finish access-error-page))
|
||||
request)
|
||||
|
||||
(check-ip-address initial-request)
|
||||
|
||||
(define web-base (directory-part default-configuration-path))
|
||||
|
||||
; more here - abstract with static pages?
|
||||
|
|
@ -182,7 +175,7 @@
|
|||
; switch-to-current-port : configuration-table -> (U #f configuration-table)
|
||||
; doesn't work - the browser doesn't send the port and it wouldn't be reliable anyway
|
||||
; perhaps the server could include it?
|
||||
'(define (switch-to-current-port old)
|
||||
#;(define (switch-to-current-port old)
|
||||
(let ([current-port (url-port (request-uri initial-request))])
|
||||
(and (not (= current-port (configuration-table-port old)))
|
||||
(make-configuration-table
|
||||
|
|
@ -636,8 +629,8 @@
|
|||
|
||||
; Little Helpers
|
||||
|
||||
; initialization-error-page : response
|
||||
(define initialization-error-page
|
||||
; initialization-error-page : request -> response
|
||||
(define (initialization-error-page initial-request)
|
||||
`(html (head (title "Web Server Configuration Program Invocation Error"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "Please direct your browser directly to the "
|
||||
|
|
@ -781,12 +774,12 @@
|
|||
file-path
|
||||
(lambda (out)
|
||||
(pretty-print
|
||||
`(require (lib ,CONFIGURE-SERVLET-NAME "web-server"))
|
||||
`(module ,CONFIGURE-SERVLET-NAME mzscheme
|
||||
(require (lib ,CONFIGURE-SERVLET-NAME "web-server" "private"))
|
||||
(provide (all-from (lib ,CONFIGURE-SERVLET-NAME "web-server" "private")))
|
||||
(set-config-path! ,(path->string configuration-path)))
|
||||
out)
|
||||
(newline out)
|
||||
(pretty-print
|
||||
`(servlet-maker ,(path->string configuration-path))
|
||||
out))))))
|
||||
(newline out))))))
|
||||
|
||||
; extract-definition : sym (listof s-expr) -> s-expr
|
||||
; to return the rhs from (def name rhs) not (def (name . args) body)
|
||||
|
|
@ -804,6 +797,7 @@
|
|||
(define build-path-maybe-expression->file-name caddr)
|
||||
|
||||
; main
|
||||
(define (start initial-request)
|
||||
(error-print-width 800) ; 10-ish lines
|
||||
(check-ip-address initial-request)
|
||||
(choose-configuration-file)))
|
||||
|
||||
(define servlet (servlet-maker default-configuration-table-path)))
|
||||
|
|
|
|||
|
|
@ -3,13 +3,7 @@
|
|||
(require "private/dispatch-server-sig.ss")
|
||||
(provide ; XXX contract signature
|
||||
(rename dispatch-server^ web-server^)
|
||||
servlet^ web-config^ web-config/pervasive^ web-config/local^)
|
||||
|
||||
#;(define-signature web-server^
|
||||
((open dispatch-server^)))
|
||||
|
||||
(define-signature servlet^
|
||||
(initial-request send/suspend send/finish send/back send/forward adjust-timeout!))
|
||||
web-config^ web-config/pervasive^ web-config/local^)
|
||||
|
||||
; more here - rename
|
||||
(define-signature web-config/pervasive^
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user