diff --git a/chicken-install.scm b/chicken-install.scm
index 9583541..439ee4e 100644
a
|
b
|
|
83 | 83 | (define *windows-shell* (foreign-value "C_WINDOWS_SHELL" bool)) |
84 | 84 | (define *proxy-host* #f) |
85 | 85 | (define *proxy-port* #f) |
| 86 | (define *proxy-user-pass* #f) |
86 | 87 | (define *running-test* #f) |
87 | 88 | (define *mappings* '()) |
88 | 89 | (define *deploy* #f) |
… |
… |
|
263 | 264 | password: *password* |
264 | 265 | trunk: *trunk* |
265 | 266 | proxy-host: *proxy-host* |
266 | | proxy-port: *proxy-port*) |
| 267 | proxy-port: *proxy-port* |
| 268 | proxy-user-pass: *proxy-user-pass*) |
267 | 269 | [(exn net) |
268 | 270 | (print "TCP connect timeout") |
269 | 271 | (values #f "") ] |
… |
… |
EOF |
622 | 624 | |
623 | 625 | (define (setup-proxy uri) |
624 | 626 | (if (string? uri) |
625 | | (cond ((irregex-match "(.+)\\:([0-9]+)" uri) => |
626 | | (lambda (m) |
627 | | (set! *proxy-host* (irregex-match-substring m 1)) |
628 | | (set! *proxy-port* (string->number (irregex-match-substring m 2)))) |
629 | | (else |
630 | | (set! *proxy-host* uri) |
631 | | (set! *proxy-port* 80)))))) |
| 627 | (begin |
| 628 | (set! *proxy-user-pass* (get-environment-variable "proxy_auth")) |
| 629 | (cond ((irregex-match "(.+)\\:([0-9]+)" uri) => |
| 630 | (lambda (m) |
| 631 | (set! *proxy-host* (irregex-match-substring m 1)) |
| 632 | (set! *proxy-port* (string->number (irregex-match-substring m 2)))) |
| 633 | (else |
| 634 | (set! *proxy-host* uri) |
| 635 | (set! *proxy-port* 80))))))) |
632 | 636 | |
633 | 637 | (define *short-options* '(#\h #\k #\l #\t #\s #\p #\r #\n #\v #\i #\u #\D)) |
634 | 638 | |
diff --git a/setup-download.scm b/setup-download.scm
index 0cfeac6..cf7c497 100644
a
|
b
|
|
219 | 219 | (if m (irregex-match-substring m 5) "/")) ) ) |
220 | 220 | |
221 | 221 | (define (locate-egg/http egg url #!optional version destination tests |
222 | | proxy-host proxy-port) |
| 222 | proxy-host proxy-port proxy-user-pass) |
223 | 223 | (let ([tmpdir (or destination (get-temporary-directory))]) |
224 | 224 | (let-values ([(host port locn) (deconstruct-url url)]) |
225 | 225 | (let ([locn (string-append |
… |
… |
|
230 | 230 | (if tests "&tests=yes" ""))] |
231 | 231 | [eggdir (make-pathname tmpdir egg) ] ) |
232 | 232 | (unless (file-exists? eggdir) (create-directory eggdir)) |
233 | | (http-fetch host port locn eggdir proxy-host proxy-port) |
| 233 | (http-fetch host port locn eggdir proxy-host proxy-port proxy-user-pass) |
234 | 234 | ; If we get here then version of egg exists |
235 | 235 | (values eggdir (or version "")) ) ) ) ) |
236 | 236 | |
… |
… |
|
249 | 249 | (connection "close") |
250 | 250 | (accept "*") |
251 | 251 | (content-length 0) |
252 | | proxy-host proxy-port) |
| 252 | proxy-host proxy-port proxy-user-pass) |
253 | 253 | (conc |
254 | 254 | "GET " |
255 | 255 | (if proxy-host |
… |
… |
|
260 | 260 | "User-Agent: " user-agent "\r\n" |
261 | 261 | "Accept: " accept "\r\n" |
262 | 262 | "Host: " host #\: port "\r\n" |
| 263 | (when proxy-user-pass |
| 264 | (string-append "Proxy-Authorization: Basic " proxy-user-pass "\r\n")) |
263 | 265 | "Content-length: " content-length "\r\n" |
264 | 266 | "\r\n") ) |
265 | 267 | |
… |
… |
|
273 | 275 | (define (match-chunked-transfer-encoding ln) |
274 | 276 | (irregex-match "[Tt]ransfer-[Ee]ncoding:\\s*chunked.*" ln) ) |
275 | 277 | |
276 | | (define (http-fetch host port locn dest proxy-host proxy-port) |
| 278 | (define (http-fetch host port locn dest proxy-host proxy-port proxy-user-pass) |
277 | 279 | (d "connecting to host ~s, port ~a ~a...~%" host port |
278 | 280 | (if proxy-host |
279 | 281 | (sprintf "(via ~a:~a) " proxy-host proxy-port) |
… |
… |
|
291 | 293 | [response-match (match-http-response h1)]) |
292 | 294 | (d "~a~%" h1) |
293 | 295 | ;;*** handle redirects here |
294 | | (unless (response-match-code? response-match 200) |
295 | | (network-failure "invalid response from server" h1) ) |
| 296 | (if (response-match-code? response-match 407) |
| 297 | (begin |
| 298 | (let-values ([(inpx outpx) (tcp-connect proxy-host proxy-port)]) |
| 299 | (set! in inpx) (set! out outpx)) |
| 300 | (display |
| 301 | (make-HTTP-GET/1.1 locn *chicken-install-user-agent* host port: port accept: "*/*" |
| 302 | proxy-host: proxy-host proxy-port: proxy-port |
| 303 | proxy-user-pass: proxy-user-pass) |
| 304 | out)) |
| 305 | (unless (response-match-code? response-match 200) |
| 306 | (network-failure "invalid response from server" h1))) |
296 | 307 | (let loop () |
297 | 308 | (let ([ln (read-line in)]) |
298 | 309 | (unless (string-null? ln) |
… |
… |
|
351 | 362 | |
352 | 363 | (define (retrieve-extension name transport location |
353 | 364 | #!key version quiet destination username password tests |
354 | | proxy-host proxy-port trunk (mode 'default)) |
| 365 | proxy-host proxy-port proxy-user-pass trunk (mode 'default)) |
355 | 366 | (fluid-let ((*quiet* quiet) |
356 | 367 | (*trunk* trunk) |
357 | 368 | (*mode* mode)) |
… |
… |
|
361 | 372 | ((svn) |
362 | 373 | (locate-egg/svn name location version destination username password) ) |
363 | 374 | ((http) |
364 | | (locate-egg/http name location version destination tests proxy-host proxy-port) ) |
| 375 | (locate-egg/http name location version destination tests proxy-host proxy-port proxy-user-pass) ) |
365 | 376 | (else |
366 | 377 | (error "cannot retrieve extension unsupported transport" transport) ) ) ) ) |
367 | 378 | |