From da2b5d0cbe5b67ea120b5d9157a64ee2eb3fe164 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 15 Sep 2019 15:52:01 +0200
Subject: [PATCH 1/2] Fix egg-download response handling

There were two issues:

- The check for 200 "OK" was nested inside the 407 code handling,
  which meant we would misinterpret error HTML pages as egg contents.
- The code which handled 407 "Proxy Authentication Required" would
  simply send a new request without reading the response headers
  correctly.
---
 NEWS             |  2 ++
 egg-download.scm | 59 ++++++++++++++++++++++++------------------------
 2 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/NEWS b/NEWS
index 5642c85b..9b71bd35 100644
--- a/NEWS
+++ b/NEWS
@@ -42,6 +42,8 @@
   - The new "-module-registration" options causes module registration
     code to always be included in the program, even when it has also
     been emitted as a separate file (for example with "-J").
+  - chicken-install now correctly checks server response code to avoid
+    interpreting error response bodies (like 404, 500) as Scheme code.
 
 
 5.1.0
diff --git a/egg-download.scm b/egg-download.scm
index 0839ad83..15dddbbd 100644
--- a/egg-download.scm
+++ b/egg-download.scm
@@ -66,10 +66,10 @@
          ""))
   (let-values (((in out)
                   (tcp-connect (or proxy-host host) (or proxy-port port))))
-    (d "requesting ~s ...~%" locn)
-    (let ((req (make-HTTP-GET/1.1 locn user-agent host 
-                        port: port accept: "*/*"
-			proxy-host: proxy-host proxy-port: proxy-port)))
+    (let next-req ((req (make-HTTP-GET/1.1 locn user-agent host
+                         port: port accept: "*/*"
+			 proxy-host: proxy-host proxy-port: proxy-port)))
+      (d "requesting ~s ...~%" locn)
       (display req out)
       (flush-output out)
       (d "reading response ...~%")
@@ -79,32 +79,31 @@
              (response-match (match-http-response h1)))
         (d "~a~%" h1)
         ;;XXX handle redirects here
-        (if (response-match-code? response-match 407)
-            (let-values (((inpx outpx) (tcp-connect proxy-host proxy-port)))
-	      (set! in inpx) (set! out outpx)
-	      (display
-	        (make-HTTP-GET/1.1 
-		  locn user-agent host port: port 
-                  accept: "*/*"
-		  proxy-host: proxy-host proxy-port: proxy-port 
-		  proxy-user-pass: proxy-user-pass)
-		out)
-	      (unless (response-match-code? response-match 200)
-		(network-failure "invalid response from server" h1)))
-	    (let loop ()
-    	      (let ((ln (read-line in)))
-	        (unless (equal? ln "")
-		  (cond ((match-chunked-transfer-encoding ln)
-                         (set! chunked #t))
-                        ((match-content-length ln) =>
-                         (lambda (sz) (set! datalen sz))))
-		  (d "~a~%" ln)
-		  (loop) ) ) ) )
-	(when chunked
-	  (d "reading chunks ")
-	  (let ((data (read-chunks in)))
-	    (close-input-port in)
-	    (set! in (open-input-string data))) )
+        (cond
+	 ((response-match-code? response-match 407)
+          (let-values (((inpx outpx) (tcp-connect proxy-host proxy-port)))
+	    (set! in inpx) (set! out outpx)
+	    (next-req (make-HTTP-GET/1.1
+		       locn user-agent host port: port
+		       accept: "*/*"
+		       proxy-host: proxy-host proxy-port: proxy-port
+		       proxy-user-pass: proxy-user-pass))))
+	 ((response-match-code? response-match 200)
+	  (let loop ()
+    	    (let ((ln (read-line in)))
+	      (unless (equal? ln "")
+		(cond ((match-chunked-transfer-encoding ln)
+                       (set! chunked #t))
+                      ((match-content-length ln) =>
+                       (lambda (sz) (set! datalen sz))))
+		(d "~a~%" ln)
+		(loop) ) ) )
+	  (when chunked
+	    (d "reading chunks ")
+	    (let ((data (read-chunks in)))
+	      (close-input-port in)
+	      (set! in (open-input-string data))) ))
+	 (else (network-failure "invalid response from server" h1)))
         (values in out datalen)))))
 
 (define (http-retrieve-files in out dest)
-- 
2.20.1