ssh/popen: Change API to match "open-pipe*"

Change (ssh popen) procedures to make their behavior match the behavior of
"open-pipe*" procedure.

Reported by graywolf in
<#39>

* modules/ssh/popen.scm (string-replace-substring): New procedure.
(shell-quote): New procedure.
(open-remote-pipe*, open-remote-input-pipe*, open-remote-output-pipe*): Use
"shell-quote" to quote arguments to make procedures behavior match the
"open-pipe*" behavior.
* tests/common.scm (start-server/exec): Update.
* NEWS: Update.

NEWS

@@ -8,6 +8,18 @@ Copyright (C) Artyom V. Poptsov <[email protected]>
   notice and this notice are preserved.
 
 * Unreleased
+** Change =(ssh popen)= procedures behavior                     :API_CHANGE:
+Now the following procedures handle the program arguments the same way as
+=open-pipe*= procedure. This also makes the their behavior match the
+description from the Guile-SSH documentation.
+
+This change affects the following procedures from =(ssh popen)=:
+- =open-remote-pipe*=
+- =open-remote-input-pipe*=
+- =open-remote-output-pipe*=
+
+Reported by graywolf in
+<https://github.com/artyom-poptsov/guile-ssh/issues/39>
 ** New simplified version of the project logo
 Thanks to Darya Sev. <[email protected]> for very helpful design advices for the
 new simplified version of the project logo.

modules/ssh/popen.scm

@@ -1,6 +1,6 @@
 ;;; popen.scm -- Remote popen emulation.
 
-;; Copyright (C) 2015, 2016 Artyom V. Poptsov <[email protected]>
+;; Copyright (C) 2015-2024 Artyom V. Poptsov <[email protected]>
 ;;
 ;; This file is a part of Guile-SSH.
 ;;
@@ -55,6 +55,43 @@
 
 (define OPEN_PTY "t")
 
+
+;; This procedure is taken from GNU Guile 3.0.0.
+;;
+;; Original comment:
+;;
+;; string-replace-substring By A. Wingo in
+;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html
+;; also in string-replace-substring guix:guix/utils.scm.
+
+(define (string-replace-substring str substring replacement)
+  "Return a new string where every instance of @var{substring} in string
+   @var{str} has been replaced by @var{replacement}. For example:
+
+   @lisp
+   (string-replace-substring \"a ring of strings\" \"ring\" \"rut\")
+   @result{} \"a rut of struts\"
+   @end lisp
+   "
+  (let ((sublen (string-length substring)))
+    (with-output-to-string
+      (lambda ()
+        (let lp ((start 0))
+          (cond
+           ((string-contains str substring start)
+            => (lambda (end)
+                 (display (substring/shared str start end))
+                 (display replacement)
+                 (lp (+ end sublen))))
+           (else
+            (display (substring/shared str start)))))))))
+
+
+
+(define (shell-quote s)
+  "Quote string S for sh-compatible shells."
+  (string-append "'" (string-replace-substring s "'" "'\\''") "'"))
+
 (define (open-remote-pipe session command mode)
   "Execute a COMMAND on the remote host using a SESSION with a pipe to it.
 Returns newly created channel port with the specified MODE."
@@ -70,7 +107,10 @@ Returns newly created channel port with the specified MODE."
 (define (open-remote-pipe* session mode prog . args)
   "Execute a PROG with optional ARGS on the remote host using a SESSION with a
 pipe to it.  Returns newly created channel port with the specified MODE."
-  (open-remote-pipe session (string-join (cons prog args)) mode))
+  (open-remote-pipe session
+                    (string-join (cons (shell-quote prog)
+                                       (map shell-quote args)))
+                    mode))
 
 
 (define (open-remote-input-pipe session command)
@@ -81,7 +121,10 @@ Returns newly created input channel port."
 (define (open-remote-input-pipe* session prog . args)
   "Execute a PROG with optional ARGS on the remote host using a SESSION with
 an input pipe to it.  Returns newly created input channel port."
-  (open-remote-pipe session (string-join (cons prog args)) OPEN_READ))
+  (open-remote-pipe session
+                    (string-join (cons (shell-quote prog)
+                                       (map shell-quote args)))
+                    OPEN_READ))
 
 
 (define (open-remote-output-pipe session command)
@@ -92,6 +135,9 @@ Returns newly created input channel port."
 (define (open-remote-output-pipe* session prog . args)
   "Execute a PROG with optional ARGS on the remote host using a SESSION with
 an output pipe to it.  Returns newly created output channel port."
-  (open-remote-pipe session (string-join (cons prog args)) OPEN_WRITE))
+  (open-remote-pipe session
+                    (string-join (cons (shell-quote prog)
+                                       (map shell-quote args)))
+                    OPEN_WRITE))
 
 ;;; popen.scm ends here.

tests/common.scm

@@ -1,6 +1,6 @@
 ;;; common.scm -- Heper procedures and macros for tests.
 
-;; Copyright (C) 2015-2021 Artyom V. Poptsov <[email protected]>
+;; Copyright (C) 2015-2024 Artyom V. Poptsov <[email protected]>
 ;;
 ;; This file is a part of Guile-SSH.
 ;;
@@ -427,9 +427,9 @@ scheme@(guile-user)> ")
   (define (state:message-handle-exec message session)
       (format-log/scm 'nolog "start-server/exec" "state:message-handle-exec: message: ~A" message)
     (let ((command (exec-req:cmd (message-get-req message))))
-      (format-log/scm 'nolog "start-server/exec" "command: ~A" command)
+      (format-log/scm 'nolog "start-server/exec" "command: ~S" command)
       (cond
-       ((string=? command "ping")
+       ((or (string=? command "'ping'") (string=? command "ping"))
         (message-reply-success message)
         (channel-request-send-exit-status *channel* 0)
         (write-line "pong" *channel*)
@@ -438,7 +438,8 @@ scheme@(guile-user)> ")
             (channel-send-eof *channel*))
           (lambda args
             (format-log/scm 'nolog "start-server/exec" "ERROR: ~a" args))))
-       ((string=? command "uname") ; For exit status testing
+       ((or (string=? command "'uname'") (string=? command "uname"))
+        ;; For exit status testing
         (body session message *channel*))
        ((string=? command "exit status") ; For exit status testing
         (message-reply-success message)
@@ -466,7 +467,7 @@ scheme@(guile-user)> ")
         (channel-request-send-exit-status *channel* 0)
         (channel-send-eof *channel*))
 
-       ((string=? command "guile -q")
+       ((or (string=? command "'guile -q'") (string=? command "'guile' '-q'"))
         (message-reply-success message)
         (display %guile-version-string *channel*)
         (body session message *channel*))