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

Fixed (and improved) `http://getpost-impure-port' to show the port in

Browse Source 
the Host header if it's not the default.

svn: r3744

original commit: 96034746fc334de939259e314b187eb6402f2127
This commit is contained in:
Eli Barzilay 2006-07-17 20:06:52 +00:00
parent 28bc64b5f8
commit eee9fa25fa
1 changed files with 40 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/net/url-unit.ss
View File

@ -95,56 +95,50 @@
(if fragment (sa "#" (uri-encode fragment)) ""))))))
;; url->default-port : url -> num
(define url->default-port
(lambda (url)
(let ((scheme (url-scheme url)))
(cond
((not scheme) 80)
((string=? scheme "http") 80)
(else
(url-error "Scheme ~a not supported" (url-scheme url)))))))
(define (url->default-port url)
(let ([scheme (url-scheme url)])
(cond [(not scheme) 80]
[(string=? scheme "http") 80]
[else (url-error "Scheme ~a not supported" (url-scheme url))])))
;; make-ports : url -> in-port x out-port
(define make-ports
(lambda (url proxy)
(let ((port-number (if proxy
(caddr proxy)
(or (url-port url)
(url->default-port url))))
(host (if proxy
(cadr proxy)
(url-host url))))
(tcp-connect host port-number))))
(define (make-ports url proxy)
(let ([port-number (if proxy
(caddr proxy)
(or (url-port url) (url->default-port url)))]
[host (if proxy
(cadr proxy)
(url-host url))])
(tcp-connect host port-number)))
;; http://getpost-impure-port : bool x url x union (str, #f) x list (str) -> in-port
(define http://getpost-impure-port
(lambda (get? url post-data strings)
(let*-values (((proxy) (assoc (url-scheme url) (current-proxy-servers)))
((server->client client->server)
(make-ports url proxy)))
(let ((access-string
(url->string
(if proxy
url
(make-url #f #f #f #f
(url-path-absolute? url)
(url-path url)
(url-query url)
(url-fragment url))))))
(for-each (lambda (s)
(display (string-append s "\r\n") client->server))
(cons (format "~a ~a HTTP/1.0" (if get? "GET" "POST") access-string)
(cons (format "Host: ~a" (url-host url))
(if post-data
(cons
(format "Content-Length: ~a" (bytes-length post-data))
strings)
strings)))))
(display "\r\n" client->server)
(when post-data
(display post-data client->server))
(tcp-abandon-port client->server) ; flushes
server->client)))
(define (http://getpost-impure-port get? url post-data strings)
(let*-values
([(proxy) (assoc (url-scheme url) (current-proxy-servers))]
[(server->client client->server) (make-ports url proxy)]
[(access-string) (url->string
(if proxy
url
(make-url #f #f #f #f
(url-path-absolute? url)
(url-path url)
(url-query url)
(url-fragment url))))])
(define (println . xs)
(for-each (lambda (x) (display x client->server)) xs)
(display "\r\n" client->server))
(println (if get? "GET " "POST ") access-string " HTTP/1.0")
(println "Host: " (url-host url)
(let ([p (url-port url)])
(if (equal? p (url->default-port url))
"" (format ":~a" p))))
(when post-data (println "Content-Length: " (bytes-length post-data)))
(for-each println strings)
(println)
(when post-data (display post-data client->server))
(flush-output client->server)
(tcp-abandon-port client->server)
server->client))
(define (file://->path url)
;; remove all ""s