From 11d5b22d4eb69696b43e576db3d16793dd166d93 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Fri, 21 Jan 2011 15:02:31 +0100
Subject: [PATCH] Use g_spawn_sync () instead of system ().  Fixes #1429.

Avoid the opening of a DOS box, console window, command window or
power shell during PostScript to PDF conversion on some versions of
Microsoft Windows [with GUB 6976be5 or newer].

Bypass the shell, thus avoiding quoting (think spaces or other special
characters in a file name), mangling and shell-incompatibilities.
---
 lily/general-scheme.cc     |   62 ++++++++++++++++++++++++++++
 lily/include/lily-guile.hh |    2 +-
 lily/lily-guile.cc         |    6 +--
 scm/backend-library.scm    |   98 ++++++++++++++------------------------------
 scm/framework-ps.scm       |    8 ++-
 scm/ps-to-png.scm          |    2 +
 6 files changed, 103 insertions(+), 75 deletions(-)

diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc
index 14ef697..5989350 100644
--- a/lily/general-scheme.cc
+++ b/lily/general-scheme.cc
@@ -23,6 +23,7 @@
 #include <cstdio>
 #include <ctype.h>
 #include <cstring>  /* memset */
+#include <glib.h>
 using namespace std;
 
 #include "dimensions.hh"
@@ -663,3 +664,64 @@ LY_DEFINE (ly_format, "ly:format",
 
   return scm_take_locale_stringn (result, len);
 }
+
+int
+ly_run_command (char *argv[], char **standard_output, char **standard_error)
+{
+  GError *error = 0;
+  int exit_status = 0;
+  int flags = G_SPAWN_SEARCH_PATH;
+  if (!standard_output)
+    flags |= G_SPAWN_STDOUT_TO_DEV_NULL;
+  if (!standard_error)
+    flags |= G_SPAWN_STDERR_TO_DEV_NULL;
+  if (!g_spawn_sync (0, argv, 0, GSpawnFlags (flags),
+		     0, 0, 
+		     standard_output, standard_error,
+		     &exit_status, &error))
+    {
+      fprintf (stderr, "failed (%d): %s: %s\n", exit_status, argv[0], error->message);
+      g_error_free (error);
+      if (!exit_status)
+	exit_status = -1;
+    }
+
+  return exit_status;
+}
+
+LY_DEFINE (ly_spawn, "ly:spawn",
+	   1, 0, 1, (SCM command, SCM rest),
+	   "Simple interface to g_spawn_sync"
+	   " @var{str}."
+	   "  The error is formatted with @code{format} and @var{rest}.")
+
+{
+  LY_ASSERT_TYPE (scm_is_string, command, 1);
+
+  int argc = scm_is_pair (rest) ? scm_ilength (rest) : 0;
+  char **argv = new char*[argc + 2];
+
+  int n = 0;
+  argv[n++] = ly_scm2str0 (command);
+  for (SCM s = rest; scm_is_pair (s); s = scm_cdr (s))
+    argv[n++] = ly_scm2str0 (scm_car (s));
+  argv[n] = 0;
+
+  char *standard_output = 0;
+  char *standard_error = 0;
+  int exit_status = be_verbose_global
+    ? ly_run_command (argv, &standard_output, &standard_error)
+    : ly_run_command (argv, 0, 0);
+
+  if (be_verbose_global)
+    {
+      fprintf (stderr, "\n%s", standard_output);
+      fprintf (stderr, "%s", standard_error);
+    }
+  
+  for (int i = 0; i < n; i++)
+    free (argv[i]);
+  delete[] argv;
+
+  return scm_from_int (exit_status);
+}
diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh
index 6dcc050..3fefd5d 100644
--- a/lily/include/lily-guile.hh
+++ b/lily/include/lily-guile.hh
@@ -66,7 +66,7 @@ Interval ly_scm2interval (SCM);
 Drul_array<Real> ly_scm2realdrul (SCM);
 Slice int_list_to_slice (SCM l);
 SCM ly_interval2scm (Drul_array<Real>);
-char *ly_scm2newstr (SCM str, size_t *lenp);
+char *ly_scm2str0 (SCM str);
 
 Real robust_scm2double (SCM, double);
 int robust_scm2int (SCM, int);
diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index f0ff8ca..1763a5c 100644
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -138,12 +138,10 @@ ly_string2scm (string const &str)
 				  str.length ());
 }
 
-
 char *
-ly_scm2newstr (SCM str, size_t *lenp)
+ly_scm2str0 (SCM str)
 {
-  char* p = scm_to_locale_stringn(str, lenp);
-  return p;
+  return scm_to_locale_string (str);
 }
 
 /*
diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index ec81b2f..f21decd 100644
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -23,23 +23,12 @@
 	     (scm paper-system)
 	     (ice-9 optargs))
 
-(define-public (ly:system command . rest)
-  (let* ((status 0)
-	 (dev-null "/dev/null")
-	 (silenced (if (or (ly:get-option 'verbose)
-			   (not (access? dev-null W_OK)))
-		       command
-		       (format #f "~a > ~a 2>&1 " command dev-null))))
-    (if (ly:get-option 'verbose)
-	(begin
-	  (ly:message (_ "Invoking `~a'...") command))
-	  (ly:progress "\n"))
-
-    (set! status
-	  (if (pair? rest)
-	      (system-with-env silenced (car rest))
-	      (system silenced)))
-	
+(define-public (ly:system command)
+  (if (ly:get-option 'verbose)
+      (begin
+	(ly:message (_ "Invoking `~a'...") (string-join command)))
+      (ly:progress "\n"))
+  (let ((status (apply ly:spawn command)))
     (if (> status 0)
 	(begin
 	  (ly:message (_ "`~a' failed (~a)") command status)
@@ -47,22 +36,6 @@
 	  ;; hmmm.  what's the best failure option? 
 	  (throw 'ly-file-failed)))))
 
-(define-public (system-with-env cmd env)
-
-  "Execute CMD in fork, with ENV (a list of strings) as the environment"
-  (let*
-      ;; laziness: should use execle?
-      
-      ((pid (primitive-fork)))
-    (if (= 0 pid)
-	;; child
-	(begin
-	  (environ env)
-	  (system cmd))
-	
-	;; parent
-	(cdr (waitpid pid)))))
-
 (define-public (sanitize-command-option str)
   "Kill dubious shell quoting"
   
@@ -91,41 +64,32 @@
 		    (dir-basename name ".ps" ".eps")
 		    ".pdf"))
 	 (is-eps (string-match "\\.eps$" name))
-	 (paper-size-string (if is-eps
-				"-dEPSCrop"
-				(ly:format "-dDEVICEWIDTHPOINTS=~$\
- -dDEVICEHEIGHTPOINTS=~$"
-					paper-width paper-height)))
-
-	 (cmd (ly:format
-		      "~a\
- ~a\
- ~a\
- ~a\
- -dCompatibilityLevel=1.4\
- -dNOPAUSE\
- -dBATCH\
- -r1200\
- -sDEVICE=pdfwrite\
- -sOutputFile=~S\
- -c .setpdfwrite\
- -f ~S\
-"
-		      (search-gs)
-		      (if (ly:get-option 'verbose) "" "-q")
-		      (if (or (ly:get-option 'gs-load-fonts)
-			      (ly:get-option 'gs-load-lily-fonts))
-			  "-dNOSAFER"
-			  "-dSAFER")
-		      paper-size-string
-		      pdf-name
-		      name)))
-    ;; The wrapper on windows cannot handle `=' signs,
-    ;; gs has a workaround with #.
-    (if (eq? PLATFORM 'windows)
-	(begin
-	  (set! cmd (string-regexp-substitute "=" "#" cmd))
-	  (set! cmd (string-regexp-substitute "-dSAFER " "" cmd))))
+	 (*unspecified* (if #f #f))
+	 (cmd
+	  (remove (lambda (x) (eq? x *unspecified*))
+	  (list
+	       (search-gs)
+	       (if (ly:get-option 'verbose) *unspecified* "-q")
+	       (if (or (ly:get-option 'gs-load-fonts)
+		       (ly:get-option 'gs-load-lily-fonts)
+		       (eq? PLATFORM 'windows))
+		   "-dNOSAFER"
+		   "-dSAFER")
+
+	       (if is-eps
+		   "-dEPSCrop"
+		   (ly:format "-dDEVICEWIDTHPOINTS=~$" paper-width))
+	       (if is-eps
+		   *unspecified*
+		   (ly:format "-dDEVICEHEIGHTPOINTS=~$" paper-height))
+	       "-dCompatibilityLevel=1.4"
+	       "-dNOPAUSE"
+	       "-dBATCH"
+	       "-r1200"
+	       "-sDEVICE=pdfwrite"
+	       (string-append "-sOutputFile=" pdf-name)
+	       "-c.setpdfwrite"
+	       (string-append "-f" name)))))
 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index b79c1a3..c4d1d01 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -267,10 +267,12 @@
     (let* ((dir-name (tmpnam))
 	   (files '())
 	   (status 0)
-	   (embed #f))
+	   (embed #f)
+	   (cwd (getcwd)))
       (mkdir dir-name #o700)
-      (set! status (ly:system
-		    (format "cd ~a && fondu -force '~a'" dir-name filename)))
+      (chdir dir-name)
+      (set! status (ly:system (list "fondu" "-force" file-name)))
+      (chdir cwd)
       (set! files (dir-listing dir-name))
       (for-each
        (lambda (f)
diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 4436ea3..17f8222 100644
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -27,6 +27,8 @@
  (lily)
  )
 
+;; FIXME: use backend-library for duplicates and stubs; lilypond-ps2png.scm is no more
+
 (define-public _ gettext)
 
 (define PLATFORM
-- 
1.7.1