suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Removing some utilities

Browse Source 
svn: r6423
This commit is contained in:
Jay McCarthy 2007-05-30 22:54:34 +00:00
parent 229cf60278
commit 1b02edd3d9
9 changed files with 31 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/web-server/configuration/configuration-table-structs.ss
View File

@ -27,7 +27,7 @@
(provide/contract
[struct configuration-table
([port natural-number/c]
([port (between/c 1 65535)]
[max-waiting natural-number/c]
[initial-connection-timeout natural-number/c]
[default-host host-table?]

3
collects/web-server/dispatchers/dispatch-files.ss
View File

@ -41,7 +41,8 @@
(gen-file-not-found-responder "not-found.html")])
(define get-mime-type (make-get-mime-type mime-types-path))
(lambda (conn req)
(define-values (uri method _path) (decompose-request req))
(define uri (request-uri req))
(define method (request-method req))
;; ************************************************************
;; ************************************************************
;; SERVING FILES

7
collects/web-server/dispatchers/dispatch-filter.ss
View File

@ -1,6 +1,9 @@
(module dispatch-filter mzscheme
(require (lib "contract.ss"))
(require (lib "contract.ss")
(lib "url.ss" "net")
(lib "uri-codec.ss" "net"))
(require "dispatch.ss"
"../request-structs.ss"
"../private/util.ss")
(provide/contract
[interface-version dispatcher-interface-version?]
@ -8,7 +11,7 @@
(define interface-version 'v1)
(define ((make regex inner) conn req)
(define-values (uri method path) (decompose-request req))
(define path (uri-decode (url-path->string (url-path (request-uri req)))))
(if (regexp-match regex path)
(inner conn req)
(next-dispatcher))))

6
collects/web-server/dispatchers/dispatch-passwords.ss
View File

@ -1,5 +1,7 @@
(module dispatch-passwords mzscheme
(require (lib "kw.ss")
(lib "url.ss" "net")
(lib "uri-codec.ss" "net")
(lib "contract.ss"))
(require "dispatch.ss"
"../private/util.ss"
@ -35,7 +37,9 @@
(update-password-cache!)
(unbox password-cache))
(lambda (conn req)
(define-values (uri method path) (decompose-request req))
(define uri (request-uri req))
(define path (uri-decode (url-path->string (url-path uri))))
(define method (request-method req))
(define denied? (read-password-cache))
(cond
[(and denied?

19
collects/web-server/dispatchers/dispatch-pathprocedure.ss
View File

@ -1,8 +1,11 @@
(module dispatch-pathprocedure mzscheme
(require (lib "contract.ss"))
(require (lib "contract.ss")
(lib "url.ss" "net")
(lib "uri-codec.ss" "net"))
(require "dispatch.ss"
"../private/util.ss"
"../private/response.ss"
"../request-structs.ss"
"../response-structs.ss")
(provide/contract
[interface-version dispatcher-interface-version?]
@ -10,10 +13,10 @@
(define interface-version 'v1)
(define ((make the-path procedure) conn req)
(let-values ([(uri method path) (decompose-request req)])
(if (string=? the-path path)
(output-response/method
conn
(procedure)
method)
(next-dispatcher)))))
(define path (uri-decode (url-path->string (url-path (request-uri req)))))
(if (string=? the-path path)
(output-response/method
conn
(procedure)
(request-method req))
(next-dispatcher))))

7
collects/web-server/dispatchers/dispatch-servlets.ss
View File

@ -3,7 +3,8 @@
(lib "kw.ss")
(lib "plt-match.ss")
(lib "string.ss")
(lib "contract.ss"))
(lib "contract.ss")
(lib "uri-codec.ss" "net"))
(require "dispatch.ss"
"../private/web-server-structs.ss"
"../private/connection-manager.ss"
@ -383,7 +384,7 @@
;; return dispatcher
(lambda (conn req)
(define-values (uri method path) (decompose-request req))
(define path (uri-decode (url-path->string (url-path (request-uri req)))))
(cond [(string=? "/conf/refresh-servlets" path)
;; more here - this is broken - only out of date or specifically mentioned
;; scripts should be flushed. This destroys persistent state!
@ -391,7 +392,7 @@
(output-response/method
conn
(responders-servlets-refreshed)
method)]
(request-method req))]
[(servlet-bin? path)
(adjust-connection-timeout!
conn

5
collects/web-server/private/launch.ss
View File

@ -25,10 +25,7 @@
("Use an alternate configuration table" "file-name")]
[("-p" "--port")
,(lambda (flag port)
(let ([p (string->number port)])
(if (valid-port? p)
(cons 'port p)
(error 'web-server "port expects an argument of type <exact integer in [1, 65535]>; given ~s" port))))
(cons 'port (string->number port)))
("Use an alternate network port." "port")]
[("-a" "--ip-address")
,(lambda (flag ip-address)

5
collects/web-server/private/setup-launch.ss
View File

@ -13,10 +13,7 @@
`((once-each
[("-p" "--port")
,(lambda (flag port)
(let ([p (string->number port)])
(if (valid-port? p)
(cons 'port p)
(error 'web-server-setup "port expects an argument of type <exact integer in [1, 65535]>; given ~s" port))))
(cons 'port (string->number port)))
("Use an alternate network port." "port")]
[("-d" "--destination")
,(lambda (flag destination)

41
collects/web-server/private/util.ss
View File

@ -5,10 +5,6 @@
(lib "uri-codec.ss" "net"))
(require "../request-structs.ss")
;; valid-port? : any/c -> boolean?
(define (valid-port? p)
(and (integer? p) (exact? p) (<= 1 p 65535)))
;; ripped this off from url-unit.ss
(define (url-path->string strs)
(apply string-append
@ -29,13 +25,6 @@
[else (error 'maybe-join-params
"bad value from path/param-path: ~e" s)])))))
;; decompse-request : request -> uri * symbol * string
(define (decompose-request req)
(let* ([uri (request-uri req)]
[method (request-method req)]
[path (uri-decode (url-path->string (url-path uri)))])
(values uri method path)))
;; network-error: symbol string . values -> void
;; throws a formatted exn:fail:network
(define (network-error src fmt . args)
@ -63,28 +52,7 @@
s)])
(string-lowercase! s)
(string->symbol s)))
; prefix? : str -> str -> bool
; more here - consider moving this to mzlib's string.ss
;; Notes: (GregP)
;; 1. What's the significance of char # 255 ???
;; 2. 255 isn't an ascii character. ascii is 7-bit
;; 3. OK f this. It is only used in three places, some of them
;; will involve bytes while the others may involve strings. So
;; I will just use regular expressions and get on with life.
(define (prefix?-old prefix)
(let* ([len (string-length prefix)]
[last (string-ref prefix (sub1 len))]
[ascii (char->integer last)])
(if (= 255 ascii)
; something could be done about this - ab255 -> ac
; and all 255's eliminates upper range check
(error 'prefix? "prefix can't end in the largest character")
(let ([next (string-append (substring prefix 0 (sub1 len))
(string (integer->char (add1 ascii))))])
(lambda (x)
(and (string<=? prefix x) (string<? x next)))))))
(define (directory-part path)
(let-values ([(base name must-be-dir) (split-path path)])
(cond
@ -112,16 +80,9 @@
(cdr x)
default)))
; hash-table-empty? : hash-table -> bool
(define (hash-table-empty? table)
(zero? (hash-table-count table)))
(provide/contract
[url-path->string ((listof (or/c string? path/param?)) . -> . string?)]
[extract-flag (symbol? (listof (cons/c symbol? any/c)) any/c . -> . any/c)]
[hash-table-empty? (any/c . -> . boolean?)]
[valid-port? (any/c . -> . boolean?)]
[decompose-request ((request?) . ->* . (url? symbol? string?))]
[network-error ((symbol? string?) (listof any/c) . ->* . (void))]
[path->list (path? . -> . (cons/c (or/c path? (symbols 'up 'same))
(listof (or/c path? (symbols 'up 'same)))))]