Removing old web-server tests
svn: r11439
This commit is contained in:
Jay McCarthy
parent
81566dc3b3
commit
a194dfe369
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>A Test Page</title></head><body bgcolor="white"><p>A simple module servlet works.</p></body></html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>A Test Page</title></head><body bgcolor="white"><p>Here are the initial bindings: ((texan . "big-hat"))</p></body></html>
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
Servlet didn't load.
|
|
||||||
open-input-file: cannot open input file: "/home/ptg/plt/collects/web-server/default-web-root/servlets/tests/not-there-on-purpose.ss" (No such file or directory; errno=2)
|
|
||||||
|
|
@ -1,3 +0,0 @@
|
||||||
<html><head><title>my-title</title></head>
|
|
||||||
<body><p>The first paragraph</p>
|
|
||||||
<p>The second paragraph</p></body></html>
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
2b
|
|
||||||
<html><head><title>my-title</title></head>
|
|
||||||
|
|
||||||
21
|
|
||||||
<body><p>The first paragraph</p>
|
|
||||||
|
|
||||||
2a
|
|
||||||
<p>The second paragraph</p></body></html>
|
|
||||||
|
|
||||||
0
|
|
||||||
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
uber uber uber-de-doo
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
Servlet didn't load.
|
|
||||||
"Loading \"/home/ptg/plt/collects/web-server/default-web-root/./servlets/tests/non-unit.ss\" produced \n5\n instead of a servlet."
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><meta http-equiv="Pragma" content="no-cache" /><meta http-equiv="expires" content="-1" /><title>What is your name?</title></head><body bgcolor="white"><form action="/servlets/tests/suspended-module.ss;id15*k1-590544085" method="post">What is your name?<input type="text" name="name" /></form></body></html>
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
<html><head><title>Testing 1...2...3</title></head><body><p>This is a generated web page.</p><p>Here are the bindings:
|
|
||||||
()
|
|
||||||
<br />Count = 1<br />Here are the headers:
|
|
||||||
((host . #"127.0.0.1"))
|
|
||||||
</p></body></html>
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
<html><head><title>Testing 1...2...3</title></head><body><p>This is a generated web page.</p><p>Here are the bindings:
|
|
||||||
((a . "b") (see . "def"))
|
|
||||||
<br />Count = 2<br />Here are the headers:
|
|
||||||
((host . #"127.0.0.1"))
|
|
||||||
</p></body></html>
|
|
||||||
|
|
@ -1,25 +0,0 @@
|
||||||
(module build-plt mzscheme
|
|
||||||
(require setup/pack
|
|
||||||
mzlib/date
|
|
||||||
"suite.ss")
|
|
||||||
|
|
||||||
(define web-root (build-path "collects" "web-server" "default-web-root"))
|
|
||||||
|
|
||||||
(define exclude
|
|
||||||
(list (build-path web-root "servlets" "tests")
|
|
||||||
(build-path web-root "htdocs" "secret")
|
|
||||||
(build-path web-root "passwords")
|
|
||||||
(build-path web-root "log")))
|
|
||||||
|
|
||||||
(let ([why-broken (broken? 8180)])
|
|
||||||
(when why-broken
|
|
||||||
(error 'build-plt "The web server is broken~n~a" why-broken)))
|
|
||||||
|
|
||||||
(current-directory (build-path (collection-path "web-server") 'up 'up))
|
|
||||||
(pack "/home/ptg/.www/packages/web-server.plt"
|
|
||||||
(format "Web Server: ~a" (date->string (seconds->date (current-seconds))))
|
|
||||||
(list (build-path "collects" "web-server"))
|
|
||||||
'(("web-server"))
|
|
||||||
(lambda (p)
|
|
||||||
(and (not (member p exclude))
|
|
||||||
(std-filter p)))))
|
|
||||||
|
|
@ -1,28 +0,0 @@
|
||||||
((port 80)
|
|
||||||
(max-waiting 40)
|
|
||||||
(initial-connection-timeout 30)
|
|
||||||
(default-host-table
|
|
||||||
(host-table
|
|
||||||
(default-indices "index.html" "index.htm")
|
|
||||||
(log-format parenthesized-default)
|
|
||||||
(messages
|
|
||||||
(servlet-message "servlet-error.html")
|
|
||||||
(authentication-message "forbidden.html")
|
|
||||||
(servlets-refreshed "servlet-refresh.html")
|
|
||||||
(passwords-refreshed "passwords-refresh.html")
|
|
||||||
(file-not-found-message "not-found.html")
|
|
||||||
(protocol-message "protocol-error.html"))
|
|
||||||
(timeouts
|
|
||||||
(default-servlet-timeout 120)
|
|
||||||
(password-connection-timeout 300)
|
|
||||||
(servlet-connection-timeout 86400)
|
|
||||||
(file-per-byte-connection-timeout 1/20)
|
|
||||||
(file-base-connection-timeout 30))
|
|
||||||
(paths
|
|
||||||
(configuration-root "conf")
|
|
||||||
(host-root "web-root")
|
|
||||||
(log-file-path "log")
|
|
||||||
(file-root "htdocs")
|
|
||||||
(servlet-root ".")
|
|
||||||
(password-authentication "passwords"))))
|
|
||||||
(virtual-host-table))
|
|
||||||
|
|
@ -1,32 +0,0 @@
|
||||||
(module my-url mzscheme
|
|
||||||
(require (all-except net/url purify-port))
|
|
||||||
(provide purify-port
|
|
||||||
(struct mime-header (name value)))
|
|
||||||
;(provide (all-from-except url purify-port))
|
|
||||||
;(provide (all-from-except net/url purify-port))
|
|
||||||
; the -except is not needed, since purify-port was not imported.
|
|
||||||
(provide (all-from net/url))
|
|
||||||
|
|
||||||
; mime-header = (make-mime-header str str)
|
|
||||||
(define-struct mime-header (name value))
|
|
||||||
|
|
||||||
(define COLON:REGEXP (regexp (format "^([^:]*):[ ~a]*(.*)" #\tab)))
|
|
||||||
|
|
||||||
; match-colon : str -> (list str str str)
|
|
||||||
(define (match-colon s) (regexp-match COLON:REGEXP s))
|
|
||||||
|
|
||||||
; purify-port : iport -> (listof mime-header)
|
|
||||||
; Note: this function is silently robust. It ignores invalid input
|
|
||||||
(define (purify-port in)
|
|
||||||
(read-line in) ; skip HTTP/x.y NNN mumble
|
|
||||||
(let read-headers ()
|
|
||||||
(let ([line (read-line in 'any)])
|
|
||||||
(cond
|
|
||||||
[(eof-object? line) null]
|
|
||||||
[(zero? (string-length line)) null]
|
|
||||||
[(match-colon line) =>
|
|
||||||
(lambda (x)
|
|
||||||
(cons (make-mime-header (cadr x) (caddr x))
|
|
||||||
(read-headers)))]
|
|
||||||
[else ; error - bad header
|
|
||||||
(read-headers)])))))
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
(module pr7823 mzscheme
|
|
||||||
(require web-server/response-structs)
|
|
||||||
|
|
||||||
(define x (make-response/full
|
|
||||||
200 "OK" (current-seconds) #"text/html" '()
|
|
||||||
(list "<html><body>Hello</body></html>")))
|
|
||||||
|
|
||||||
(display x) (newline)
|
|
||||||
(display (response/full-body x)) (newline)
|
|
||||||
(display (response/basic-extras x)) (newline))
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
(require-library "suite.ss" "server" "test")
|
|
||||||
(require-library "web-hammer.ss" "server" "test")
|
|
||||||
|
|
||||||
; more here - search for a port that works
|
|
||||||
(define port 8080)
|
|
||||||
(broken? port)
|
|
||||||
; calling broken? also starts a server in another underlying OS process on the same machine
|
|
||||||
|
|
||||||
(define run1
|
|
||||||
(server-performance (string->url (format "http://127.0.0.1:~a/" port))
|
|
||||||
16 0 120))
|
|
||||||
|
|
@ -1,93 +0,0 @@
|
||||||
;; Mike Burns, July 8th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Useful assertions
|
|
||||||
(module assertions mzscheme
|
|
||||||
(require schemeunit/test
|
|
||||||
web-server/web-server
|
|
||||||
web-server/configuration
|
|
||||||
net/url
|
|
||||||
net/head
|
|
||||||
mzlib/contract)
|
|
||||||
|
|
||||||
(provide assert-serve assert-serve/string assert-status-number assert-with-server)
|
|
||||||
(provide/contract
|
|
||||||
(start-server (-> (-> any)))
|
|
||||||
(full-url (string? . -> . url?))
|
|
||||||
(web-root path?)
|
|
||||||
(input-port-equal? (input-port? input-port? . -> . boolean?))
|
|
||||||
(THE-PORT number?)
|
|
||||||
(THE-IP string?))
|
|
||||||
|
|
||||||
(define THE-PORT 8135)
|
|
||||||
|
|
||||||
(define THE-IP "127.0.0.1")
|
|
||||||
|
|
||||||
(define web-root (build-path (collection-path "tests")
|
|
||||||
"web-server"
|
|
||||||
"scheme-units"
|
|
||||||
"test-web-root"))
|
|
||||||
|
|
||||||
(define-simple-assertion (assert-serve url-path file-path content-type)
|
|
||||||
(assert-with-server
|
|
||||||
url-path
|
|
||||||
(lambda (http-port)
|
|
||||||
(and (content-type-equal? (purify-port http-port) content-type)
|
|
||||||
(call-with-input-file
|
|
||||||
file-path
|
|
||||||
(lambda (f-port)
|
|
||||||
(input-port-equal? http-port f-port)))))))
|
|
||||||
|
|
||||||
(define-simple-assertion (assert-serve/string url-path str content-type)
|
|
||||||
(assert-with-server
|
|
||||||
url-path
|
|
||||||
(lambda (http-port)
|
|
||||||
(and (content-type-equal? (purify-port http-port) content-type)
|
|
||||||
(let ((is (open-input-string str)))
|
|
||||||
(input-port-equal? http-port is))))))
|
|
||||||
|
|
||||||
(define-simple-assertion (assert-status-number url-path status-number)
|
|
||||||
(assert-with-server
|
|
||||||
url-path
|
|
||||||
(lambda (http-port)
|
|
||||||
(regexp-match
|
|
||||||
(format "^HTTP/... ~a" status-number)
|
|
||||||
(read-line http-port)))))
|
|
||||||
|
|
||||||
(define-simple-assertion (assert-with-server url-path assertion)
|
|
||||||
;; Ordering matters, so use let*
|
|
||||||
(let* ((stop-server (start-server))
|
|
||||||
(http-port (get-impure-port (full-url url-path))))
|
|
||||||
(begin0
|
|
||||||
(assertion http-port)
|
|
||||||
(stop-server))))
|
|
||||||
|
|
||||||
;; Format a URL
|
|
||||||
(define (full-url url-path)
|
|
||||||
(string->url (format "http://~a:~a~a" THE-IP THE-PORT url-path)))
|
|
||||||
|
|
||||||
;; Start the Web server
|
|
||||||
(define (start-server)
|
|
||||||
(serve (load-configuration (expand-path "configuration-table")) THE-PORT THE-IP))
|
|
||||||
|
|
||||||
;; It is a HTML MIME header if the Content-type header exists as a string,
|
|
||||||
;; and is "text/plain". In practice, it can be anything matching the regexp
|
|
||||||
;; "^text/plain;*.*", but not in the PLT Web server.
|
|
||||||
(define/contract content-type-equal?
|
|
||||||
(string? string? . -> . boolean?)
|
|
||||||
(lambda (header content-type)
|
|
||||||
(let ((header-content-type (extract-field "Content-type" header)))
|
|
||||||
(and header-content-type
|
|
||||||
(string? header-content-type)
|
|
||||||
(string=? header-content-type content-type)))))
|
|
||||||
|
|
||||||
;; Two input ports are equal if each line read from them are equal, and they
|
|
||||||
;; are the same size.
|
|
||||||
(define (input-port-equal? a b)
|
|
||||||
(let ((a-line (read-line a))
|
|
||||||
(b-line (read-line b)))
|
|
||||||
(cond
|
|
||||||
((eof-object? a-line) (eof-object? b-line))
|
|
||||||
((eof-object? b-line) (eof-object? a-line))
|
|
||||||
((equal? a-line b-line) (input-port-equal? a b))
|
|
||||||
(else #f))))
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
@ -1,28 +0,0 @@
|
||||||
((port 8135)
|
|
||||||
(max-waiting 40)
|
|
||||||
(initial-connection-timeout 30)
|
|
||||||
(default-host-table
|
|
||||||
(host-table
|
|
||||||
(default-indices "index.html" "index.htm")
|
|
||||||
(log-format parenthesized-default)
|
|
||||||
(messages
|
|
||||||
(servlet-message "servlet-error.html")
|
|
||||||
(authentication-message "forbidden.html")
|
|
||||||
(servlets-refreshed "servlet-refresh.html")
|
|
||||||
(passwords-refreshed "passwords-refresh.html")
|
|
||||||
(file-not-found-message "not-found.html")
|
|
||||||
(protocol-message "protocol-error.html"))
|
|
||||||
(timeouts
|
|
||||||
(default-servlet-timeout 120)
|
|
||||||
(password-connection-timeout 300)
|
|
||||||
(servlet-connection-timeout 86400)
|
|
||||||
(file-per-byte-connection-timeout 1/20)
|
|
||||||
(file-base-connection-timeout 30))
|
|
||||||
(paths
|
|
||||||
(configuration-root "conf")
|
|
||||||
(host-root "test-web-root")
|
|
||||||
(log-file-path "log")
|
|
||||||
(file-root "htdocs")
|
|
||||||
(servlet-root ".")
|
|
||||||
(password-authentication "passwords"))))
|
|
||||||
(virtual-host-table))
|
|
||||||
|
|
@ -1,66 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test serving files that require authentication.
|
|
||||||
(module test-authentication mzscheme
|
|
||||||
(require mzlib/contract
|
|
||||||
schemeunit/test
|
|
||||||
net/url
|
|
||||||
net/head
|
|
||||||
net/base64
|
|
||||||
"assertions.ss"
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
(test-authentication test-suite?))
|
|
||||||
|
|
||||||
;; Check for 403.
|
|
||||||
(define-simple-assertion (assert-no-serve url-path)
|
|
||||||
;; Ordering matters, so use let*
|
|
||||||
(let* ((stop-server (start-server))
|
|
||||||
(http-port (get-impure-port (full-url url-path))))
|
|
||||||
(begin0
|
|
||||||
(not (equal? (read-line http-port) "HTTP/1.1 200 Okay\r"))
|
|
||||||
(stop-server))))
|
|
||||||
|
|
||||||
(define-simple-assertion (assert-auth url-path auth-string)
|
|
||||||
(let* ((stop-server (start-server))
|
|
||||||
(http-port (get-impure-port (full-url url-path)
|
|
||||||
(auth-headers auth-string))))
|
|
||||||
(begin0
|
|
||||||
(equal? (read-line http-port) "HTTP/1.1 200 Okay\r")
|
|
||||||
(stop-server))))
|
|
||||||
|
|
||||||
;; Create the headers for an authorization string.
|
|
||||||
(define/contract auth-headers
|
|
||||||
(bytes? . -> . (listof string?))
|
|
||||||
(lambda (auth-string)
|
|
||||||
(list (format "authorization: Basic ~a"
|
|
||||||
(base64-encode auth-string)))))
|
|
||||||
|
|
||||||
(define test-authentication
|
|
||||||
(make-test-suite
|
|
||||||
(make-test-case
|
|
||||||
"Authorization-only file without providing authorization, implicit file"
|
|
||||||
(assert-no-serve "/secret/"))
|
|
||||||
(make-test-case
|
|
||||||
"Authorization-only file with provided authorization, implicit file"
|
|
||||||
(assert-auth "/secret/" #"bubba:bbq"))
|
|
||||||
(make-test-case
|
|
||||||
"Authorization-only file without providing authorization, explicit file"
|
|
||||||
(assert-no-serve "/secret/index.html"))
|
|
||||||
(make-test-case
|
|
||||||
"Authorization-only file with provided authorization, explicit file"
|
|
||||||
(assert-auth "/secret/index.html" #"bubba:bbq"))))
|
|
||||||
|
|
||||||
;;; TODO
|
|
||||||
;;; browser requests file,
|
|
||||||
;;; browser gives 403,
|
|
||||||
;;; browser provides creditentials,
|
|
||||||
;;; server provides file
|
|
||||||
|
|
||||||
;;; browser requests file,
|
|
||||||
;;; browser gives 403,
|
|
||||||
;;; browser provides creditentials,
|
|
||||||
;;; creditentials are bogus,
|
|
||||||
;;; server does not provide file
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
@ -1,28 +0,0 @@
|
||||||
;; Mike Burns, July 8th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test async-channel:
|
|
||||||
(module test-channel mzscheme
|
|
||||||
(require schemeunit/test
|
|
||||||
web-server/channel)
|
|
||||||
|
|
||||||
(provide test-channel)
|
|
||||||
|
|
||||||
(define test-channel
|
|
||||||
(let ((c (make-async-channel))
|
|
||||||
(v (gensym)))
|
|
||||||
(make-test-suite
|
|
||||||
"Test async-channel"
|
|
||||||
(make-test-case
|
|
||||||
"async-channel-get-available of the empty channel"
|
|
||||||
(assert-eq? (void) (async-channel-get-available c (lambda (x) #f))))
|
|
||||||
(make-test-case
|
|
||||||
"async-channel-get-available of the non-empty channel"
|
|
||||||
(assert-false (begin (async-channel-put c v)
|
|
||||||
(async-channel-get-available c (lambda (x) #f)))))
|
|
||||||
(make-test-case
|
|
||||||
"async-channel-try-get of the empty channel"
|
|
||||||
(assert-false (async-channel-try-get c (lambda () #f))))
|
|
||||||
(make-test-case
|
|
||||||
"async-channel-try-get of the non-empty channel"
|
|
||||||
(assert-eq? v (begin (async-channel-put c v)
|
|
||||||
(async-channel-try-get c (lambda () #f))))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,70 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test the error messages for both headers and content.
|
|
||||||
(module test-errors mzscheme
|
|
||||||
(require schemeunit/test
|
|
||||||
net/url
|
|
||||||
"assertions.ss"
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide test-errors)
|
|
||||||
|
|
||||||
(define test-errors
|
|
||||||
(make-test-suite
|
|
||||||
"Test the error messages for both headers and content"
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"404 with an absolute filename"
|
|
||||||
(assert-status-number "/does-not-exist" 404))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"404 with a relative filename"
|
|
||||||
(assert-status-number "does-not-exist" 404))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"404 with an absolute directory name"
|
|
||||||
(assert-status-number "/does-not-exist/" 404))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"404 with an relative directory name"
|
|
||||||
(assert-status-number "does-not-exist/" 404))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"404 with an absolute servlet"
|
|
||||||
(assert-status-number "/servlets/does-not-exist" 404))
|
|
||||||
|
|
||||||
; Not in suite.ss
|
|
||||||
;(make-test-case
|
|
||||||
; "Unit servlet not returning a response"
|
|
||||||
; ...)
|
|
||||||
;;; TODO check headers
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"Require failure"
|
|
||||||
(assert-with-server
|
|
||||||
"/servlets/bad-require.ss"
|
|
||||||
(lambda (http-port)
|
|
||||||
(purify-port http-port) ;; For the effect
|
|
||||||
(input-port-equal?
|
|
||||||
http-port
|
|
||||||
(open-input-string
|
|
||||||
(format
|
|
||||||
(string-append
|
|
||||||
"Servlet didn't load.~ndefault-load-handler: cannot open "
|
|
||||||
"input file: \"~a\" (No such file or directory; "
|
|
||||||
"errno=2)")
|
|
||||||
(path->string
|
|
||||||
(build-path web-root
|
|
||||||
"servlets"
|
|
||||||
"I-do-not-exist.ss"))))))))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
"Exception raised"
|
|
||||||
(assert-serve "/servlets/raise-exception.ss"
|
|
||||||
(path->string
|
|
||||||
(build-path web-root
|
|
||||||
"htdocs"
|
|
||||||
"servlet-output"
|
|
||||||
"raise-exception.ss"))
|
|
||||||
"text/plain"))))
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test whether a static, HTML file can be sent correctly.
|
|
||||||
(module test-serve-static-html mzscheme
|
|
||||||
(require schemeunit/test
|
|
||||||
mzlib/contract
|
|
||||||
"assertions.ss"
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
(test-serve-static-html test-suite?))
|
|
||||||
|
|
||||||
(define test-serve-static-html
|
|
||||||
(make-test-suite
|
|
||||||
"Test whether static HTML can be served"
|
|
||||||
(make-test-case
|
|
||||||
"Serve HTML explicitly"
|
|
||||||
(assert-serve "/index.html"
|
|
||||||
(build-path web-root "htdocs" "index.html")
|
|
||||||
"text/html"))
|
|
||||||
(make-test-case
|
|
||||||
"Serve HTML implicitly"
|
|
||||||
(assert-serve "/"
|
|
||||||
(build-path web-root "htdocs" "index.html")
|
|
||||||
"text/html"))))
|
|
||||||
;;; TODO test that additional indices work, too.
|
|
||||||
)
|
|
||||||
|
|
@ -1,25 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test serving JPEGs. This also tests PR #6302.
|
|
||||||
(module test-serve-static-jpeg mzscheme
|
|
||||||
(require mzlib/contract
|
|
||||||
schemeunit/test
|
|
||||||
"assertions.ss")
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
(test-serve-static-jpeg test-suite?))
|
|
||||||
|
|
||||||
(define test-serve-static-jpeg
|
|
||||||
(make-test-suite
|
|
||||||
"Test whether static JPEGs can be served"
|
|
||||||
(make-test-case
|
|
||||||
"Serve JPEG"
|
|
||||||
(assert-serve "/me.jpg"
|
|
||||||
(build-path web-root "htdocs" "me.jpg")
|
|
||||||
"image/jpeg"))
|
|
||||||
(make-test-case
|
|
||||||
"Serve JPEG with upper-case \"extension\""
|
|
||||||
(assert-serve "/me2.JPG"
|
|
||||||
(build-path web-root "htdocs" "me2.JPG")
|
|
||||||
"image/jpeg"))))
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
@ -1,175 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test servlets.
|
|
||||||
;; - Normal servlet call.
|
|
||||||
;; - Servlet call plus arguments on the URL
|
|
||||||
;; - Incremental servlets
|
|
||||||
;; - Various MIME formats
|
|
||||||
;; - URL paths
|
|
||||||
(module test-servlets mzscheme
|
|
||||||
(require mzlib/contract
|
|
||||||
schemeunit/test
|
|
||||||
"assertions.ss"
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
(test-servlets test-suite?))
|
|
||||||
|
|
||||||
(define test1-output "<html><head><title>Title</title></head></html>")
|
|
||||||
|
|
||||||
(define test2-output
|
|
||||||
(string-append
|
|
||||||
"<html><head><title>Title</title></head><body><h1>Title</h1><p>Current "
|
|
||||||
"path: " (path->string (build-path web-root "servlets"))
|
|
||||||
"</p></body></html>"))
|
|
||||||
|
|
||||||
(define test2-incremental-output
|
|
||||||
(string-append
|
|
||||||
"<html><head><title>Title</title></head><body><h1>Title</h1><p>Current "
|
|
||||||
"path: " (path->string (build-path web-root "servlets"))
|
|
||||||
"</p></body></html>"))
|
|
||||||
|
|
||||||
(define test3-output "blah blah plain text")
|
|
||||||
|
|
||||||
(define test4-output
|
|
||||||
(string-append
|
|
||||||
"<html><head><title>Title</title></head><body><h1>Title</h1><p>ab</p>"
|
|
||||||
"<p>seed</p></body></html>"))
|
|
||||||
|
|
||||||
(define test5-output
|
|
||||||
(string-append
|
|
||||||
"<html><head><title>Title</title></head><body><h1>Title</h1><p>ab</p>"
|
|
||||||
"<p>seed</p><p>Current path: " (path->string
|
|
||||||
(build-path web-root "servlets"))
|
|
||||||
"</p></body></html>"))
|
|
||||||
|
|
||||||
(define test6-output "abseed")
|
|
||||||
|
|
||||||
(define test7-output (path->string (build-path web-root "servlets")))
|
|
||||||
|
|
||||||
(define test8-output (string-append (path->string
|
|
||||||
(build-path web-root "servlets"))
|
|
||||||
"abseed"))
|
|
||||||
|
|
||||||
(define test-servlets
|
|
||||||
(make-test-suite
|
|
||||||
|
|
||||||
;; Non-incrementals
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with no arguments on the URL, "
|
|
||||||
"in text/html, no URL path")
|
|
||||||
(assert-serve/string "/servlets/test1.ss"
|
|
||||||
test1-output
|
|
||||||
"text/html"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with no arguments on the URL, "
|
|
||||||
"in text/html, with URL path")
|
|
||||||
(assert-serve/string "/servlets/test2.ss/home"
|
|
||||||
test2-output
|
|
||||||
"text/html"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with no arguments on the URL, "
|
|
||||||
"in text/plain, no URL path")
|
|
||||||
(assert-serve/string "/servlets/test3.ss"
|
|
||||||
test3-output
|
|
||||||
"text/plain"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with arguments on the URL, "
|
|
||||||
"in text/html, no URL path")
|
|
||||||
(assert-serve/string "/servlets/test4.ss?a=b&see=d"
|
|
||||||
test4-output
|
|
||||||
"text/html"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with arguments on the URL, "
|
|
||||||
"in text/html, with URL path")
|
|
||||||
(assert-serve/string "/servlets/test5.ss/home?a=b&see=d"
|
|
||||||
test5-output
|
|
||||||
"text/html"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with arguments on the URL, "
|
|
||||||
"in text/plain, no URL path")
|
|
||||||
(assert-serve/string "/servlets/test6.ss?a=b&see=d"
|
|
||||||
test6-output
|
|
||||||
"text/plain"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet no arguments on the URL, "
|
|
||||||
"in text/plain, with URL path")
|
|
||||||
(assert-serve/string "/servlets/test7.ss/home"
|
|
||||||
test7-output
|
|
||||||
"text/plain"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Non-incremental servlet with arguments on the URL, "
|
|
||||||
"in text/plain, with URL path")
|
|
||||||
(assert-serve/string "/servlets/test8.ss/home?a=b&see=d"
|
|
||||||
test8-output
|
|
||||||
"text/plain"))
|
|
||||||
|
|
||||||
;; Incrementals
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Incremental servlet with no arguments on the URL, "
|
|
||||||
"in text/html, no URL path")
|
|
||||||
(assert-serve/string "/servlets/test1-incremental.ss"
|
|
||||||
test1-output
|
|
||||||
"text/html"))
|
|
||||||
|
|
||||||
(make-test-case
|
|
||||||
(string-append
|
|
||||||
"Incremental servlet with no arguments on the URL, "
|
|
||||||
"in text/html, with URL path")
|
|
||||||
(assert-serve/string "/servlets/test2-incremental.ss/home"
|
|
||||||
test2-incremental-output
|
|
||||||
"text/html"))
|
|
||||||
;; Only the first two are tested incrementally.
|
|
||||||
|
|
||||||
;;; TODO
|
|
||||||
;;; - <form action="...?a=b;c=d" method="POST"> ... </form>
|
|
||||||
|
|
||||||
;; A servlet with an implicit send/back.
|
|
||||||
(make-test-case
|
|
||||||
"Implicit send/back"
|
|
||||||
(let ((stop-server (start-server)))
|
|
||||||
(let* ((p1 (get-pure-port
|
|
||||||
(string->url
|
|
||||||
(format "http://~a:~a/servlets/add.ss"
|
|
||||||
THE-IP THE-PORT))))
|
|
||||||
(m1 (regexp-match #rx"action=\"([^\"]*)\"" p1))
|
|
||||||
(p2 (post-pure-port
|
|
||||||
(string->url
|
|
||||||
(format "http://~a:~a~a" THE-IP THE-PORT (cadr m1)))
|
|
||||||
#"number=1"
|
|
||||||
null))
|
|
||||||
(m2 (regexp-match #rx"action=\"([^\"]*)\"" p2))
|
|
||||||
(p3 (sync/timeout
|
|
||||||
5
|
|
||||||
(post-impure-port
|
|
||||||
(string->url
|
|
||||||
(format "http://~a:~a~a" THE-IP THE-PORT (cadr m2)))
|
|
||||||
#"number=2"
|
|
||||||
null))))
|
|
||||||
(printf "p3 = ~s~n" p3)
|
|
||||||
(if p3
|
|
||||||
(begin0
|
|
||||||
(begin
|
|
||||||
(purify-port p3)
|
|
||||||
(equal? (read-string 100 p3) add-output))
|
|
||||||
(stop-server))
|
|
||||||
(begin (stop-server) (fail))))))
|
|
||||||
|
|
||||||
))
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
@ -1,22 +0,0 @@
|
||||||
#!/bin/sh
|
|
||||||
#|
|
|
||||||
exec mzscheme -r "$0" "$@"
|
|
||||||
|#
|
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Run from collects/tests/web-server/scheme-units
|
|
||||||
(require schemeunit/text-ui
|
|
||||||
"test-authentication.ss"
|
|
||||||
"test-serve-static-html.ss"
|
|
||||||
"test-serve-static-jpeg.ss"
|
|
||||||
"test-web-server.ss"
|
|
||||||
"test-servlets.ss"
|
|
||||||
"test-errors.ss"
|
|
||||||
"test-send.ss")
|
|
||||||
|
|
||||||
(test/text-ui test-web-server)
|
|
||||||
(test/text-ui test-serve-static-html)
|
|
||||||
(test/text-ui test-serve-static-jpeg)
|
|
||||||
(test/text-ui test-authentication)
|
|
||||||
(test/text-ui test-errors)
|
|
||||||
(test/text-ui test-servlets)
|
|
||||||
(test/text-ui test-send)
|
|
||||||
|
|
@ -1,28 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test if the server does timeout
|
|
||||||
(module test-timeout mzscheme
|
|
||||||
(require schemeunit/test
|
|
||||||
"assertions.ss"
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide test-timeout)
|
|
||||||
|
|
||||||
(define *timeout* 40)
|
|
||||||
|
|
||||||
(define test-timeout
|
|
||||||
(make-test-suite
|
|
||||||
"Does the server time out?"
|
|
||||||
(make-test-case
|
|
||||||
(format "Does the server time out after ~a seconds?" *timeout*)
|
|
||||||
(assert-with-server
|
|
||||||
"/servlets/test1.ss"
|
|
||||||
(lambda (http-port)
|
|
||||||
(assert-pred
|
|
||||||
(lambda (in)
|
|
||||||
(sleep *timeout*) ;; Wait for it to timeout
|
|
||||||
(and (char-ready? in) (eof-object? (read-char in))))
|
|
||||||
(let-values (((in out) (tcp-connect THE-IP THE-PORT)))
|
|
||||||
in)))))))
|
|
||||||
|
|
||||||
;;; TODO adjust-timeout!
|
|
||||||
)
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Access Denied</title></head>
|
|
||||||
<body>
|
|
||||||
<p>The server could not verify that you have permissions to access the requested document.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Not Found</title></head>
|
|
||||||
<body bgcolor='white'>
|
|
||||||
<p>The file you were looking for was not found on this server.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Passwords Refreshed</title></head>
|
|
||||||
<body bgcolor='white'>
|
|
||||||
<p>The Web server is now using the new password file.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Browser Error</title></head>
|
|
||||||
<body>
|
|
||||||
<p>The browser sent a malformed request.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Servlet Error</title></head>
|
|
||||||
<body>
|
|
||||||
<p>The servlet terminated abnormally.<br />
|
|
||||||
Please ask the author to fix the problem based on the details in
|
|
||||||
the Web server's log file.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Servlets Refreshed</title></head>
|
|
||||||
<body bgcolor='white'>
|
|
||||||
<p>Fresh copies of Servlets will now be (re)loaded from disk.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
||||||
<html>
|
|
||||||
<head>
|
|
||||||
<title>Welcome to the PLT Web server!</title>
|
|
||||||
</head>
|
|
||||||
|
|
||||||
<body bgcolor="white">
|
|
||||||
<img src="/Defaults/documentation/web-server.gif" width="61" height="57" />
|
|
||||||
|
|
||||||
<blockquote>
|
|
||||||
|
|
||||||
<table width="66%" bgcolor="white">
|
|
||||||
<tr><td>
|
|
||||||
<h2>Welcome to the PLT Web Server</h2>
|
|
||||||
|
|
||||||
<p>
|
|
||||||
Find out more about <a href='/Defaults/'>the server and configure</a> it.
|
|
||||||
</p>
|
|
||||||
|
|
||||||
<p>Please replace this page with your favorite index page.
|
|
||||||
<br />For future configuration changes, remember to look up
|
|
||||||
<br />
|
|
||||||
<center>
|
|
||||||
<code> http://127.0.0.1:<var>port</var>/Defaults/ </code>
|
|
||||||
</center>
|
|
||||||
|
|
||||||
<p>Powered by
|
|
||||||
<a href="http://www.plt-scheme.org/">
|
|
||||||
<img width="53" height="19" src="/Defaults/documentation/plt-logo.gif" />
|
|
||||||
</a>
|
|
||||||
<p><font size="-2">
|
|
||||||
For more information on PLT Software, please follow the icon link.
|
|
||||||
</font>
|
|
||||||
</p>
|
|
||||||
</p>
|
|
||||||
</table>
|
|
||||||
|
|
||||||
</blockquote>
|
|
||||||
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 113 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 113 KiB |
|
|
@ -1,9 +0,0 @@
|
||||||
<html>
|
|
||||||
<head>
|
|
||||||
<title>You win nothing!</title>
|
|
||||||
</head>
|
|
||||||
<body>
|
|
||||||
<h1>You win nothing!</h1>
|
|
||||||
<p>Congrats, loser!</p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
Servlet didn't load.
|
|
||||||
ka-boom!
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>Title</title></head></html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>Title</title></head><body><h1>Title</h1><p>Current path: /proj/scheme/netgeek/collects/tests/web-server/scheme-units</p></body></html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>Title</title></head><body><h1>Title</h1><p>Current path: /proj/scheme/netgeek/collects/tests/web-server/scheme-units/test-web-root/servlets</p></body></html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
blah blah plain text
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>Title</title></head><body><h1>Title</h1><p>ab</p><p>seed</p></body></html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<html><head><title>Title</title></head><body><h1>Title</h1><p>ab</p><p>seed</p><p>Current path: /proj/scheme/netgeek/collects/tests/web-server/scheme-units/test-web-root/servlets</p></body></html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
abseed
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
/proj/scheme/netgeek/collects/tests/web-server/scheme-units/test-web-root/servlets
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
/proj/scheme/netgeek/collects/tests/web-server/scheme-units/test-web-root/servletsabseed
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1 +0,0 @@
|
||||||
'(("secret stuff" "/secret(/.*)?" (bubba "bbq") (|Billy| "BoB")))
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
;; Try requiring a file that does not exist.
|
|
||||||
(require "I-do-not-exist.ss")
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
;; Raise an exception
|
|
||||||
(raise 'ka-boom!)
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
;; Incremental servlet with no arguments on the URL, in text/html, no URL
|
|
||||||
;; path.
|
|
||||||
(module test1-incremental mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
(make-html-response/incremental
|
|
||||||
(lambda (output-chunk)
|
|
||||||
(output-chunk "<html><head><title>")
|
|
||||||
(output-chunk "Title")
|
|
||||||
(sleep 4)
|
|
||||||
(output-chunk "</title></head></html>")))))
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
@ -1,17 +0,0 @@
|
||||||
;; Non-incremental servlet with no arguments on the URL, in text/html, no URL
|
|
||||||
;; path.
|
|
||||||
(module test1 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
'(html
|
|
||||||
(head
|
|
||||||
(title "Title")))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
;; Incremental servlet with no arguments on the URL, in text/html, with URL
|
|
||||||
;; path.
|
|
||||||
(require mzlib/unitsig
|
|
||||||
web-server/servlet-sig
|
|
||||||
)
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
(let ((cd (path->string (current-directory))))
|
|
||||||
(send/finish
|
|
||||||
(make-html-response/incremental
|
|
||||||
(lambda (output-chunked)
|
|
||||||
(output-chunked "<html><head><title>")
|
|
||||||
(output-chunked "Title")
|
|
||||||
(sleep 1)
|
|
||||||
(output-chunked "</title></head><body><h1>Title</h1>")
|
|
||||||
(output-chunked "<p>Current path: ")
|
|
||||||
(sleep 1)
|
|
||||||
(output-chunked cd)
|
|
||||||
(output-chunked "</p></body></html>")))))
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
||||||
;; Incremental servlet with no arguments on the URL, in text/html, with URL
|
|
||||||
;; path.
|
|
||||||
(module test2-incremental mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
(make-html-response/incremental
|
|
||||||
(lambda (output-chunked)
|
|
||||||
(output-chunked "<html><head><title>")
|
|
||||||
(output-chunked "Title")
|
|
||||||
(sleep 4)
|
|
||||||
(output-chunked "</title></head><body><h1>Title</h1>")
|
|
||||||
(output-chunked "<p>Current path: ")
|
|
||||||
(sleep 4)
|
|
||||||
(output-chunked (path->string (current-directory)))
|
|
||||||
(output-chunked "</p></body></html>")))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
;; Non-incremental servlet with no arguments on the URL, in text/html, with URL
|
|
||||||
;; path.
|
|
||||||
(module test2 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
`(html
|
|
||||||
(head
|
|
||||||
(title "Title"))
|
|
||||||
(body
|
|
||||||
(h1 "Title")
|
|
||||||
(p "Current path: " ,(path->string (current-directory)))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
;; Non-incremental servlet with no arguments on the URL, in text/plain, no URL
|
|
||||||
;; path.
|
|
||||||
(module test3 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
'("text/plain"
|
|
||||||
"blah blah plain text")))
|
|
||||||
)
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
;; Non-incremental servlet with arguments on the URL, in text/html, no URL
|
|
||||||
;; path.
|
|
||||||
(module test4 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
`(html
|
|
||||||
(head
|
|
||||||
(title "Title"))
|
|
||||||
(body
|
|
||||||
(h1 "Title")
|
|
||||||
,@(map
|
|
||||||
(lambda (binding)
|
|
||||||
(list 'p (symbol->string (car binding)) (cdr binding)))
|
|
||||||
(request-bindings req))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
||||||
;; Non-incremental servlet with arguments on the URL, in text/html, with URL
|
|
||||||
;; path.
|
|
||||||
(module test5 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
`(html
|
|
||||||
(head
|
|
||||||
(title "Title"))
|
|
||||||
(body
|
|
||||||
(h1 "Title")
|
|
||||||
,@(map
|
|
||||||
(lambda (binding)
|
|
||||||
(list 'p (symbol->string (car binding)) (cdr binding)))
|
|
||||||
(request-bindings req))
|
|
||||||
(p "Current path: " ,(path->string (current-directory)))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,19 +0,0 @@
|
||||||
;; Non-incremental servlet with arguments on the URL, in text/plain, no URL
|
|
||||||
;; path.
|
|
||||||
(module test6 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
(cons "text/plain"
|
|
||||||
(map
|
|
||||||
(lambda (binding)
|
|
||||||
(string-append (symbol->string (car binding)) (cdr binding)))
|
|
||||||
(request-bindings req)))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
;; Non-incremental servlet no arguments on the URL, in text/plain, with URL
|
|
||||||
;; path.
|
|
||||||
(module test7 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
(list "text/plain"
|
|
||||||
(path->string (current-directory)))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
;; Non-incremental servlet with arguments on the URL, in text/plain, with URL
|
|
||||||
;; path.
|
|
||||||
(module test8 mzscheme
|
|
||||||
(require web-server/servlet
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide start timeout interface-version)
|
|
||||||
|
|
||||||
(define timeout 1)
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define (start req)
|
|
||||||
(send/finish
|
|
||||||
(cons "text/plain"
|
|
||||||
(cons
|
|
||||||
(path->string (current-directory))
|
|
||||||
(map
|
|
||||||
(lambda (binding)
|
|
||||||
(string-append (symbol->string (car binding)) (cdr binding)))
|
|
||||||
(request-bindings req))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
||||||
;; Mike Burns, July 28th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test if the Web server can start and stop via the command line.
|
|
||||||
;; Not sure if this is needed, but it was in Paul's.
|
|
||||||
(module test-web-server-process mzscheme
|
|
||||||
(require schemeunit/test
|
|
||||||
mzlib/process)
|
|
||||||
|
|
||||||
(provide test-web-server-process)
|
|
||||||
|
|
||||||
(define the-configuration-file "configuration-table")
|
|
||||||
|
|
||||||
(define the-port 8135)
|
|
||||||
|
|
||||||
;;; TODO resurrect
|
|
||||||
(define test-web-server-process
|
|
||||||
(make-test-suite
|
|
||||||
"Start and stop the Web server via the command line"
|
|
||||||
;; Start it
|
|
||||||
(let-values (((mz-subprocess mz-out mz-in mz-err)
|
|
||||||
(subprocess #f #f #f
|
|
||||||
(find-executable-path "web-server" #f)
|
|
||||||
"-p" (number->string the-port)
|
|
||||||
"-f" the-configuration-file)))
|
|
||||||
(sleep 5)
|
|
||||||
(make-test-case
|
|
||||||
"Start the Web server on a port with a configuration file"
|
|
||||||
;; Test it
|
|
||||||
(and (assert-eq? 'running (subprocess-status mz-subprocess))
|
|
||||||
(assert-false (char-ready? mz-err)))
|
|
||||||
;; Kill it
|
|
||||||
(let ((pid (subprocess-pid mz-subprocess))
|
|
||||||
(kill-path (find-executable-path "kill" #f)))
|
|
||||||
(unless (or (zero? pid) (not kill-path))
|
|
||||||
(let-values (((kill-subprocess kill-out kill-in kill-err)
|
|
||||||
(subprocess #f #f #f kill-path (number->string pid))))
|
|
||||||
(close-input-port kill-out)
|
|
||||||
(close-output-port kill-in)
|
|
||||||
(close-input-port kill-err)
|
|
||||||
(subprocess-wait kill-subprocess))))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,46 +0,0 @@
|
||||||
;; Mike Burns, July 26th, 2004, netgeek@speakeasy.net
|
|
||||||
;; Test the ability to start and stop the server via the library.
|
|
||||||
(module test-web-server mzscheme
|
|
||||||
(require web-server/web-server
|
|
||||||
web-server/configuration
|
|
||||||
schemeunit/test
|
|
||||||
mzlib/etc)
|
|
||||||
|
|
||||||
(provide test-web-server)
|
|
||||||
|
|
||||||
(define the-configuration
|
|
||||||
;;; TODO: test load-configuration
|
|
||||||
(load-configuration (expand-path "configuration-table")))
|
|
||||||
|
|
||||||
(define the-port 8135)
|
|
||||||
|
|
||||||
(define the-ip "127.0.0.1")
|
|
||||||
|
|
||||||
(define test-web-server
|
|
||||||
(make-test-suite
|
|
||||||
"Start and stop the Web server from the library"
|
|
||||||
(let ((stop #f))
|
|
||||||
(make-test-case
|
|
||||||
"Start the Web server with just the configuration"
|
|
||||||
(assert-pred procedure? (begin
|
|
||||||
(set! stop (serve the-configuration))
|
|
||||||
stop))
|
|
||||||
(when stop (stop))))
|
|
||||||
(let ((stop #f))
|
|
||||||
(make-test-case
|
|
||||||
"Start the Web server with the configuration and port"
|
|
||||||
(assert-pred procedure? (begin
|
|
||||||
(set! stop (serve the-configuration
|
|
||||||
the-port))
|
|
||||||
stop))
|
|
||||||
(when stop (stop))))
|
|
||||||
(let ((stop #f))
|
|
||||||
(make-test-case
|
|
||||||
"Start the Web server with the configuration, port, and IP address"
|
|
||||||
(assert-pred procedure? (begin
|
|
||||||
(set! stop (serve the-configuration
|
|
||||||
the-port the-ip))
|
|
||||||
stop))
|
|
||||||
(when stop (stop))))))
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
@ -1,110 +0,0 @@
|
||||||
; copyright 11/29/2001 A.D. by Paul Graunke and the PLT
|
|
||||||
; This is a rip-off---err---port of the Rice systems group's sclient 2.0 software
|
|
||||||
; by gaurav, peter, and gang.
|
|
||||||
; The TCP/IP stuff isn't as finely controlled, so it's my fault if it stinks.
|
|
||||||
(module sclient mzscheme
|
|
||||||
(require mzlib/etc)
|
|
||||||
|
|
||||||
; old-state = 'nothing | 'waiting | 'reading | 'writing
|
|
||||||
|
|
||||||
; old-client = (make-client iport oport state nat nat nat nat nat)
|
|
||||||
;(define-struct
|
|
||||||
; old-client
|
|
||||||
; (in out state bytes-read partial-req-written num-reqs-done timestamp start-time))
|
|
||||||
|
|
||||||
; client = (make-client nat^4)
|
|
||||||
(define-struct client (bytes-read num-reqs-done timestamp start-time))
|
|
||||||
|
|
||||||
; why 6Mb? - it isn't used in the original either
|
|
||||||
;(define PERCONBUFSIZE (* 6 1000 1000))
|
|
||||||
|
|
||||||
; FIX? - see about eliminating mutation
|
|
||||||
(define *start-time* 0)
|
|
||||||
(define *last-connect* 0)
|
|
||||||
|
|
||||||
; main : str str nat nat nat nat nat -> ???
|
|
||||||
(define (main host-machine target-file port reps num-clients rate cpu-mhz)
|
|
||||||
(let* ([request-string (build-http-request target-file)]
|
|
||||||
[request-length (string-length request-string)]
|
|
||||||
[cycles-per-request (* cpu-mhz (/ 1000000 rate))]
|
|
||||||
[max-connect-cycles (* 50000 cpu-mhz)])
|
|
||||||
(printf "A request will be issued every: ~a cycles i.e. every ~a us\n"
|
|
||||||
cycles-per-request (/ cycles-per-request cpu-mhz))
|
|
||||||
;(init-clients host-machine port) ; just did DNS lookup in original
|
|
||||||
(set! *start-time* (current-milliseconds))
|
|
||||||
(let* ([all-clients-threads
|
|
||||||
(build-list num-clients
|
|
||||||
(lambda (i) (simple-connect host-machine port request-string)))]
|
|
||||||
[all-clients (map car all-clients-threads)]
|
|
||||||
[all-threads (map cdr all-clients-threads)])
|
|
||||||
(for-each thread-wait all-threads)
|
|
||||||
; print-stats
|
|
||||||
(let* ([diff-time0 (- (current-milliseconds) *start-time*)]
|
|
||||||
[diff-time (if (zero? diff-time0) 1 diff-time0)]
|
|
||||||
[diff-seconds (/ diff-time 1e6)]
|
|
||||||
[total-bytes-read (apply + (map client-bytes-read all-clients))]
|
|
||||||
[reqs-done (apply + (map client-num-reqs-done all-clients))]
|
|
||||||
[reps-done reqs-done] ; FIX?
|
|
||||||
[n-diff-samples reqs-done] ; FIX?
|
|
||||||
;[diff-sum (apply + '(...))] FIX!
|
|
||||||
[diff-sum -inf.0]
|
|
||||||
[speed (* 8.0 (/ total-bytes-read diff-time))])
|
|
||||||
; the original was in micro seconds
|
|
||||||
(printf "Elapsed time: ~a milliseconds\n" diff-time)
|
|
||||||
(printf "reps done: ~a\n" reps-done)
|
|
||||||
(printf "request rate: ~a\n"
|
|
||||||
(/ reqs-done diff-seconds))
|
|
||||||
(printf "[ ~a Mb/s, ~a ~a S, ~a B, ~a R, ~a cl, pt ~a ~a c/s]\n"
|
|
||||||
speed target-file diff-seconds total-bytes-read
|
|
||||||
reps-done num-clients port
|
|
||||||
(/ reps-done diff-seconds))
|
|
||||||
(printf "average response time: ~a us\n"
|
|
||||||
(exact->inexact (/ diff-sum n-diff-samples)))
|
|
||||||
(printf "maximum number of pseudo clients: ~a\n" num-clients)))))
|
|
||||||
|
|
||||||
; build-http-request : str -> str
|
|
||||||
(define (build-http-request host-name)
|
|
||||||
; This was clearly broken in the original:
|
|
||||||
;"GET http://fxp2.cs.rice.edu:8080/%s HTTP/1.0\r\n"
|
|
||||||
(string-append "GET /" host-name" HTTP/1.0\r\n"
|
|
||||||
"Accept: text/plain\r\n"
|
|
||||||
"Accept: text/html\r\n"
|
|
||||||
"Accept: */*\r\n"))
|
|
||||||
|
|
||||||
; simple-connect : str nat str -> (cons client thread)
|
|
||||||
; original - this took two unused arguments and banged its result into a vector
|
|
||||||
; FIX? - should it report statistics when exceptions occur?
|
|
||||||
(define (simple-connect host-name port request)
|
|
||||||
(let* ([start-time (current-milliseconds)]
|
|
||||||
[client (make-client 0 0 start-time start-time)])
|
|
||||||
(cons client
|
|
||||||
(thread
|
|
||||||
(lambda ()
|
|
||||||
(let connect ()
|
|
||||||
(let-values ([(in out) (tcp-connect host-name port)])
|
|
||||||
(set! *last-connect* (current-milliseconds))
|
|
||||||
; FIX? - Gaurav's paper said something about not filling the server's
|
|
||||||
; TCP/IP queue with waiting clients. It sounds like this needs a
|
|
||||||
; timeout of a little more than twice the expected round trip delay
|
|
||||||
; or whatever.
|
|
||||||
(send-http in out client request)
|
|
||||||
(read-from-connection in out client)
|
|
||||||
; FIX? - do something like deadline-passed, perhaps?
|
|
||||||
(set-client-num-reqs-done! client (add1 (client-num-reqs-done client))))
|
|
||||||
(connect)))))))
|
|
||||||
|
|
||||||
; send-http : iport oport client str -> void
|
|
||||||
; The original did all sorts of funny stuff for asynchronous I/O.
|
|
||||||
(define (send-http in out client request)
|
|
||||||
(display request out))
|
|
||||||
|
|
||||||
(define read-increments (* 8 1024))
|
|
||||||
(define *singe-read-buffer* (make-string read-increments #\space))
|
|
||||||
|
|
||||||
; read-from-connection : iport oport client -> void
|
|
||||||
(define (read-from-connection in out client)
|
|
||||||
(let read-all ()
|
|
||||||
(let ([x (read-string-avail! *singe-read-buffer* in)])
|
|
||||||
(unless (eof-object? x)
|
|
||||||
(set-client-bytes-read! client (+ x (client-bytes-read client)))
|
|
||||||
(read-all))))))
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
; needs first defined (i.e. use a teaching langauge)
|
|
||||||
; needs the servlet.ss teachpack
|
|
||||||
|
|
||||||
(require mzlib/etc)
|
|
||||||
|
|
||||||
; : sym -> str
|
|
||||||
; to input an opinion about a color
|
|
||||||
(define (color the-color)
|
|
||||||
(extract-binding/single
|
|
||||||
'color
|
|
||||||
(request-bindings
|
|
||||||
(send/suspend
|
|
||||||
(build-suspender '("hi")
|
|
||||||
`((p ,(format
|
|
||||||
"What do you think about the color ~a?"
|
|
||||||
the-color))
|
|
||||||
(input ([type "text"] [name "color"]))))))))
|
|
||||||
|
|
||||||
(define blue (color (identity (first (list 'blue)))))
|
|
||||||
(define green (color 'green))
|
|
||||||
|
|
||||||
(send/finish `(html (body (p "Thoughts about blue: " ,blue)
|
|
||||||
(p "What you wrote about green: " ,green))))
|
|
||||||
|
|
@ -1,6 +0,0 @@
|
||||||
; requires empty (from a teaching language)
|
|
||||||
; requires servlet2.ss and dir.ss teachpacks
|
|
||||||
|
|
||||||
(define my-dir (make-dir "a-fake-dir-name" empty empty))
|
|
||||||
|
|
||||||
(final-page (dir-name my-dir))
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
; expects the servlet.ss teachpack
|
|
||||||
; works in any language above beginner (including beginner with qq)
|
|
||||||
|
|
||||||
; : sym -> str
|
|
||||||
; to input an opinion about a color
|
|
||||||
(define (color the-color)
|
|
||||||
(extract-binding/single
|
|
||||||
'color
|
|
||||||
(request-bindings
|
|
||||||
(send/suspend
|
|
||||||
(build-suspender '("hi")
|
|
||||||
`((p ,(format
|
|
||||||
"What do you think about the color ~a?"
|
|
||||||
the-color))
|
|
||||||
(input ([type "text"] [name "color"]))))))))
|
|
||||||
|
|
||||||
(define blue (color 'navy))
|
|
||||||
(define green (color 'green))
|
|
||||||
|
|
||||||
(send/finish `(html (body (p "Thoughts about blue: " ,blue)
|
|
||||||
(p "What you wrote about green: " ,green))))
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
(define (pass) (final-page "You may pass."))
|
|
||||||
|
|
||||||
(define name (single-query "What is your name?"))
|
|
||||||
(define quest (single-query "What is your quest?"))
|
|
||||||
|
|
||||||
(if (string-ci=? name "Matthias")
|
|
||||||
(let ([v (string->number (single-query "What is the terminal velocity of a sparrow?"))])
|
|
||||||
(if (and v (= v 5))
|
|
||||||
(pass)
|
|
||||||
(final-page "Study sparrows more.")))
|
|
||||||
(begin
|
|
||||||
(single-query "What is your favorite color?")
|
|
||||||
(pass)))
|
|
||||||
|
|
@ -1,445 +0,0 @@
|
||||||
; HOW TO RUN:
|
|
||||||
; Call broken? with a port number (greater than 1024 unless you're root)
|
|
||||||
; i.e. (broken? 8080)
|
|
||||||
; It should return #f if it's not broken, otherwise it returns a string explaining the brokenness.
|
|
||||||
|
|
||||||
; note - should be run on multiple platforms
|
|
||||||
|
|
||||||
; more-here - test flushing pending requests to a terminated servlet
|
|
||||||
|
|
||||||
(module suite mzscheme
|
|
||||||
(provide broken? broken?/remote start-server files-broken? authentication-broken?
|
|
||||||
normal-servlets-broken? errors-broken?)
|
|
||||||
(require mzlib/process
|
|
||||||
mzlib/etc
|
|
||||||
"my-url.ss"
|
|
||||||
net/base64
|
|
||||||
xml/xml
|
|
||||||
web-server/channel)
|
|
||||||
|
|
||||||
(define myprint void)
|
|
||||||
|
|
||||||
; header-pattern = (listof (cons sym (+ regexp str)))
|
|
||||||
|
|
||||||
(error-print-width 800)
|
|
||||||
|
|
||||||
(define test-directory (build-path (collection-path "tests") "web-server"))
|
|
||||||
(define web-root (build-path test-directory "web-root"))
|
|
||||||
;(define web-root (collection-path "web-server" "default-web-root"))
|
|
||||||
(define answers-directory (build-path test-directory "answers"))
|
|
||||||
(define TEST-IP "127.0.0.1")
|
|
||||||
|
|
||||||
(print-struct #t)
|
|
||||||
|
|
||||||
;; broken?/remote: nat -> (union falses str)
|
|
||||||
;; same as broken? but connect to a running web-server
|
|
||||||
;; rather than starting a new one
|
|
||||||
(define (broken?/remote port)
|
|
||||||
(or (files-broken? port)
|
|
||||||
(authentication-broken? port)
|
|
||||||
(normal-servlets-broken? port)
|
|
||||||
(extended-servlets-broken? port)
|
|
||||||
(errors-broken? port)
|
|
||||||
(timeouts-broken? port)))
|
|
||||||
|
|
||||||
; broken? : nat -> (+ false str)
|
|
||||||
;; the cadilac broken? function, starts the server automatically.
|
|
||||||
(define (broken? port)
|
|
||||||
(or (channels-broken?)
|
|
||||||
(let ([server (start-server port)])
|
|
||||||
(dynamic-wind
|
|
||||||
void
|
|
||||||
(lambda ()
|
|
||||||
(or (and (not (subprocess? server)) server)
|
|
||||||
(files-broken? port)
|
|
||||||
(authentication-broken? port)
|
|
||||||
(normal-servlets-broken? port)
|
|
||||||
(extended-servlets-broken? port)
|
|
||||||
(errors-broken? port)
|
|
||||||
(timeouts-broken? port)))
|
|
||||||
(lambda () (kill-subprocess server))))))
|
|
||||||
|
|
||||||
; channels-broken? : -> (U str #f)
|
|
||||||
; more here - stress test for synchronization defects
|
|
||||||
(define (channels-broken?)
|
|
||||||
(let ([c (make-async-channel)]
|
|
||||||
[v (gensym)])
|
|
||||||
(async-channel-put c v)
|
|
||||||
(if (eq? v (async-channel-get c))
|
|
||||||
(or (let ([*x* #f])
|
|
||||||
(async-channel-get-available
|
|
||||||
c
|
|
||||||
(lambda (y) (set! *x* "channel: not empty")))
|
|
||||||
*x*)
|
|
||||||
(let ([*x* "channel: nothing available"])
|
|
||||||
(async-channel-put c v)
|
|
||||||
(async-channel-get-available c (lambda (y) (set! *x* #f)))
|
|
||||||
*x*)
|
|
||||||
(let/ec k
|
|
||||||
(async-channel-try-get c (lambda () (k #f)))
|
|
||||||
"channel: removed item from empty channel")
|
|
||||||
(let/ec k
|
|
||||||
(let ([x (gensym)])
|
|
||||||
(async-channel-put c x)
|
|
||||||
(async-channel-try-get
|
|
||||||
c
|
|
||||||
(lambda () (k "channel: fail to remove x")))
|
|
||||||
#f)))
|
|
||||||
"channel: put/get mismatch")))
|
|
||||||
|
|
||||||
; start-server : nat -> (U str subprocess)
|
|
||||||
(define (start-server port)
|
|
||||||
(let-values ([(mz-subprocess mz-out mz-in mz-err)
|
|
||||||
(subprocess #f #f #f
|
|
||||||
(find-executable-path "web-server" #f)
|
|
||||||
"-p" (number->string port)
|
|
||||||
"-f" (path->string (build-path test-directory "configuration-table")) )])
|
|
||||||
(sleep 5)
|
|
||||||
(if (not (eq? 'running (subprocess-status mz-subprocess)))
|
|
||||||
(format "server mzscheme isn't running:~n~s"
|
|
||||||
; just print the first 20 lines of junk or so
|
|
||||||
(read-string 1600 mz-err))
|
|
||||||
(if (char-ready? mz-err)
|
|
||||||
(format "server printed error: ~s" (read-line mz-err))
|
|
||||||
mz-subprocess))))
|
|
||||||
|
|
||||||
; kill-subprocess : subprocess -> void
|
|
||||||
(define (kill-subprocess p)
|
|
||||||
(let ([pid (subprocess-pid p)]
|
|
||||||
[kill-path (find-executable-path "kill" #f)])
|
|
||||||
(unless (or (zero? pid) (not kill-path))
|
|
||||||
(let-values ([(kill-subprocess out in err)
|
|
||||||
(subprocess #f #f #f kill-path (number->string pid))])
|
|
||||||
(close-input-port out)
|
|
||||||
(close-output-port in)
|
|
||||||
(close-input-port err)
|
|
||||||
(subprocess-wait kill-subprocess)))))
|
|
||||||
|
|
||||||
; wont-start? : nat -> (+ false str)
|
|
||||||
; effect: tries to start the server
|
|
||||||
'(define (wont-start? port)
|
|
||||||
(with-handlers ([void (lambda (exn) (format "start-server: exn = ~a" exn))])
|
|
||||||
(let*-values ([(mz-subprocess mz-out mz-in mz-err)
|
|
||||||
(subprocess #f #f #f
|
|
||||||
(find-executable-path "web-server" #f)
|
|
||||||
"-p" (number->string port))]
|
|
||||||
[(send-command)
|
|
||||||
; String -> Void
|
|
||||||
(lambda (command)
|
|
||||||
(write command mz-in)
|
|
||||||
(newline mz-in))])
|
|
||||||
;(send-command `(current-directory ,web-root))
|
|
||||||
(send-command `(serve ,port))
|
|
||||||
(sleep 5)
|
|
||||||
(if (not (eq? 'running (subprocess-status mz-subprocess)))
|
|
||||||
(format "server mzscheme isn't running:~n~s"
|
|
||||||
; just print the first 20 lines of junk or so
|
|
||||||
(read-string 1600 mz-err))
|
|
||||||
(if (char-ready? mz-err)
|
|
||||||
(format "server printed error: ~s" (read-line mz-err))
|
|
||||||
#f)))))
|
|
||||||
|
|
||||||
(define date-regexp "^(Sun|Mon|Tue|Wed|Thu|Fri|Sat), [0-9]* (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) [0-9]* [0-9][0-9]:[0-9][0-9]:[0-9][0-9] GMT$")
|
|
||||||
|
|
||||||
(define usual-headers
|
|
||||||
`((date ,date-regexp)
|
|
||||||
(Last-Modified ,date-regexp)
|
|
||||||
(server "^PLT Scheme$")
|
|
||||||
(content-type "^text/html$")
|
|
||||||
(connection "^close$")))
|
|
||||||
|
|
||||||
(define jpeg-headers
|
|
||||||
`((date ,date-regexp)
|
|
||||||
(Last-Modified ,date-regexp)
|
|
||||||
(server "^PLT Scheme$")
|
|
||||||
(content-type "^image/jpeg$")
|
|
||||||
(connection "^close$")))
|
|
||||||
|
|
||||||
; content-length-header : str -> (list sym str)
|
|
||||||
(define (content-length-header file-path)
|
|
||||||
(myprint " file-path = ~s~n" file-path)
|
|
||||||
`(content-length ,(format "^~a$" (file-size file-path))))
|
|
||||||
|
|
||||||
; files-broken? : nat -> (+ false string)
|
|
||||||
(define (files-broken? port)
|
|
||||||
(myprint "files-broken?~n")
|
|
||||||
(with-handlers ([void (lambda (exn) (format "test-files: error starting up ~a" exn))])
|
|
||||||
(let* ([file-path (build-path web-root "htdocs" "index.html")]
|
|
||||||
[implicit-url (local-url port "")]
|
|
||||||
[explicit-url (combine-url/relative implicit-url "index.html")]
|
|
||||||
[pattern (append usual-headers (list (content-length-header file-path)))]
|
|
||||||
|
|
||||||
;; jpeg tests
|
|
||||||
;; for PR#6302
|
|
||||||
[picture1-path (build-path web-root "htdocs" "me.jpg")]
|
|
||||||
[picture1-url (combine-url/relative implicit-url "me.jpg")]
|
|
||||||
[picture1-pattern (append jpeg-headers (list (content-length-header picture1-path)))]
|
|
||||||
|
|
||||||
;; reproduces PR#6302 b-cuz me2.JPG has upper-case extension
|
|
||||||
[picture2-path (build-path web-root "htdocs" "me2.JPG")]
|
|
||||||
[picture2-url (combine-url/relative implicit-url "me2.JPG")]
|
|
||||||
[picture2-pattern (append jpeg-headers (list (content-length-header picture2-path)))]
|
|
||||||
)
|
|
||||||
(or (problem-with-url? file-path pattern explicit-url)
|
|
||||||
(problem-with-url? file-path pattern implicit-url)
|
|
||||||
(problem-with-url? picture1-path picture1-pattern picture1-url)
|
|
||||||
(problem-with-url? picture2-path picture2-pattern picture2-url)
|
|
||||||
))))
|
|
||||||
|
|
||||||
; problem-with-url? : str header-pattern url [(listof str)] -> (U false str)
|
|
||||||
(define problem-with-url?
|
|
||||||
(opt-lambda (file-path header-match url [extra-headers null])
|
|
||||||
(delimit-resources
|
|
||||||
(lambda ()
|
|
||||||
(with-handlers ([void (lambda (exn) (format "test-url: url = ~a~n ~a~n" url exn))])
|
|
||||||
(call-with-input-file file-path
|
|
||||||
(lambda (file-input)
|
|
||||||
(let* ([http-port (get-impure-port url extra-headers)]
|
|
||||||
[headers (purify-port http-port)])
|
|
||||||
(error-add (format "problem-with-url: ~s: " (url->string url))
|
|
||||||
(or (mime-headers-problem? headers header-match)
|
|
||||||
(input-port-diff http-port file-input)))))))))))
|
|
||||||
|
|
||||||
(define (print-port i-port)
|
|
||||||
(printf "inside print-port~n")
|
|
||||||
(let loop ([l (read-line i-port)])
|
|
||||||
(unless (eof-object? l)
|
|
||||||
(printf "~a~n" l)
|
|
||||||
(loop (read-line i-port)))))
|
|
||||||
|
|
||||||
; : url header-pattern regexp -> (U false str)
|
|
||||||
(define (broken-url-regexp? to-test header-match expected)
|
|
||||||
(delimit-resources
|
|
||||||
(lambda ()
|
|
||||||
(with-handlers ([void (lambda (exn) (format "exception for url ~e~n~e" to-test exn))])
|
|
||||||
(let* ([http-port (get-impure-port to-test)]
|
|
||||||
[headers (purify-port http-port)])
|
|
||||||
(error-add (format "url did not match: ~e: " (url->string to-test))
|
|
||||||
(or (mime-headers-problem? headers header-match)
|
|
||||||
(regexp-match expected http-port))))))))
|
|
||||||
|
|
||||||
; delimit-resources : (-> a) -> a
|
|
||||||
(define (delimit-resources thunk)
|
|
||||||
(let ([cust (make-custodian)]
|
|
||||||
[old-cust (current-custodian)])
|
|
||||||
(dynamic-wind (lambda () (current-custodian cust))
|
|
||||||
thunk
|
|
||||||
(lambda ()
|
|
||||||
(current-custodian old-cust)
|
|
||||||
(custodian-shutdown-all cust)))))
|
|
||||||
|
|
||||||
; authentication-broken? : nat -> (+ false str)
|
|
||||||
(define (authentication-broken? port)
|
|
||||||
(myprint "authentication-broken?~n")
|
|
||||||
(let* ([forbidden-file-path (build-path web-root "conf" "forbidden.html")]
|
|
||||||
[okay-file-path (build-path web-root "htdocs" "secret" "index.html")]
|
|
||||||
[forbidden-content-length (content-length-header forbidden-file-path)]
|
|
||||||
[okay-content-length (content-length-header okay-file-path)]
|
|
||||||
[auth-header `(www-authenticate "^Basic realm=\"secret stuff\"$")]
|
|
||||||
[forbidden-headers (append usual-headers (list forbidden-content-length auth-header))]
|
|
||||||
[okay-headers (append usual-headers (list okay-content-length))]
|
|
||||||
; [authorization (list (format "authorization: Basic ~a" (base64-encode "bubba:bbq")))]
|
|
||||||
[authorization (list (bytes->string/utf-8 (bytes-append #"authorization: Basic " (base64-encode #"bubba:bbq"))))]
|
|
||||||
)
|
|
||||||
(or (problem-with-url? forbidden-file-path
|
|
||||||
forbidden-headers
|
|
||||||
(local-url port "secret/"))
|
|
||||||
(problem-with-url? okay-file-path
|
|
||||||
okay-headers
|
|
||||||
(local-url port "secret/")
|
|
||||||
authorization)
|
|
||||||
(problem-with-url? forbidden-file-path
|
|
||||||
forbidden-headers
|
|
||||||
(local-url port "secret/index.html"))
|
|
||||||
(problem-with-url? okay-file-path
|
|
||||||
okay-headers
|
|
||||||
(local-url port "secret/index.html")
|
|
||||||
authorization))))
|
|
||||||
|
|
||||||
; normal-servlets-broken? : Nat -> (+ false str)
|
|
||||||
(define (normal-servlets-broken? port)
|
|
||||||
(myprint "normal-servlets-broken?~n")
|
|
||||||
(let* ([local-test-url
|
|
||||||
(lambda (path)
|
|
||||||
(local-url port (string-append "servlets/tests/" path)))]
|
|
||||||
[broken-url?
|
|
||||||
(lambda (answer prog)
|
|
||||||
(let ([answer-1 (build-path answers-directory answer)])
|
|
||||||
(problem-with-url? answer-1
|
|
||||||
(append usual-headers (list (content-length-header answer-1)))
|
|
||||||
(local-test-url prog))))])
|
|
||||||
(or (broken-url? "test.servlet-1" "test.ss")
|
|
||||||
(broken-url? "test.servlet-2" "test.ss?a=b&see=def")
|
|
||||||
(problem-with-url? (build-path answers-directory "incremental")
|
|
||||||
usual-headers
|
|
||||||
(local-url port "servlets/tests/incremental.ss"))
|
|
||||||
; more here - test chunked version
|
|
||||||
;(problem-with-url? (build-path answers-directory "incremental")
|
|
||||||
; `(,(car usual-headers)
|
|
||||||
; ,(cadr usual-headers)
|
|
||||||
; ,(caddr usual-headers)
|
|
||||||
; (Transfer-Encoding "^chunked$"))
|
|
||||||
; (local-url port "servlets/tests/incremental.ss"))
|
|
||||||
(let ([string-answer (build-path answers-directory "mime-servlet")])
|
|
||||||
(problem-with-url? string-answer
|
|
||||||
`(,(car usual-headers)
|
|
||||||
,(cadr usual-headers)
|
|
||||||
,(caddr usual-headers)
|
|
||||||
(content-type "^text/uber-format$")
|
|
||||||
(connection "^close$")
|
|
||||||
,(content-length-header string-answer))
|
|
||||||
(local-url port "servlets/tests/mime.ss")))
|
|
||||||
(broken-url? "a-module" "a-module.ss")
|
|
||||||
(broken-url? "b-module" "b-module.ss?texan=big-hat")
|
|
||||||
;(broken-url? "suspended-module" "suspended-module.ss") ; k-id is random
|
|
||||||
(broken-url-regexp? (local-test-url "suspended-module.ss")
|
|
||||||
(append usual-headers (list `(content-length "[0-9]*")))
|
|
||||||
suspended-module-regexp))))
|
|
||||||
|
|
||||||
(define suspended-module-regexp
|
|
||||||
(regexp "<html><head><meta http-equiv=\"Pragma\" content=\"no-cache\" /><meta http-equiv=\"expires\" content=\"-1\" /><title>What is your name?</title></head><body bgcolor=\"white\"><form action=\"/servlets/tests/suspended-module.ss;id[0-9]*[*]k1-[0-9]*\" method=\"post\">What is your name?<input type=\"text\" name=\"name\" /></form></body></html>"))
|
|
||||||
|
|
||||||
; extended-servlets-broken? : Nat -> (+ false str)
|
|
||||||
(define (extended-servlets-broken? port)
|
|
||||||
#f)
|
|
||||||
|
|
||||||
; : (list sym str)
|
|
||||||
(define generic-content-length-header
|
|
||||||
`(content-length "^[0-9][0-9]*$"))
|
|
||||||
|
|
||||||
; errors-broken? : Nat -> (+ false str)
|
|
||||||
; tests file-not-found, servlet-error, and protocol-error. The access-denied error is under authentication-broken?
|
|
||||||
(define (errors-broken? port)
|
|
||||||
(printf "errors-broken?:~n")
|
|
||||||
(let* ([not-found-path (build-path web-root "conf" "not-found.html")]
|
|
||||||
[not-found-headers (append usual-headers (list (content-length-header not-found-path)))]
|
|
||||||
[non-unit-headers (append usual-headers (list generic-content-length-header))]
|
|
||||||
[servlet-error-path (build-path web-root "conf" "servlet-error.html")]
|
|
||||||
[servlet-error-headers (append usual-headers (list (content-length-header servlet-error-path)))])
|
|
||||||
(or (problem-with-url? not-found-path
|
|
||||||
not-found-headers
|
|
||||||
(local-url port "/conf/some-file-name-that-is-not-there.hmtl"))
|
|
||||||
(problem-with-url? not-found-path
|
|
||||||
not-found-headers
|
|
||||||
(local-url port "some-file-name-that-is-not-there.hmtl"))
|
|
||||||
(problem-with-url? not-found-path
|
|
||||||
not-found-headers
|
|
||||||
(local-url port "servlets/some-program-name-that-is-not-there"))
|
|
||||||
(problem-with-url? servlet-error-path
|
|
||||||
servlet-error-headers
|
|
||||||
(local-url port "servlets/tests/broken.ss"))
|
|
||||||
(broken-url-regexp? (local-url port "servlets/tests/non-unit.ss")
|
|
||||||
non-unit-headers
|
|
||||||
"Servlet didn't load. \"Loading \\\".*non-unit.ss\\\" produced \n5\n instead of a servlet.\"")
|
|
||||||
(broken-url-regexp? (local-url port "servlets/tests/bad-require.ss")
|
|
||||||
(append usual-headers (list generic-content-length-header))
|
|
||||||
"Servlet didn't load. open-input-file: cannot open input file: \".*not-there-on-purpose.ss\" (No such file or directory; errno=2)")
|
|
||||||
#|(problem-with-url? servlet-error-path
|
|
||||||
servlet-error-headers
|
|
||||||
(local-url port "servlets/tests/bad-return.ss"))
|
|
||||||
|#)))
|
|
||||||
|
|
||||||
; timeouts-broken? : nat -> (U false str)
|
|
||||||
(define (timeouts-broken? port)
|
|
||||||
(printf "timeouts-broken?:~n")
|
|
||||||
(delimit-resources
|
|
||||||
(lambda ()
|
|
||||||
(let-values ([(in out) (tcp-connect TEST-IP port)])
|
|
||||||
(sleep 40) ; must be big enough to timeout
|
|
||||||
(if (and (char-ready? in) (eof-object? (read-char in)))
|
|
||||||
#f
|
|
||||||
"Did not timeout")))))
|
|
||||||
|
|
||||||
; local-url : nat str -> url
|
|
||||||
(define (local-url port extra)
|
|
||||||
(string->url (format "http://~a:~a/~a" TEST-IP port extra)))
|
|
||||||
|
|
||||||
; error-add : str (+ false str) -> (+ false str)
|
|
||||||
(define (error-add prefix result)
|
|
||||||
(and result (string-append prefix result)))
|
|
||||||
|
|
||||||
; mime-headers-problem? : (listof mime-header) header-pattern -> (+ false str)
|
|
||||||
(define (mime-headers-problem? headers answers)
|
|
||||||
(myprint "mime-headers-problem?~n")
|
|
||||||
(if (not (= (length headers) (length answers)))
|
|
||||||
(format "wrong number of headers.~n expected ~s~n received ~s"
|
|
||||||
answers (map (lambda (h)
|
|
||||||
(list (mime-header-name h)
|
|
||||||
(mime-header-value h)))
|
|
||||||
headers))
|
|
||||||
(ormap (lambda (h a)
|
|
||||||
(if (and (string-ci=? (mime-header-name h)
|
|
||||||
(symbol->string (car a)))
|
|
||||||
(regexp-match (cadr a) (mime-header-value h)))
|
|
||||||
#f
|
|
||||||
(format "mime-header results:~s" (list (list (car a) (mime-header-name h))
|
|
||||||
(list (cadr a) (mime-header-value h))))))
|
|
||||||
headers
|
|
||||||
answers)))
|
|
||||||
|
|
||||||
; input-port-diff : iport iport -> (+ false str)
|
|
||||||
; effect: consumes all input on at least the shorter port
|
|
||||||
(define (input-port-diff a b)
|
|
||||||
(myprint "input-port-diff~n")
|
|
||||||
(let compare ([n 0])
|
|
||||||
(let* ([c-a (read-char a)]
|
|
||||||
[c-b (read-char b)]
|
|
||||||
[differ (lambda () (format "(<where> <actual> <expected>): ~s" (list n c-a c-b)))])
|
|
||||||
(cond
|
|
||||||
[(eof-object? c-a)
|
|
||||||
(cond
|
|
||||||
[(eof-object? c-b) #f]
|
|
||||||
[else (differ)])]
|
|
||||||
[else
|
|
||||||
(cond
|
|
||||||
[(eof-object? c-b) (differ)]
|
|
||||||
[else (if (char=? c-a c-b)
|
|
||||||
(compare (add1 n))
|
|
||||||
(differ))])]))))
|
|
||||||
|
|
||||||
; extract-k-url : iport -> str
|
|
||||||
; to extract the action url from an html form
|
|
||||||
(define (extract-k-url in)
|
|
||||||
(or (let search-content ([el (document-element (read-xml in))])
|
|
||||||
(cond
|
|
||||||
[(element? el)
|
|
||||||
(or (if (eq? 'form (element-name el))
|
|
||||||
(let action-attribute ([attrs (element-attributes el)])
|
|
||||||
(cond
|
|
||||||
[(null? attrs) #f]
|
|
||||||
[else (if (eq? 'action (attribute-name (car attrs)))
|
|
||||||
(attribute-value (car attrs))
|
|
||||||
(action-attribute (cdr attrs)))]))
|
|
||||||
#f)
|
|
||||||
(ormap search-content (element-content el)))]
|
|
||||||
[else #f]))
|
|
||||||
(raise "couldn't find action url")))
|
|
||||||
|
|
||||||
#|
|
|
||||||
; Meta tests:
|
|
||||||
|
|
||||||
; input-port-diff
|
|
||||||
(call-with-input-file "/home/ptg/to-do"
|
|
||||||
(lambda (in1)
|
|
||||||
(call-with-input-file "/home/ptg/to-do"
|
|
||||||
(lambda (in2)
|
|
||||||
(input-port-diff in1 in2)))))
|
|
||||||
(call-with-input-file "/etc/passwd"
|
|
||||||
(lambda (in1)
|
|
||||||
(call-with-input-file "/home/ptg/to-do"
|
|
||||||
(lambda (in2)
|
|
||||||
(input-port-diff in1 in2)))))
|
|
||||||
|# #|
|
|
||||||
(mime-headers-problem? (list (make-mime-header "server" ": PLT"))
|
|
||||||
'((server ": PLT")))
|
|
||||||
(mime-headers-problem? (list (make-mime-header "server" ": PLT"))
|
|
||||||
'((server ": PLT2")))
|
|
||||||
|#
|
|
||||||
#|
|
|
||||||
(string=? "boing" (extract-k-url (open-input-string "<html><form action='boing'>hi</form></html>")))
|
|
||||||
(string=? "boing" (extract-k-url (open-input-string "<html><form><form action='boing'>hi</form></form></html>")))
|
|
||||||
(with-handlers ([void (lambda (exn) (string=? exn "couldn't find action url"))])
|
|
||||||
(extract-k-url (open-input-string "<html><p>pair of graph</p></html>"))
|
|
||||||
#f)
|
|
||||||
|#
|
|
||||||
)
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
||||||
(module web-hammer mzscheme
|
|
||||||
(require net/url)
|
|
||||||
(provide server-performance)
|
|
||||||
(provide (all-from net/url))
|
|
||||||
|
|
||||||
(define BUFFER-SIZE 8192)
|
|
||||||
|
|
||||||
;; server-performance : Url Nat Nat Nat -> Num
|
|
||||||
;; num-clients client threads request the url from the server repeatedly
|
|
||||||
;; think-time-msecs appart for duration-seconds
|
|
||||||
;; the performance is completed requests per second
|
|
||||||
(define (server-performance url num-clients think-time-msec duration-seconds)
|
|
||||||
(let ([cust (make-custodian)]
|
|
||||||
[think-time-seconds (/ think-time-msec 1000)]
|
|
||||||
[responses (make-vector num-clients 0)]
|
|
||||||
[start (current-milliseconds)])
|
|
||||||
(parameterize ([current-custodian cust])
|
|
||||||
(let loop ([n num-clients])
|
|
||||||
(let ([n-1 (sub1 n)])
|
|
||||||
(unless (zero? n)
|
|
||||||
(thread
|
|
||||||
(lambda ()
|
|
||||||
(let request ()
|
|
||||||
(with-handlers ([exn:fail? void])
|
|
||||||
(parameterize ([current-custodian (make-custodian)])
|
|
||||||
(let ([port (get-pure-port url)])
|
|
||||||
(let discard-all ()
|
|
||||||
(let ([s (read-string BUFFER-SIZE port)])
|
|
||||||
(unless (eof-object? s)
|
|
||||||
(discard-all)))))
|
|
||||||
(custodian-shutdown-all (current-custodian)))
|
|
||||||
; vector-set! is inside ignore errors so it doesn't happen for unfulfilled requests
|
|
||||||
(vector-set! responses n-1 (add1 (vector-ref responses n-1))))
|
|
||||||
(sleep think-time-seconds)
|
|
||||||
(request))))
|
|
||||||
(loop n-1)))))
|
|
||||||
(sleep duration-seconds)
|
|
||||||
(custodian-shutdown-all cust)
|
|
||||||
(let ([stop (current-milliseconds)])
|
|
||||||
(* 1000 (/ (apply + (vector->list responses)) (- stop start)))))))
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Access Denied</title></head>
|
|
||||||
<body>
|
|
||||||
<p>The server could not verify that you have permissions to access the requested document.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Not Found</title></head>
|
|
||||||
<body bgcolor='white'>
|
|
||||||
<p>The file you were looking for was not found on this server.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Passwords Refreshed</title></head>
|
|
||||||
<body bgcolor='white'>
|
|
||||||
<p>The Web server is now using the new password file.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Browser Error</title></head>
|
|
||||||
<body>
|
|
||||||
<p>The browser sent a malformed request.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Servlet Error</title></head>
|
|
||||||
<body>
|
|
||||||
<p>The servlet terminated abnormally.<br />
|
|
||||||
Please ask the author to fix the problem based on the details in
|
|
||||||
the Web server's log file.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Servlets Refreshed</title></head>
|
|
||||||
<body bgcolor='white'>
|
|
||||||
<p>Fresh copies of Servlets will now be (re)loaded from disk.</p>
|
|
||||||
<p>Powered by <a href="http://www.plt-scheme.org/">PLT</a></p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,136 +0,0 @@
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghi
|
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+\|[]{}()~
|
|
||||||
abcdefghijklmnopqrstuvwxyz0123456789A
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
||||||
<html>
|
|
||||||
<head>
|
|
||||||
<title>Welcome to the PLT Web server!</title>
|
|
||||||
</head>
|
|
||||||
|
|
||||||
<body bgcolor="white">
|
|
||||||
<img src="/Defaults/documentation/web-server.gif" width="61" height="57" />
|
|
||||||
|
|
||||||
<blockquote>
|
|
||||||
|
|
||||||
<table width="66%" bgcolor="white">
|
|
||||||
<tr><td>
|
|
||||||
<h2>Welcome to the PLT Web Server</h2>
|
|
||||||
|
|
||||||
<p>
|
|
||||||
Find out more about <a href='/Defaults/'>the server and configure</a> it.
|
|
||||||
</p>
|
|
||||||
|
|
||||||
<p>Please replace this page with your favorite index page.
|
|
||||||
<br />For future configuration changes, remember to look up
|
|
||||||
<br />
|
|
||||||
<center>
|
|
||||||
<code> http://127.0.0.1:<em>port</em>/Defaults/ </code>
|
|
||||||
</center>
|
|
||||||
|
|
||||||
<p>Powered by
|
|
||||||
<a href="http://www.plt-scheme.org/">
|
|
||||||
<img width="53" height="19" src="/Defaults/documentation/plt-logo.gif" />
|
|
||||||
</a>
|
|
||||||
<p><font size="-2">
|
|
||||||
For more information on PLT Software, please follow the icon link.
|
|
||||||
</font>
|
|
||||||
</p>
|
|
||||||
</p>
|
|
||||||
</table>
|
|
||||||
|
|
||||||
</blockquote>
|
|
||||||
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 113 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 113 KiB |
|
|
@ -1,8 +0,0 @@
|
||||||
<html>
|
|
||||||
<head><title>Home</title></head>
|
|
||||||
<body>
|
|
||||||
<p>
|
|
||||||
Hi.
|
|
||||||
</p>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
'(("secret stuff" "/secret(/.*)?" (bubba "bbq") (|Billy| "BoB")))
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
; DO NOT DELETE THIS SERVLET,
|
|
||||||
; 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.
|
|
||||||
|
|
||||||
(require web-server/configure)
|
|
||||||
|
|
||||||
servlet
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
(module a-module 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 "A simple module servlet works.")))))
|
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
(module b-module mzscheme
|
|
||||||
(provide interface-version timeout start)
|
|
||||||
(require web-server/servlet-sig)
|
|
||||||
|
|
||||||
(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 ,(format "Here are the initial bindings: ~v"
|
|
||||||
(request-bindings initial-request)))))))
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
(require "not-there-on-purpose.ss")
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
(require mzlib/unitsig)
|
|
||||||
(require web-server/servlet-sig)
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
5)
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
(require mzlib/unitsig)
|
|
||||||
(require web-server/servlet-sig)
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
(raise 'kablooie))
|
|
||||||
|
|
@ -1,55 +0,0 @@
|
||||||
; purpose: to test send/suspend, send/forward, send/back, and send/finish
|
|
||||||
(module cut-module mzscheme
|
|
||||||
(provide interface-version timeout start)
|
|
||||||
(require web-server/servlet
|
|
||||||
web-server/servlet-sig)
|
|
||||||
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define timeout (* 7 24 60 60))
|
|
||||||
|
|
||||||
; : request -> response
|
|
||||||
(define (start initial-request)
|
|
||||||
(let ([order (extract-binding/single
|
|
||||||
'order
|
|
||||||
(request-bindings
|
|
||||||
(send/suspend (let ([question "Place your order"])
|
|
||||||
(build-suspender
|
|
||||||
`(,question)
|
|
||||||
`(,question (input ([type "text"] [name "order"]))))))))])
|
|
||||||
(if (string=? "coconut" order)
|
|
||||||
(continue-shopping)
|
|
||||||
(retry-order))))
|
|
||||||
|
|
||||||
; : -> doesn't
|
|
||||||
(define (continue-shopping)
|
|
||||||
(let* ([next-request
|
|
||||||
(send/forward
|
|
||||||
(build-suspender
|
|
||||||
'("Keep shopping")
|
|
||||||
`((p "Your order has shipped to a random location. You may not go back.")
|
|
||||||
(p (input ([type "submit"] [name "go"] [value "Keep Shopping"])))
|
|
||||||
(p (input ([type "submit"] [name "stop"] [value "Logout"]))))))]
|
|
||||||
[next (request-bindings next-request)])
|
|
||||||
(cond
|
|
||||||
[(exists-binding? 'go next)
|
|
||||||
(start next-request)]
|
|
||||||
[(exists-binding? 'stop next)
|
|
||||||
(send/finish goodbye-page)]
|
|
||||||
[else
|
|
||||||
(send/finish
|
|
||||||
`(html (head (title "Oops"))
|
|
||||||
(body ([bgcolor "white"])
|
|
||||||
(p "Oops " ,(format "next = ~v" next)))))])))
|
|
||||||
|
|
||||||
; : -> doesn't
|
|
||||||
(define (retry-order)
|
|
||||||
(send/back '(html (head (title "oops"))
|
|
||||||
(body (p "This store only sells coconuts. Please click the browser's back button and type "
|
|
||||||
(code "coconut") " in the field.")))))
|
|
||||||
|
|
||||||
(define goodbye-page
|
|
||||||
`(html (head (title "Goodbye"))
|
|
||||||
(body (p "Thank you for shopping.")))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
(require web-server/servlet-sig
|
|
||||||
mzlib/unitsig)
|
|
||||||
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
|
|
||||||
(send/finish
|
|
||||||
(make-html-response/incremental
|
|
||||||
(lambda (output-chunk)
|
|
||||||
(output-chunk "<html><head><title>"
|
|
||||||
"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")))))
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
(require mzlib/unitsig)
|
|
||||||
(require web-server/servlet-sig)
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
`("text/uber-format"
|
|
||||||
"uber uber uber"
|
|
||||||
"-de-doo"))
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
(module module-suspended-init mzscheme
|
|
||||||
(provide interface-version timeout start)
|
|
||||||
(require web-server/servlet
|
|
||||||
web-server/servlet-sig)
|
|
||||||
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define timeout (* 7 24 60 60))
|
|
||||||
|
|
||||||
; : request -> response
|
|
||||||
(define (start initial-request)
|
|
||||||
(let ([name (extract-binding/single
|
|
||||||
'name
|
|
||||||
(request-bindings
|
|
||||||
(send/suspend (let ([question "What is your name?"])
|
|
||||||
(build-suspender
|
|
||||||
`(,question)
|
|
||||||
`(,question (input ([type "text"] [name "name"]))))))))])
|
|
||||||
`(html (head (title "Hi " ,name "!"))
|
|
||||||
(body (p "Hello, " ,name "! Don't you feel special now?")))))
|
|
||||||
|
|
||||||
(send/suspend
|
|
||||||
(build-suspender '("Module Init")
|
|
||||||
'((p "Maybe calling send/suspend during the module initialization is not a good idea.")
|
|
||||||
(p "This call to send/suspend fails in the development environment since the parameter is #f")
|
|
||||||
(p "It fails in the server because the instance id is not yet installed into the table.")))))
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
5
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
(define title "A Test of Direct Responses")
|
|
||||||
|
|
||||||
`(html (head (title ,title))
|
|
||||||
(body (h2 ,title)
|
|
||||||
(p "This is only a test.")))
|
|
||||||
|
|
@ -1,22 +0,0 @@
|
||||||
(require mzlib/unitsig)
|
|
||||||
(require web-server/servlet-sig)
|
|
||||||
|
|
||||||
(let* ([line-size 80]
|
|
||||||
[build-a-str
|
|
||||||
(lambda (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/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
|
|
||||||
(define size (- (string->number (cdr (assq 'size bindings))) html-overhead))
|
|
||||||
(define nlines (quotient size line-size))
|
|
||||||
(define extra (remainder size line-size))
|
|
||||||
|
|
||||||
`(html (head (title "A Page"))
|
|
||||||
(body (p ,@(vector->list (make-vector nlines line))
|
|
||||||
,(build-a-str extra))))))
|
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
(module suspended-module mzscheme
|
|
||||||
(provide interface-version timeout start)
|
|
||||||
(require web-server/servlet
|
|
||||||
web-server/servlet-sig)
|
|
||||||
|
|
||||||
(define interface-version 'v1)
|
|
||||||
|
|
||||||
(define timeout (* 7 24 60 60))
|
|
||||||
|
|
||||||
; : request -> response
|
|
||||||
(define (start initial-request)
|
|
||||||
(let ([name (extract-binding/single
|
|
||||||
'name
|
|
||||||
(request-bindings
|
|
||||||
(send/suspend (let ([question "What is your name?"])
|
|
||||||
(build-suspender
|
|
||||||
`(,question)
|
|
||||||
`(,question (input ([type "text"] [name "name"]))))))))])
|
|
||||||
`(html (head (title "Hi " ,name "!"))
|
|
||||||
(body (p "Hello, " ,name "! Don't you feel special now?"))))))
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
(require mzlib/unitsig)
|
|
||||||
(require web-server/servlet-sig)
|
|
||||||
(let ([count 0])
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
(with-handlers ([void (lambda (exn) `(html (body (p ,(exn-message exn)))))])
|
|
||||||
(set! count (add1 count))
|
|
||||||
`(html (head (title "Testing 1...2...3"))
|
|
||||||
(body (p "This is a generated web page.")
|
|
||||||
(p ,(format "Here are the bindings:~n~s~n" (request-bindings initial-request))
|
|
||||||
(br)
|
|
||||||
"Count = " ,(number->string count)
|
|
||||||
(br)
|
|
||||||
,(format "Here are the headers:~n~s~n" (request-headers initial-request)))))))
|
|
||||||
)
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
(require mzlib/unitsig
|
|
||||||
web-server/servlet-sig
|
|
||||||
net/url)
|
|
||||||
(let ([count 0])
|
|
||||||
(unit/sig ()
|
|
||||||
(import servlet^)
|
|
||||||
(set! count (add1 count))
|
|
||||||
`(html (head (title "URL Test"))
|
|
||||||
(body (p "The method requested is: " ,(format "~s" (request-method initial-request)))
|
|
||||||
(p "The URL requested is: " ,(url->string (request-uri initial-request)))
|
|
||||||
(p "count is: " ,(number->string count))))))
|
|
||||||
Loading…
Reference in New Issue
Block a user