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

supporting http proxy (without authorization) during make install

Browse Source
This commit is contained in:
Michael Filonenko 2012-12-24 19:51:45 +03:00 committed by Matthew Flatt
parent d228790ed9
commit 6702fd38d2
1 changed files with 25 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/download-libs.rkt
View File

@ -3,6 +3,23 @@
(require racket/tcp)
(provide do-download)
(define-values (http-proxy-host http-proxy-port)
(let ([http-proxy (getenv "http_proxy")])
(if http-proxy
(let ((matched (regexp-match #rx"^(?:[Hh][Tt][Tt][Pp]://)?([^:]+)(?::([0-9]+))?$" http-proxy)))
(if matched
(values (list-ref matched 1)
(or (and (list-ref matched 2)
(string->number (list-ref matched 2)))
80))
(begin
(printf "Could not parse `http_proxy' value: ~e\n" http-proxy)
(values #f #f))))
(values #f #f))))
(when http-proxy-host
(printf ">> Proxy detected: host ~a port ~a\n" http-proxy-host http-proxy-port))
(define url-host "download.racket-lang.org")
(define url-path "/libs/10/")
(define url-base (string-append "http://" url-host url-path))
@ -35,10 +52,15 @@
(define (download* file target)
(define src (format "~a~a/~a" url-path architecture file))
(define-values [i o] (tcp-connect url-host 80))
(fprintf o "GET ~a HTTP/1.0\r\nHost: ~a\r\n\r\n" src url-host)
(define-values [i o] (if http-proxy-host
(tcp-connect http-proxy-host http-proxy-port)
(tcp-connect url-host 80)))
(if http-proxy-host
(fprintf o "GET ~a~a~a HTTP/1.0\r\nHost: ~a\r\n\r\n" "http://" url-host src url-host)
(fprintf o "GET ~a HTTP/1.0\r\nHost: ~a\r\n\r\n" src url-host))
(flush-output o) (tcp-abandon-port o)
(purify-port i)
(call-with-output-file target #:exists 'truncate/replace
(λ (out) (copy-port i out))))
@ -78,6 +100,7 @@
(define (do-download needed really-needed arch)
(set! architecture arch)
(printf ">> Downloading files from\n>> ~a~a\n" url-base architecture)
(printf ">> (set the `http_proxy' environment variable if a proxy is needed)\n")
(printf ">> If you don't want automatic download, download each file\n")
(printf ">> yourself from there to\n")
(printf ">> ~a\n" (path->complete-path (current-directory)))