Re: [Chicken-hackers] [PATCH] qs

[Felix]

Hello!

SorrySorrySorry.

Here is the patch by sjamaan, which seems to work now.
I have messed around with git again, so the patch might
be rejected, but should nevertheless apply.


cheers,
felix

From 2abfc2fd1f9b3979791a1b1db2aa5f206c673a20 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Tue, 16 Apr 2013 23:30:29 +0200
Subject: [PATCH 1/2] qs uses single quotes instead of backslashing by
 blacklist - thanks to Florian Zumbiehl and sjamaan

---
 NEWS          |    3 +++
 setup-api.scm |    2 +-
 utils.scm     |   26 ++++++++++++--------------
 3 files changed, 16 insertions(+), 15 deletions(-)

diff --git a/NEWS b/NEWS
index b013a84..b81e8b9 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,9 @@
   - CVE-2013-1874: ./.csirc is no longer loaded from the current directory
     upon startup of csi, which could lead to untrusted code execution.
     (thanks to Florian Zumbiehl)
+  - On *nix, the qs procedure now single-quotes everything instead of relying
+    on a blacklist of shell characters to be escaped.  On Windows, it properly
+    duplicates double-quote characters.  (thanks to Florian Zumbiehl)
 
 - Tools
   - csc: added "-oi"/"-ot" options as alternatives to "-emit-inline-file"
diff --git a/setup-api.scm b/setup-api.scm
index 9309ca8..7370b56 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -237,7 +237,7 @@
   (cond ((string=? prg "csc")
         (string-intersperse 
          (cons*
-          (shellpath (find-program "csc"))
+          (find-program "csc")
           "-feature" "compiling-extension" 
           (if (or (deployment-mode)
                   (and (feature? #:cross-chicken)
diff --git a/utils.scm b/utils.scm
index 94417fc..77ccf56 100644
--- a/utils.scm
+++ b/utils.scm
@@ -59,20 +59,18 @@
 ;;; Quote string for shell
 
 (define (qs str #!optional (platform (build-platform)))
-  (case platform
-    ((mingw32)
-     (string-append "\"" str "\""))
-    (else
-     (if (zero? (string-length str))
-        "''"
-        (string-concatenate
-         (map (lambda (c)
-                (if (or (char-whitespace? c)
-                        (memq c '(#\# #\" #\' #\` #\´ #\~ #\& #\% #\$ #\! #\* 
#\;
-                                  #\< #\> #\\ #\( #\) #\[ #\] #\{ #\} #\? 
#\|)))
-                    (string #\\ c)
-                    (string c)))
-              (string->list str)))))))
+  (let ((delim (if (eq? platform 'mingw32) #\" #\'))
+       (escaped (if (eq? platform 'mingw32) "\"\"" "'\\''")))
+    (string-append
+     (string delim)
+     (string-concatenate
+      (map (lambda (c)
+            (cond
+             ((char=? c delim) escaped)
+             ((char=? c #\nul) (error 'qs "NUL character can not be 
represented in shell string" str))
+             (else (string c))))
+          (string->list str)))
+     (string delim))))
 
 
 ;;; Compile and load file
-- 
1.7.9.5