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

Fix PR1859

Browse Source
This commit is contained in:
Jay McCarthy 2017-10-20 11:08:13 -04:00
parent e255c737b5
commit 06e3205787
2 changed files with 40 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/net-test/tests/net/url.rkt
View File

@ -35,6 +35,14 @@
("http_proxy" . ,http-proxy) ("http_proxy" . ,http-proxy)
("https_proxy" . ,https-proxy) ("https_proxy" . ,https-proxy)
("git_proxy" . ,git-proxy) ("git_proxy" . ,git-proxy)
("PLT_HTTP_PROXY" . ,plt-http-proxy)
("PLT_HTTPS_PROXY" . ,plt-https-proxy)
("PLT_GIT_PROXY" . ,plt-git-proxy)
("HTTP_PROXY" . ,http-proxy)
("HTTPS_PROXY" . ,https-proxy)
("GIT_PROXY" . ,git-proxy)
("plt_no_proxy" . ,plt-no-proxy) ("plt_no_proxy" . ,plt-no-proxy)
("no_proxy" . ,no-proxy))))) ("no_proxy" . ,no-proxy)))))
(put! (car var.val) (cdr var.val))) (put! (car var.val) (cdr var.val)))

56
racket/collects/net/url.rkt
View File

@ -37,32 +37,40 @@
;; proxying-scheme is therefore always "http" (no "s") -- although the meaning thereof depends on the ;; proxying-scheme is therefore always "http" (no "s") -- although the meaning thereof depends on the
;; proxied-scheme ;; proxied-scheme
(define (env->c-p-s-entries . envarses) (define (env->c-p-s-entries . envarses)
(define (inr envars) (define (in1 proxied-scheme envvar)
(if (null? envars) (match (getenv envvar)
null [#f #f]
(let ((proxied-scheme (match (car envars) ["" null]
[(regexp #rx"plt_(.*)_proxy" (list _ scm)) scm] [(app string->url
[(regexp #rx"(.*)_proxy" (list _ scm)) scm]))) (url (and proxying-scheme "http") #f (? string? host) (? integer? port)
(match (getenv (car envars)) _ (list) (list) #f))
[#f (env->c-p-s-entries (cdr envars))] (list (list proxied-scheme host port))]
["" null] [(app string->url
[(app string->url (url (and proxying-scheme "http") _ (? string? host) (? integer? port)
(url (and proxying-scheme "http") #f (? string? host) (? integer? port) _ _ _ _))
_ (list) (list) #f)) (log-net/url-warning "~s contains somewhat invalid proxy URL format" envvar)
(list (list proxied-scheme host port))] (list (list proxied-scheme host port))]
[(app string->url [inv
(url (and proxying-scheme "http") _ (? string? host) (? integer? port) (log-net/url-error "~s contained invalid proxy URL format: ~s" envvar inv)
_ _ _ _)) null]))
(log-net/url-warning "~s contains somewhat invalid proxy URL format" (car envars)) (define (inr proxied-scheme envars)
(list (list proxied-scheme host port))] (match envars
[inv (log-net/url-error "~s contained invalid proxy URL format: ~s" (car envars) inv) ['() null]
null])))) [(cons envvar more-envars)
(apply append (map inr envarses))) (or (in1 proxied-scheme envvar)
(in1 proxied-scheme (string-upcase envvar))
(inr proxied-scheme more-envars))]))
(define (inrs spec)
(inr (first spec) (rest spec)))
(append-map inrs envarses))
(define current-proxy-servers-promise (define current-proxy-servers-promise
(make-parameter (delay/sync (env->c-p-s-entries '("plt_http_proxy" "http_proxy") (make-parameter
'("plt_https_proxy" "https_proxy") (delay/sync
'("plt_git_proxy" "git_proxy"))))) (env->c-p-s-entries
'("http" "plt_http_proxy" "http_proxy" "all_proxy")
'("https" "plt_https_proxy" "https_proxy" "all_proxy")
'("git" "plt_git_proxy" "git_proxy" "all_proxy")))))
(define (proxy-servers-guard v) (define (proxy-servers-guard v)
(unless (and (list? v) (unless (and (list? v)