From 729fd0ef5d4f78bc86f2a497c06cecbc2b4fa571 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 1 Apr 2021 12:34:02 -0700 Subject: add some properties for setting keys & values in configuration files Signed-off-by: Sean Whitton --- src/package.lisp | 3 + src/property/file.lisp | 229 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 232 insertions(+) diff --git a/src/package.lisp b/src/package.lisp index efce2ee..2294bfd 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -222,6 +222,9 @@ #:host-data-uploaded #:secret-uploaded #:host-secret-uploaded + #:contains-conf-pairs + #:contains-shell-conf + #:contains-ini-settings #:regex-replaced-lines #:directory-exists)) diff --git a/src/property/file.lisp b/src/property/file.lisp index 58c3a03..56009d6 100644 --- a/src/property/file.lisp +++ b/src/property/file.lisp @@ -109,3 +109,232 @@ Uses CL-PPCRE:REGEX-REPLACE, which see for the syntax of REPLACE." (mrun "mkdir" "-p" dir) ;; assume it was already there :no-change)) + + +;;;; Config files + +;; all our actual uses of this so far could avoid traversing the lines of the +;; file more than once if this function instead applied MAP to each line and +;; then just transformed it back right away, but in the future we might want +;; to write functions which operate on the whole set of lines at once +(defun config-file-map + (&key (parse-comment "#") (new-comment "# ") + (parse-section (constantly nil)) (new-section #'identity) + parse-kv new-kv map) + "Return a function suitable for passing to FILE:MAP-FILE-LINES, to modify +the lines of a config file using MAP. MAP is a function from a list of config +file lines to a list of config file lines, except that lines which set values +in the original file will be replaced by lists of the form (COMMENTED SECTION +KEY VALUE), where + + - COMMENTED is a boolean indicating whether the line was commented + - SECTION is the section of the config file in which the line appears + +and KEY and VALUE are the key and value. MAP may return lists of this form +and they will be converted back into strings. + +Other arguments: + +- PARSE-COMMENT is a CL-PPCRE regular expression which, when matched at the + beginning of a line, indicates a comment. It is assumed that it can be + repeated and may be followed by whitespace. + +- NEW-COMMENT is a string to be prepended to lines to comment them out. + +- PARSE-SECTION is a function which returns the name of the section if passed + a line which begins a section of the config file, or nil if the line does + not start a section. It can also be a CL-PPCRE regexp, which should extract + the section name as the first capture group. Lines will be passed to this + function (or matched against this regexp) uncommented. + +- NEW-SECTION is a function which takes a section name and returns a line + (without trailing newline) beginning a new section with that name. + +- PARSE-KV is a function which returns as a cons the key and value set by a + line of the config file, or nil if the line is something else. It can also + be a CL-PPCRE regexp, which should extract the key and value as the first + and second capture groups, respectively. Lines will be passed to this + function (or matched against this regexp) uncommented. + +- NEW-KV is a function of two arguments, a key and a value, which returns an + uncommented line setting the key and value." + (unless (functionp parse-section) + (let ((orig parse-section)) + (setq parse-section (lambda (line) + (multiple-value-bind (match groups) + (re:scan-to-strings orig line) + (when match (elt groups 0))))))) + (unless (functionp parse-kv) + (let ((orig parse-kv)) + (setq parse-kv (lambda (line) + (multiple-value-bind (match groups) + (re:scan-to-strings orig line) + (and match (cons (elt groups 0) (elt groups 1)))))))) + (flet ((uncomment (line) + (multiple-value-list + (re:regex-replace #?/^(?:${parse-comment})+\s*/ line "")))) + (lambda (lines) + (let* ((unmapped + (loop with current-section + for line in lines + for (uncommented commentedp) = (uncomment line) + for (k . v) = (funcall parse-kv uncommented) + for new-section + = (and (not commentedp) + (funcall parse-section uncommented)) + do (setq current-section + (or new-section current-section)) + if (and k v) + collect (list commentedp current-section k v) + else collect line)) + (mapped (funcall map unmapped))) + (loop with current-section + for line in mapped + for line-section = (etypecase line + (cons (cadr line)) + (string (funcall parse-section line))) + + if (and (listp line) + line-section + (not (string= line-section current-section))) + collect "" + and collect (funcall new-section line-section) + and do (setq current-section line-section) + else if (and (stringp line) + line-section + (not (string= line-section current-section))) + do (setq current-section line-section) + + if (listp line) + collect (with-output-to-string (s) + (destructuring-bind (commentedp sec k v) line + (declare (ignore sec)) + (when commentedp (princ new-comment s)) + (princ (funcall new-kv k v) s))) + else collect line))))) + +(defun simple-conf-update (file pairs &rest args) + (let ((keys (make-hash-table :test #'equal))) + (loop for (k v) on pairs by #'cddr + unless (stringp v) + do (simple-program-error + "Values passed are not all strings, or list is not even") + do (setf (gethash k keys) v)) + (map-file-lines + file (apply + #'config-file-map + :map + (lambda (lines) + (let ((new-lines + (loop for line in lines + for key = (and (listp line) (caddr line)) + for val = (and (listp line) (gethash key keys)) + if (eql val :done) + collect (list* t nil (cddr line)) + else if val + collect (list nil nil key val) + and do (setf (gethash key keys) :done) + else collect line))) + (loop for k being the hash-keys in keys using (hash-value v) + unless (eql v :done) + collect (list nil nil k v) into accum + finally (return (nconc new-lines accum))))) + args)))) + +(defprop contains-conf-pairs :posix (file &rest pairs) + "Where FILE is a config file in which keys and values are separated by spaces +and there are no sections, and PAIRS is a list of even length of alternating +keys and values, set each of these keys and values in FILE. + +If there are any other lines which set values for the same keys, they will be +commented out; the first commented or uncommented line for each key will be +uncommented and used to set the value, if it exists." + (:desc (format nil "~A has ~{~A ~A~^, ~}" file pairs)) + (:apply (simple-conf-update file pairs + :parse-kv #?/^(\S+) (.+)/ + :new-kv (lambda (k v) #?"${k} ${v}")))) + +(defprop contains-shell-conf :posix (file &rest pairs) + "Where FILE is a shell config file, like those in /etc/default, and PAIRS is a +list of even length of alternating keys and values, set each of these keys and +values in FILE. + +If there are any other lines which set values for the same keys, they will be +commented out; the first commented or uncommented line for each key will be +uncommented and used to set the value, if it exists." + (:desc (format nil "~A has ~{~A=~S~^, ~}" file pairs)) + (:apply (simple-conf-update file (loop for (k v) on pairs by #'cddr + collect k + collect (escape-sh-token v)) + ;; include quoting as part of the value so we + ;; don't end up substituting double quotation + ;; marks for single, or similar + :parse-kv #?/^(\S+)\s?=\s?(.*)/ + :new-kv (lambda (k v) #?"${k}=${v}")))) + +(defprop contains-ini-settings :posix (file &rest triples) + "Where FILE is an INI file, and each of TRIPLES is a list of three elements, +a section name, key and value, set those keys and values in FILE. Keys +containing '=' are not supported. + +If there are any other lines which set values for the same keys in the same +sections, they will be commented out. The first commented or uncommented line +for each key in its section will be uncommented and used to set the value, if +it exists. + +Some normalisation will be performed: whitespace around the '=' will be +removed, and semicolon comment chars will be replaced with '#'." + (:desc (format nil "~A has ~{~{[~A] ~A = ~A~}~^, ~}" file triples)) + (:apply + (let ((parse-section #?/^\[(.+)\]$/) + (keys (make-hash-table :test #'equal))) + (loop for (s k v) in triples + do (setf (gethash (cons s k) keys) v)) + (map-file-lines + file + (config-file-map + :parse-comment "[#;]" + :parse-section parse-section + :new-section (lambda (s) #?"[${s}]") + :parse-kv #?/^([^=\s]+)\s*=\s*(.*)/ + :new-kv (lambda (k v) #?"${k}=${v}") + :map + (lambda (lines) + (let ((new-lines + (loop with current-section + for line in lines + for sec = (etypecase line + (list (cadr line)) + (string (re:regex-replace + parse-section line #?/\1/))) + and key = (and (listp line) (caddr line)) + for pair = (cons sec key) + for val = (and (listp line) (gethash pair keys)) + + ;; If we've reached a new section insert any + ;; remaining pairs in this section, as that's + ;; better than inserting a new section with the + ;; same name at the end of the file. + if (and sec (not (string= sec current-section))) + nconc (loop for pair being the hash-keys in keys + using (hash-value v) + for (s . k) = pair + when (and (string= current-section s) + (not (eql v :done))) + collect (list nil s k v) + and do (setf (gethash pair keys) :done)) + and do (setq current-section sec) + + if (eql val :done) + collect (cons t (cdr line)) + else if val + collect (list nil sec key val) + and do (setf (gethash pair keys) :done) + else collect line))) + (loop for pair being the hash-keys in keys using (hash-value v) + for (s . k) = pair + unless (eql v :done) + collect (list nil s k v) into accum + finally (return + (nconc new-lines + (sort accum #'string< :key #'cadr))))))))))) -- cgit v1.2.3