diff --git a/modules/ordo/util/shell-quote.scm b/modules/ordo/util/shell-quote.scm new file mode 100644 index 0000000..6333264 --- /dev/null +++ b/modules/ordo/util/shell-quote.scm @@ -0,0 +1,53 @@ +;; This file is part of Ordo. +;; +;; Shell quoting implementation is based on Perl's String::ShellQuote +;; Copyright (c) 1997 Roderick Schertler. +;; +;; Guile implementation Copyright (c) 2025 Ray Miller. +;; +;; Ordo is free software: you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation, either version 3 of the License, or (at your option) +;; any later version. +;; +;; Ordo is distributed in the hope that it will be useful, but WITHOUT ANY +;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +;; A PARTICULAR PURPOSE. See the GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along with +;; Ordo. If not, see . + +(define-module (ordo util shell-quote) + #:use-module (rx irregex) + #:use-module ((srfi srfi-197) #:select (chain)) + #:export (shell-quote-string)) + +(define unsafe-characters (irregex '(~ (or alphanumeric ("!%+,\\-./:=@^"))))) + +(define (needs-escape? s) + (irregex-search unsafe-characters s)) + +(define (escape s) + (define (squash-quotes m) + (let ((n (/ (- (irregex-match-end-index m) + (irregex-match-start-index m)) + 4))) + (list->string (append + '(#\' #\") + (make-list n #\') + '(#\" #\'))))) + (chain s + ;; ' -> '\'' + (irregex-replace/all (irregex "'") _ "'\\''") + ;; make multiple ' in a row look simpler + ;; '\'''\'''\'' -> '"'''"' + (irregex-replace/all (irregex '(>= 2 "'\\''")) _ squash-quotes) + ;; wrap in single quotes + (string-append "'" _ "'") + ;; kill leading/trailing pair of single quotes + (irregex-replace (irregex '(seq bos "''")) _ "") + (irregex-replace (irregex '(seq "''" eos)) _ ""))) + +(define (shell-quote-string s) + "Quote strings for passing through the shell" + (if (needs-escape? s) (escape s) s))