From a14fe66f94b9aff41d2ce99517da2d82aa1d342b Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Mon, 20 Jun 2011 06:30:09 -0400
Subject: [PATCH] Hack: make the `net/url' implementation handle both "http"
and "https" urls, dispatching to the plain tcp functions or the ssl one.
(See "HACK" comment for a description on how this is done.)
original commit: e74f70393fcc27775b80a2bf18535082563ae779
---
collects/net/url-unit.rkt | 39 +++++++++++++++++++++++++++++++++------
1 file changed, 33 insertions(+), 6 deletions(-)
diff --git a/collects/net/url-unit.rkt b/collects/net/url-unit.rkt
index c5479ca..245a771 100644
--- a/collects/net/url-unit.rkt
+++ b/collects/net/url-unit.rkt
@@ -12,10 +12,10 @@
;; "pure" = the MIME headers have been read
(require racket/port racket/string
- "url-structs.rkt"
- "uri-codec.rkt"
- "url-sig.rkt"
- "tcp-sig.rkt")
+ "url-structs.rkt" "uri-codec.rkt" "url-sig.rkt" "tcp-sig.rkt")
+
+;; See "HACK" below.
+(require (prefix-in r: racket/tcp))
(import tcp^)
(export url^)
@@ -92,13 +92,37 @@
[(string=? scheme "https") 443]
[else (url-error "Scheme ~a not supported" (url-scheme url))])))
+;; HACK: if `tcp-connect' is void, then instead of using the input unit
+;; we dispatch (based on the url scheme) directly to the built in tcp
+;; functionality or to the ssl functions. This makes it possible to
+;; have net/url provide an implementation that handles both http and
+;; https, while code that uses this unit directly (like old code that
+;; slaps together an ssl version) continues to work.
+(define dispatch-on-scheme? (void? tcp-connect))
+(define get-ssl
+ (let ([connect #f] [abandon #f])
+ ;; require the ssl code only when needed
+ (lambda (name)
+ (unless connect
+ (define-values/invoke-unit
+ ((dynamic-require 'net/ssl-tcp-unit 'make-ssl-tcp@)
+ #f #f #f #f #f #f #f)
+ (import) (export tcp^))
+ (set! connect tcp-connect)
+ (set! abandon tcp-abandon-port))
+ (case name [(connect) connect] [(abandon) abandon]))))
+
;; make-ports : url -> in-port x out-port
(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)))
+ ((cond
+ [(not dispatch-on-scheme?) tcp-connect]
+ [(string=? (url-scheme url) "https") (get-ssl 'connect)]
+ [else r: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 get? url post-data strings)
@@ -127,7 +151,10 @@
(println)
(when post-data (display post-data client->server))
(flush-output client->server)
- (tcp-abandon-port client->server)
+ ((cond [(not dispatch-on-scheme?) tcp-abandon-port]
+ [(string=? (url-scheme url) "https") (get-ssl 'abandon)]
+ [else r:tcp-abandon-port])
+ client->server)
server->client)
(define (file://->path url [kind (system-path-convention-type)])