From 8fa41a15f184660ab5bda5f86d645ba9b2582389 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 16 Mar 2023 11:56:31 -0700 Subject: support indented heredocs, add new "Reader macros" manual section Signed-off-by: Sean Whitton --- src/property/apt.lisp | 12 ++++---- src/property/sbuild.lisp | 18 ++++++------ src/property/schroot.lisp | 30 ++++++++++---------- src/reader.lisp | 72 ++++++++++++++++++++++++++++++++++++++--------- src/util.lisp | 31 -------------------- 5 files changed, 88 insertions(+), 75 deletions(-) (limited to 'src') diff --git a/src/property/apt.lisp b/src/property/apt.lisp index f7a258e..11367d2 100644 --- a/src/property/apt.lisp +++ b/src/property/apt.lisp @@ -209,12 +209,12 @@ packages. Does not do any automatic upgrades." (:desc "apt periodic updates") (:hostattrs (os:required 'os:debianlike)) (:apply - (file:has-content "/etc/apt/apt.conf.d/02periodic" -#>EOF>APT::Periodic::Enable "1"; -APT::Periodic::Update-Package-Lists "1"; -APT::Periodic::Download-Upgradeable-Packages "1"; -APT::Periodic::Verbose "1"; -EOF)) + (file:has-content "/etc/apt/apt.conf.d/02periodic" #>>~EOF>> + APT::Periodic::Enable "1"; + APT::Periodic::Update-Package-Lists "1"; + APT::Periodic::Download-Upgradeable-Packages "1"; + APT::Periodic::Verbose "1"; + EOF)) (:unapply (file:does-not-exist "/etc/apt/apt.conf.d/02periodic"))) diff --git a/src/property/sbuild.lisp b/src/property/sbuild.lisp index 297e836..9a0eca6 100644 --- a/src/property/sbuild.lisp +++ b/src/property/sbuild.lisp @@ -123,17 +123,17 @@ To take advantage of the piuparts and autopkgtest support, add to your (file:contains-lines "/etc/schroot/sbuild/fstab" "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0")) ;; Script from . - (file:has-content "/var/cache/ccache-sbuild/sbuild-setup" -#>EOF>#!/bin/sh + (file:has-content "/var/cache/ccache-sbuild/sbuild-setup" #>>~EOF>> + #!/bin/sh -export CCACHE_DIR=/var/cache/ccache-sbuild -export CCACHE_UMASK=002 -export CCACHE_COMPRESS=1 -unset CCACHE_HARDLINK -export PATH="/usr/lib/ccache:$PATH" + export CCACHE_DIR=/var/cache/ccache-sbuild + export CCACHE_UMASK=002 + export CCACHE_COMPRESS=1 + unset CCACHE_HARDLINK + export PATH="/usr/lib/ccache:$PATH" -exec "$@" -EOF :mode #o755) + exec "$@" + EOF :mode #o755) ;; schroot (chroot:os-bootstrapped-for ,chroot-options ,chroot ,host) diff --git a/src/property/schroot.lisp b/src/property/schroot.lisp index e528f10..3601c45 100644 --- a/src/property/schroot.lisp +++ b/src/property/schroot.lisp @@ -44,22 +44,22 @@ Implicitly sets SCHROOT:USES-OVERLAYS. Shell script from ." (:desc "schroot overlays in tmpfs") (:hostattrs (push-hostattr 'uses-overlays t)) - (:apply (file:has-content "/etc/schroot/setup.d/04tmpfs" -#>EOF>#!/bin/sh + (:apply + (file:has-content "/etc/schroot/setup.d/04tmpfs" #>>~EOF>> + #!/bin/sh -set -e + set -e -. "$SETUP_DATA_DIR/common-data" -. "$SETUP_DATA_DIR/common-functions" -. "$SETUP_DATA_DIR/common-config" + . "$SETUP_DATA_DIR/common-data" + . "$SETUP_DATA_DIR/common-functions" + . "$SETUP_DATA_DIR/common-config" - -if [ $STAGE = "setup-start" ]; then - mount -t tmpfs overlay /var/lib/schroot/union/overlay -elif [ $STAGE = "setup-recover" ]; then - mount -t tmpfs overlay /var/lib/schroot/union/overlay -elif [ $STAGE = "setup-stop" ]; then - umount -f /var/lib/schroot/union/overlay -fi -EOF :mode #o755)) + if [ $STAGE = "setup-start" ]; then + mount -t tmpfs overlay /var/lib/schroot/union/overlay + elif [ $STAGE = "setup-recover" ]; then + mount -t tmpfs overlay /var/lib/schroot/union/overlay + elif [ $STAGE = "setup-stop" ]; then + umount -f /var/lib/schroot/union/overlay + fi + EOF :mode #o755)) (:unapply (file:does-not-exist "/etc/schroot/setup.d/04tmpfs"))) diff --git a/src/reader.lisp b/src/reader.lisp index e4f15b9..f744fa4 100644 --- a/src/reader.lisp +++ b/src/reader.lisp @@ -1,6 +1,6 @@ ;;; Consfigurator -- Lisp declarative configuration management system -;;; Copyright (C) 2021 Sean Whitton +;;; Copyright (C) 2021, 2023 Sean Whitton ;;; This file is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -17,20 +17,64 @@ (in-package :consfigurator) +(defun lines (text &optional trimfun (trimchars '(#\Space #\Tab))) + (with-input-from-string (stream text) + (let (bolp buffer) + (flet ((trim (line) + (if trimfun (funcall trimfun trimchars line) line)) + (reset () + (setq bolp t + buffer (make-array 0 :fill-pointer 0 + :element-type 'character)))) + ;; Split on either , or ; would mean split + ;; with a blank line in between. Drop a single trailing blank line. + (loop initially (reset) + for char = (read-char stream nil nil) + if char + if (member char '(#\Return #\Newline) :test #'char=) + collect (trim buffer) + and do (reset) + (when (char= char #\Return) + (when-let ((next (peek-char nil stream nil nil))) + (when (char= next #\Newline) + (read-char stream)))) + else do (setq bolp nil) + (vector-push-extend char buffer) + end + else + unless bolp collect (trim buffer) end + and do (loop-finish)))))) + +(defun unlines (lines) + (format nil "~{~A~%~}" lines)) + (defun read-heredoc (stream char arg) - "Like CL-HEREDOC:READ-HEREDOC but treat #>EOF> and #>>EOF>> differently: -#>>EOF>> skips over the remainder of the current line and its newline. -For the sake of future extension, the remainder of the line after the #>>EOF>> -should not contain anything other than a single-line comment." - (if (char= (peek-char nil stream t :eof t) char) - ;; #>>EOF>> -- ignore the rest of the line. - (progn (read-char stream t :eof t) - (let* ((delim (make-string 2 :initial-element char)) - (ender (cl-heredoc:read-until-match stream delim))) - (read-line stream t :eof t) - (cl-heredoc:read-until-match stream ender))) - ;; #>EOF> -- just use the normal READ-HEREDOC. - (cl-heredoc:read-heredoc stream char arg))) + "Like CL-HEREDOC:READ-HEREDOC, with some additional features. + +Treat #>EOF> and #>>EOF>> differently: #>>EOF>> skips over the remainder of +the current line and its newline. For the sake of future extension, the +remainder of the line after the #>>EOF>> must not contain anything other than +a single-line comment. + +Preceding the specification of the terminating string with a tilde means an +indented heredoc; see perlop(1)." + (declare (ignore arg)) + (let* ((>> (and (char= char (peek-char nil stream t :eof t)) + (read-char stream t :eof t))) + (indented (and (char= #\~ (peek-char nil stream t :eof t)) + (read-char stream t :eof t))) + (delim (if >> (make-string 2 :initial-element char) (string char))) + (ender (cl-heredoc:read-until-match stream delim))) + (when >> + (read-line stream t :eof t)) + (let ((heredoc (cl-heredoc:read-until-match stream ender))) + (if indented + (loop with lines = (lines heredoc) + with indent = (length (lastcar lines)) + for (line . rest) on lines while rest + collect (subseq line (min indent (length line))) into accum + finally (return (unlines accum))) + heredoc)))) (named-readtables:defreadtable :consfigurator (:merge :standard) diff --git a/src/util.lisp b/src/util.lisp index 47ce5ac..20a3714 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -38,37 +38,6 @@ for result in new and i upfrom 0 do (setf (aref results i) (nreconc result (aref results i)))))) -(defun lines (text &optional trimfun (trimchars '(#\Space #\Tab))) - (with-input-from-string (stream text) - (let (bolp buffer) - (flet ((trim (line) - (if trimfun (funcall trimfun trimchars line) line)) - (reset () - (setq bolp t - buffer (make-array 0 :fill-pointer 0 - :element-type 'character)))) - ;; Split on either , or ; would mean split - ;; with a blank line in between. Drop a single trailing blank line. - (loop initially (reset) - for char = (read-char stream nil nil) - if char - if (member char '(#\Return #\Newline) :test #'char=) - collect (trim buffer) - and do (reset) - (when (char= char #\Return) - (when-let ((next (peek-char nil stream nil nil))) - (when (char= next #\Newline) - (read-char stream)))) - else do (setq bolp nil) - (vector-push-extend char buffer) - end - else - unless bolp collect (trim buffer) end - and do (loop-finish)))))) - -(defun unlines (lines) - (format nil "~{~A~%~}" lines)) - (defun words (text) (delete "" (split-string text) :test #'string=)) -- cgit v1.2.3