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

Added

Browse Source 
head-pure-port,   delete-pure-port,   put-pure-port,
  head-impure-port, delete-impure-port, put-impure-port
to (lib "url.ss" "net").
Updated doc.txt.

  

svn: r5317
This commit is contained in:
Jens Axel Soegaard 2007-01-11 23:57:01 +00:00
parent 9330d96ad7
commit 2589d4fc0d
5 changed files with 154 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/help/private/tcp-intercept.ss
View File

@ -31,6 +31,12 @@
get-impure-port
post-pure-port
post-impure-port
head-pure-port
head-impure-port
put-pure-port
put-impure-port
delete-pure-port
delete-impure-port
display-pure-port
purify-port
netscape/string->url

50
collects/net/doc.txt
View File

@ -142,27 +142,49 @@ PROCEDURES -----------------------------------------------------------
decoded information.
> (get-pure-port url [list-of-strings]) -> input-port
> (head-pure-port url [list-of-strings]) -> input-port
> (delete-pure-port url [list-of-strings]) -> input-port
Takes a URL and returns a pure port corresponding to it. Writes the
optional RFC 822 header-line strings to the server. For the "file"
scheme, uses open-input-file, does not handle exceptions, and
Takes a URL, initiates a GET/HEAD/DELETE request and returns a pure
port corresponding to the body of the response. The optional list of
strings can be used to send header-lines to the server.
The GET method is used to retrieve whatever information is
identified by the url.
The HEAD method is identical to GET, except the server must not
return a message body. The metainformation returned in a response to
a HEAD request should be identical to the information in a response
to a GET request.
The DELETE method is used to delete the entity identified by the
url.
The file:// scheme is handled only by get-pure-port,
which uses open-input-file, does not handle exceptions, and
ignores the optional strings.
> (get-impure-port url [list-of-strings]) -> input-port
> (head-pure-port url [list-of-strings]) -> input-port
> (delete-pure-port url [list-of-strings]) -> input-port
Like <method>-pure-port above, but the port returned corresponds to
both the headers returned as well as the body. The file:// scheme is
handled by none of these functions.
> (post-pure-port url post-byte-string [list-of-strings]) -> input-port
Like `get-pure-port', but issues a POST request (instead of a GET
request) to a web server using the given post data byte string.
> (get-impure-port url [list-of-strings]) -> input-port
Takes a URL and returns an impure port corresponding to it. Writes
the optional RFC 822 header-line strings to the server. There are
no impure ports with scheme "file".
> (put-pure-port url put-byte-string [list-of-strings]) -> input-port
Takes a URL, initiates a POST/PUT request and sends the byte-string.
A pure port port corresponding to the body of the response is
returned. The optional list of strings can be used to send
header-lines to the server.
> (post-impure-port url post-byte-string [list-of-strings]) -> input-port
> (put-impure-port url put-byte-string [list-of-strings]) -> input-port
Like `get-impure-port', but issues a POST request (instead of a GET
request) to a web server using the given post data string.
Like post-pure-port and put-pure-port above, but the port returned
corresponds to both the headers returned as well as the body.
> (display-pure-port input-port) -> void

6
collects/net/url-sig.ss
View File

@ -3,6 +3,12 @@
get-impure-port
post-pure-port
post-impure-port
head-pure-port
head-impure-port
delete-pure-port
delete-impure-port
put-pure-port
put-impure-port
display-pure-port
purify-port
netscape/string->url

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

@ -446,5 +446,105 @@
(if (null? strings)
(apply string-append (reverse! r))
(loop (cdr strings) (list* (car strings) sep r))))]))
;; delete-pure-port : url [x list (str)] -> in-port
(define delete-pure-port
(case-lambda
[(url) (delete-pure-port url '())]
[(url strings) (method-pure-port 'delete url #f strings)]))
;; delete-impure-port : url [x list (str)] -> in-port
(define delete-impure-port
(case-lambda
[(url) (delete-impure-port url '())]
[(url strings) (method-impure-port 'delete url #f strings)]))
;; head-pure-port : url [x list (str)] -> in-port
(define head-pure-port
(case-lambda
[(url) (head-pure-port url '())]
[(url strings) (method-pure-port 'head url #f strings)]))
;; head-impure-port : url [x list (str)] -> in-port
(define head-impure-port
(case-lambda
[(url) (head-impure-port url '())]
[(url strings) (method-impure-port 'head url #f strings)]))
;; put-pure-port : url bytes [x list (str)] -> in-port
(define put-pure-port
(case-lambda
[(url put-data) (put-pure-port url put-data '())]
[(url put-data strings) (method-pure-port 'put url put-data strings)]))
;; put-impure-port : url x bytes [x list (str)] -> in-port
(define put-impure-port
(case-lambda
[(url put-data) (put-impure-port url put-data '())]
[(url put-data strings)
(method-impure-port 'put url put-data strings)]))
;; method-impure-port : symbol x url x list (str) -> in-port
(define (method-impure-port method url data strings)
(let ([scheme (url-scheme url)])
(cond [(not scheme)
(schemeless-url url)]
[(or (string=? scheme "http")
(string=? scheme "https"))
(http://method-impure-port method url data strings)]
[(string=? scheme "file")
(url-error "There are no impure file: ports")]
[else (url-error "Scheme ~a unsupported" scheme)])))
;; method-pure-port : symbol x url x list (str) -> in-port
(define (method-pure-port method url data strings)
(let ([scheme (url-scheme url)])
(cond [(not scheme)
(schemeless-url url)]
[(or (string=? scheme "http")
(string=? scheme "https"))
(let ([port (http://method-impure-port
method url data strings)])
(with-handlers ([void (lambda (exn)
(close-input-port port)
(raise exn))])
(purify-port port))
port)]
[(string=? scheme "file")
(file://get-pure-port url)]
[else (url-error "Scheme ~a unsupported" scheme)])))
;; http://metod-impure-port : symbol x url x union (str, #f) x list (str) -> in-port
(define (http://method-impure-port method url data strings)
(define (method->string method)
(case method
((get) "GET") ((post) "POST") ((head) "HEAD")
((put) "PUT") ((delete) "DELETE")
(else (url-error "unsupported method: ~a" method))))
(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 (method->string method) " " access-string " HTTP/1.0")
(println "Host: " (url-host url)
(let ([p (url-port url)]) (if p (format ":~a" p) "")))
(when data (println "Content-Length: " (bytes-length data)))
(for-each println strings)
(println)
(when data (display data client->server))
(flush-output client->server)
(tcp-abandon-port client->server)
server->client))
))

6
collects/net/url.ss
View File

@ -32,6 +32,12 @@
(get-impure-port (opt-> (url?) ((listof string?)) input-port?))
(post-pure-port (opt-> (url? (or/c false/c bytes?)) ((listof string?)) input-port?))
(post-impure-port (opt-> (url? bytes?) ((listof string?)) input-port?))
(head-pure-port (opt-> (url?) ((listof string?)) input-port?))
(head-impure-port (opt-> (url?) ((listof string?)) input-port?))
(delete-pure-port (opt-> (url?) ((listof string?)) input-port?))
(delete-impure-port (opt-> (url?) ((listof string?)) input-port?))
(put-pure-port (opt-> (url? (or/c false/c bytes?)) ((listof string?)) input-port?))
(put-impure-port (opt-> (url? bytes?) ((listof string?)) input-port?))
(display-pure-port (input-port? . -> . void?))
(purify-port (input-port? . -> . string?))
(netscape/string->url (string? . -> . url?))