~ chicken-core (chicken-5) a08f8f548d772ef410c672ba33a27108d8d434f3

commit a08f8f548d772ef410c672ba33a27108d8d434f3
Author:     Vasilij Schneidermann <mail@vasilij.de>
AuthorDate: Sat Nov 5 13:49:25 2022 +0100
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Thu Nov 10 13:52:23 2022 +0100

    Split up potentially long echo invocation on win32
    
    Eggs with a very long infostr may trigger the maximum command line
    invocation length of 8191 chars. To avoid running into this
    limitation, the generated install script now creates an empty file,
    then echoes each line into it.
    
    Closes #1800
    
    This patch further addresses some security issues reported by Vasilij
    and applied by Felix Winkelmann:
    
    - disable variable/command expansion in script-fragments
      that produce egg-info files.
    - limit the maximum line length of shell commands in for
      Windows in the latter.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/egg-compile.scm b/egg-compile.scm
index c1f2ceb0..9ba45681 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -1129,7 +1129,7 @@ EOF
 
 ~a ~a~a
 ~a ~a~a
-cat >~a~a <<ENDINFO
+cat >~a~a <<'ENDINFO'
 ~aENDINFO~%
 EOF
                mkdir ddir qdir
@@ -1139,11 +1139,18 @@ EOF
        (printf #<<EOF
 
 ~a ~a~a
-echo ~a >~a~a~%
+copy /y nul ~a~a~%
+~a
 EOF
                mkdir ddir qdir
-               (string-intersperse (string-split infostr "\n") "^\n\n")
-               ddir dest)))))
+	       ddir dest
+	       (string-intersperse (map (lambda (line)
+					  (ensure-line-limit
+                                             (caretize (format "echo ~a >>~a~a"
+                                                               line ddir dest))
+                                             8191 ))
+					(string-split infostr "\n"))
+				   "\n"))))))
 
 ;;; some utilities for mangling + quoting
 
@@ -1227,3 +1234,12 @@ EOF
     (substring fname (add1 plen))))
 
 (define (maybe f x) (if f (list x) '()))
+
+(define (caretize str)
+  (string-translate* str '(("&" . "^&") ("^" . "^^") ("|" . "^|")
+			   ("<" . "^<") (">" . "^>"))))
+
+(define (ensure-line-limit str lim)
+  (when (>= (string-length str) lim)
+    (error "line length exceeds platform limit: " str))
+  str)