syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Use SSL on outbound HTTPS connections properly

This commit is contained in:
Tony Garnock-Jones 2016-11-21 17:38:55 +13:00
parent 9d34ffea4f
commit c8b7be22cc
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
racket/syndicate/drivers/web.rkt
View File

@ -427,17 +427,20 @@
headers headers
query) query)
req) req)
(values host (values (match scheme
[(or "wss" "https") #t]
[_ #f])
host
(or port (match scheme (or port (match scheme
["http" 80] [(or "ws" "http") 80]
["https" 443] [(or "wss" "https") 443]
[_ #f])) [_ #f]))
method method
(url->string (resource->url resource #:query query)) (url->string (resource->url resource #:query query))
headers)) headers))
(define (do-request-websocket id req) (define (do-request-websocket id req)
(define-values (_host server-port method urlstr headers) (analyze-outbound-request req)) (define-values (_ssl? _host server-port method urlstr headers) (analyze-outbound-request req))
(define control-ch (make-channel)) (define control-ch (make-channel))
(if (not server-port) (if (not server-port)
(send-ground-message (web-raw-client-conn id #f)) (send-ground-message (web-raw-client-conn id #f))
@ -463,7 +466,7 @@
(assert (web-response-websocket id #f))))))) (assert (web-response-websocket id #f)))))))
(define (do-request-complete id req body) (define (do-request-complete id req body)
(define-values (host server-port method urlstr headers) (analyze-outbound-request req)) (define-values (ssl? host server-port method urlstr headers) (analyze-outbound-request req))
(thread (thread
(lambda () (lambda ()
(define response (define response
@ -473,6 +476,7 @@
(define-values (first-line header-lines body-port) (define-values (first-line header-lines body-port)
(http-sendrecv host (http-sendrecv host
urlstr urlstr
#:ssl? ssl?
#:headers (build-http-client-headers headers) #:headers (build-http-client-headers headers)
#:port server-port #:port server-port
#:method (string-upcase (symbol->string method)) #:method (string-upcase (symbol->string method))