code.delx.au - gnu-emacs-elpa/blob - packages/shell-quasiquote/shell-quasiquote.el

   1 ;;; shell-quasiquote.el --- Turn s-expressions into shell command strings.
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
   6 ;; Keywords: extensions, unix
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; "Shell quasiquote" -- turn s-expressions into POSIX shell command strings.
  24 ;;
  25 ;; Shells other than POSIX sh are not supported.
  26 ;;
  27 ;; Quoting is automatic and safe against injection.
  28 ;;
  29 ;;   (let ((file1 "file one")
  30 ;;         (file2 "file two"))
  31 ;;     (shqq (cp -r ,file1 ,file2 "My Files")))
  32 ;;       => "cp -r 'file one' 'file two' 'My Files'"
  33 ;;
  34 ;; You can splice many arguments into place with ,@foo.
  35 ;;
  36 ;;   (let ((files (list "file one" "file two")))
  37 ;;     (shqq (cp -r ,@files "My Files")))
  38 ;;       => "cp -r 'file one' 'file two' 'My Files'"
  39 ;;
  40 ;; Note that the quoting disables a variety of shell expansions like ~/foo,
  41 ;; $ENV_VAR, and e.g. {x..y} in GNU Bash.
  42 ;;
  43 ;; You can use ,,foo to escape the quoting.
  44 ;;
  45 ;;   (let ((files "file1 file2"))
  46 ;;     (shqq (cp -r ,,files "My Files")))
  47 ;;       => "cp -r file1 file2 'My Files'"
  48 ;;
  49 ;; And ,,@foo to splice and escape quoting.
  50 ;;
  51 ;;   (let* ((arglist '("-x 'foo bar' -y baz"))
  52 ;;          (arglist (append arglist '("-z 'qux fux'"))))
  53 ;;     (shqq (command ,,@arglist)))
  54 ;;       => "command -x 'foo bar' -y baz -z 'qux fux'"
  55 ;;
  56 ;; Neat, eh?
  57
  58 \f
  59 ;;; Code:
  60
  61 ;;; We don't use `shell-quote-argument' because it doesn't provide any safety
  62 ;;; guarantees, and this quotes shell keywords as well.
  63 (defun shqq--quote-string (string)
  64   (concat "'" (replace-regexp-in-string "'" "'\\\\''" string) "'"))
  65
  66 (defun shqq--atom-to-string (atom)
  67   (cond
  68    ((symbolp atom) (symbol-name atom))
  69    ((stringp atom) atom)
  70    ((numberp atom) (number-to-string atom))
  71    (t (error "Bad shqq atom: %S" atom))))
  72
  73 (defun shqq--quote-atom (atom)
  74   (shqq--quote-string (shqq--atom-to-string atom)))
  75
  76 (defun shqq--match-comma (form)
  77   "Matches FORM against ,foo i.e. (\, foo) and returns foo.
  78 Returns nil if FORM didn't match.  You can't disambiguate between
  79 FORM matching ,nil and not matching."
  80   (if (and (consp form)
  81            (eq '\, (car form))
  82            (consp (cdr form))
  83            (null (cddr form)))
  84       (cadr form)))
  85
  86 (defun shqq--match-comma2 (form)
  87   "Matches FORM against ,,foo i.e. (\, (\, foo)) and returns foo.
  88 Returns nil if FORM didn't match.  You can't disambiguate between
  89 FORM matching ,,nil and not matching."
  90   (if (and (consp form)
  91            (eq '\, (car form))
  92            (consp (cdr form))
  93            (null (cddr form)))
  94       (shqq--match-comma (cadr form))))
  95
  96 \f
  97 (defmacro shqq (parts)
  98   "First, PARTS is turned into a list of strings.  For this,
  99 every element of PARTS must be one of:
 100
 101 - a symbol, evaluating to its name,
 102
 103 - a string, evaluating to itself,
 104
 105 - a number, evaluating to its decimal representation,
 106
 107 - \",expr\", where EXPR must evaluate to an atom that will be
 108   interpreted according to the previous rules,
 109
 110 - \",@list-expr\", where LIST-EXPR must evaluate to a list whose
 111   elements will each be interpreted like the EXPR in an \",EXPR\"
 112   form, and spliced into the list of strings,
 113
 114 - \",,expr\", where EXPR is interpreted like in \",expr\",
 115
 116 - or \",,@expr\", where EXPR is interpreted like in \",@expr\".
 117
 118 In the resulting list of strings, all elements except the ones
 119 resulting from \",,expr\" and \",,@expr\" forms are quoted for
 120 shell grammar.
 121
 122 Finally, the resulting list of strings is concatenated with
 123 separating spaces."
 124   (let ((parts
 125          (mapcar
 126           (lambda (part)
 127             (cond
 128              ((atom part) (shqq--quote-atom part))
 129              ;; We use the match-comma helpers because pcase can't match ,foo.
 130              (t (pcase part
 131                   ;; ,,foo i.e. (, (, foo))
 132                   ((pred shqq--match-comma2)
 133                    (shqq--match-comma2 part))
 134                   ;; ,,@foo i.e. (, (,@ foo))
 135                   ((and (pred shqq--match-comma)
 136                         (let `,@,form (shqq--match-comma part)))
 137                    `(mapconcat #'identity ,form " "))
 138                   ;; ,foo
 139                   ;; Insert redundant 'and x' to work around debbugs#18554.
 140                   ((and x (pred shqq--match-comma))
 141                    `(shqq--quote-atom ,(shqq--match-comma part)))
 142                   ;; ,@foo
 143                   (`,@,form
 144                    `(mapconcat #'shqq--quote-atom ,form " "))
 145                   (_
 146                    (error "Bad shqq part: %S" part))))))
 147           parts)))
 148     `(mapconcat #'identity (list ,@parts) " ")))
 149
 150 (provide 'shell-quasiquote)
 151 ;; Local Variables:
 152 ;; coding: utf-8
 153 ;; End:
 154 ;;; shell-quasiquote.el ends here