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

minor code improvements

Browse Source 
svn: r4608
This commit is contained in:
Eli Barzilay 2006-10-15 05:36:58 +00:00
parent 6b385008ad
commit 46c2b8ae1b
1 changed files with 23 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,47 +6,46 @@
(lib "plt-match.ss") (lib "plt-match.ss")
(lib "uri-codec.ss" "net")) (lib "uri-codec.ss" "net"))
(require "../request-structs.ss") (require "../request-structs.ss")
;; valid-port? : any/c -> boolean? ;; valid-port? : any/c -> boolean?
(define (valid-port? p) (define (valid-port? p)
(and (number? p) (integer? p) (exact? p) (<= 1 p 65535))) (and (integer? p) (exact? p) (<= 1 p 65535)))
;; ripped this off from url-unit.ss ;; ripped this off from url-unit.ss
(define (url-path->string strs) (define (url-path->string strs)
(apply (apply string-append
string-append (apply append
(map (match-lambda (map (lambda (s) (list "/" (maybe-join-params s)))
['up ".."] strs))))
['same "."]
[(and s (? string?)) s])
(let loop ([strs strs])
(cond
[(null? strs) (list)]
[else (list* "/"
(maybe-join-params (car strs))
(loop (cdr strs)))])))))
;; needs to unquote things! ;; needs to unquote things!
(define (maybe-join-params s) (define (maybe-join-params s)
(cond (if (string? s)
[(string? s) s] s
[else (path/param-path s)])) (let ([s (path/param-path s)])
(if (string? s)
s
(case s
[(same) "."]
[(up) ".."]
[else (error 'maybe-join-params
"bad value from path/param-path: ~e" s)])))))
;; decompse-request : request -> uri * symbol * string ;; decompse-request : request -> uri * symbol * string
(define (decompose-request req) (define (decompose-request req)
(let* ([uri (request-uri req)] (let* ([uri (request-uri req)]
[method (request-method req)] [method (request-method req)]
[path (uri-decode (url-path->string (url-path uri)))]) [path (uri-decode (url-path->string (url-path uri)))])
(values uri method path))) (values uri method path)))
;; network-error: symbol string . values -> void ;; network-error: symbol string . values -> void
;; throws a formatted exn:fail:network ;; throws a formatted exn:fail:network
(define (network-error src fmt . args) (define (network-error src fmt . args)
(raise (make-exn:fail:network (raise (make-exn:fail:network
(string->immutable-string (string->immutable-string
(apply format (format "~a: ~a" src fmt) args)) (format "~a: ~a" src (apply format fmt args)))
(current-continuation-marks)))) (current-continuation-marks))))
;; build-path-unless-absolute : path (or/c string? path?) -> path? ;; build-path-unless-absolute : path (or/c string? path?) -> path?
(define (build-path-unless-absolute base path) (define (build-path-unless-absolute base path)
(if (absolute-path? path) (if (absolute-path? path)
@ -175,4 +174,4 @@
[directory-part (path? . -> . path?)] [directory-part (path? . -> . path?)]
[lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)] [lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)]
[exn->string ((or/c exn? any/c) . -> . string?)] [exn->string ((or/c exn? any/c) . -> . string?)]
[build-path-unless-absolute (path? (or/c string? path?) . -> . path?)])) [build-path-unless-absolute (path? (or/c string? path?) . -> . path?)]))