diff --git a/.github/FUNDING.yml b/.github/FUNDING.yml
new file mode 100644
index 0000000..f27f198
--- /dev/null
+++ b/.github/FUNDING.yml
@@ -0,0 +1 @@
+github: thodg
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
index 0000000..0535628
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,591 @@
+# Adams license information
+
+Adams - UNIX system administration tool written in Common Lisp
+Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+
+
+## Adams dependencies license information
+
+### SBCL
+
+Steel Bank Common Lisp (SBCL) is free software, and comes with
+absolutely no warranty.
+
+SBCL is derived from CMU CL, which was released into the public
+domain, subject only to the BSD-style "free, but credit must be given
+and copyright notices must be retained" licenses in the LOOP macro
+(from MIT and Symbolics) and in the PCL implementation of CLOS (from
+Xerox).
+
+After CMU CL was released into the public domain, it was maintained by
+volunteers, who continued the tradition of releasing their work into
+the public domain.
+
+All changes to SBCL since the fork from CMU CL have been released into
+the public domain in jurisdictions where this is possible, or under
+the FreeBSD licence where not.
+
+The CityHash mix function as adapted in hopscotch.c has an MIT license.
+
+Thus, there are no known obstacles to copying, using, and modifying
+SBCL freely, as long as copyright notices of MIT, Symbolics, Xerox and
+Gerd Moellmann are retained.
+
+Portions of LOOP are Copyright (c) 1986 by the Massachusetts Institute
+of Technology. All Rights Reserved.
+
+Permission to use, copy, modify and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the M.I.T. copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation. The names "M.I.T." and "Massachusetts
+Institute of Technology" may not be used in advertising or publicity
+pertaining to distribution of the software without specific, written
+prior permission. Notice must be given in supporting documentation that
+copying distribution is by permission of M.I.T. M.I.T. makes no
+representations about the suitability of this software for any purpose.
+It is provided "as is" without express or implied warranty.
+
+ Massachusetts Institute of Technology
+ 77 Massachusetts Avenue
+ Cambridge, Massachusetts 02139
+
+Portions of LOOP are Copyright (c) 1989, 1990, 1991, 1992 by Symbolics,
+Inc. All Rights Reserved.
+
+Permission to use, copy, modify and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the Symbolics copyright notice appear in all copies and
+that both that copyright notice and this permission notice appear in
+supporting documentation. The name "Symbolics" may not be used in
+advertising or publicity pertaining to distribution of the software
+without specific, written prior permission. Notice must be given in
+supporting documentation that copying distribution is by permission of
+Symbolics. Symbolics makes no representations about the suitability of
+this software for any purpose. It is provided "as is" without express
+or implied warranty.
+
+Symbolics, CLOE Runtime, and Minima are trademarks, and CLOE, Genera,
+and Zetalisp are registered trademarks of Symbolics, Inc.
+
+ Symbolics, Inc.
+ 8 New England Executive Park, East
+ Burlington, Massachusetts 01803
+
+copyright information from original PCL sources:
+
+Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
+All rights reserved.
+
+Use and copying of this software and preparation of derivative works based
+upon this software are permitted. Any distribution of this software or
+derivative works must comply with all applicable United States export
+control laws.
+
+This software is made available AS IS, and Xerox Corporation makes no
+warranty about the software, its performance or its conformity to any
+specification.
+
+Copyright (C) 2002 Gerd Moellmann <gerd.moellmann@t-online.de>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The name of the author may not be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+
+### Alexandria
+
+Alexandria software and associated documentation are in the public
+domain:
+
+ Authors dedicate this work to public domain, for the benefit of the
+ public at large and to the detriment of the authors' heirs and
+ successors. Authors intends this dedication to be an overt act of
+ relinquishment in perpetuity of all present and future rights under
+ copyright law, whether vested or contingent, in the work. Authors
+ understands that such relinquishment of all rights includes the
+ relinquishment of all rights to enforce (by lawsuit or otherwise)
+ those copyrights in the work.
+
+ Authors recognize that, once placed in the public domain, the work
+ may be freely reproduced, distributed, transmitted, used, modified,
+ built upon, or otherwise exploited by anyone for any purpose,
+ commercial or non-commercial, and in any way, including by methods
+ that have not yet been invented or conceived.
+
+In those legislations where public domain dedications are not
+recognized or possible, Alexandria is distributed under the following
+terms and conditions:
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation files
+ (the "Software"), to deal in the Software without restriction,
+ including without limitation the rights to use, copy, modify, merge,
+ publish, distribute, sublicense, and/or sell copies of the Software,
+ and to permit persons to whom the Software is furnished to do so,
+ subject to the following conditions:
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+
+### cl-ppcre
+
+Copyright (c) 2002-2009, Dr. Edmund Weitz. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials
+ provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### cl-unicode
+
+Copyright (c) 2008-2012, Dr. Edmund Weitz. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials
+ provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### named-readtables
+
+Copyright (c) 2007 - 2009 Tobias C. Rittweiler <tcr@freebits.de>
+Copyright (c) 2007, Robert P. Goldman <rpgoldman@sift.info> and SIFT, LLC
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the names of Tobias C. Rittweiler, Robert P. Goldman,
+ SIFT, LLC nor the names of its contributors may be used to
+ endorse or promote products derived from this software without
+ specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Tobias C. Rittweiler, Robert
+P. Goldman and SIFT, LLC ``AS IS'' AND ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Tobias C. Rittweiler, Robert
+P. Goldman or SIFT, LLC BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### cl-interpol
+
+Copyright (c) 2003-2008, Dr. Edmund Weitz. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials
+ provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### bordeaux-threads
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+
+### cl-fad
+
+Copyright (c) 2004, Peter Seibel. All rights reserved.
+Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials
+ provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### local-time
+
+local-time Copyright (c) 2005-2012 by Daniel Lowe
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+
+### parse-number
+
+Author: Matthew Danish -- mrd.debian.org
+
+Copyright 2002 Matthew Danish.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
+
+
+### chronicity
+
+Copyright (c) 2009-2016 Chaitanya Gupta
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+3. The name of the author may not be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### cl-base64
+
+Copyright (c) 2002-2003 by Kevin Rosenberg
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The name of the Authors may not be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### cl-debug
+
+Copyright 2014 LowH <code@lowh.net>
+
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+
+### closer-mop
+
+Copyright (c) 2005 - 2016 Pascal Costanza
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+
+### nibbles
+
+Copyright (c) 2010, Nathan Froyd
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+* Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+* Neither the name of the copyright holders nor the names of
+ contributors to this software may be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### ironclad
+
+Copyright (c) 2004-2008, Nathan Froyd
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+* Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+* Neither the name of the copyright holders nor the names of
+ contributors to this software may be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+### trivial-utf-8
+
+Copyright (c) Marijn Haverbeke
+
+This software is provided 'as-is', without any express or implied
+warranty. In no event will the authors be held liable for any
+damages arising from the use of this software.
+
+Permission is granted to anyone to use this software for any
+purpose, including commercial applications, and to alter it and
+redistribute it freely, subject to the following restrictions:
+
+1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+3. This notice may not be removed or altered from any source
+ distribution.
diff --git a/Makefile b/Makefile
index 81d592b..4f8385d 100644
--- a/Makefile
+++ b/Makefile
@@ -1,18 +1,46 @@
+## Adams - UNIX system administration tool written in Common Lisp
+## Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+PACKAGE = adams
+VERSION = 0.3.2
+RELEASE_DIR = ${PACKAGE}-${VERSION}
+RELEASE_TARBALL = ${PACKAGE}-${VERSION}.tar.gz
+RELEASE_DEPS_TARBALL = ${PACKAGE}-${VERSION}.deps.tar.gz
PROGRAM = build/adams
PREFIX = /usr/local
-LISP = sbcl
+LISP = sbcl --dynamic-space-size 2048
LISP_LOAD = ${LISP} --load
+CLEANFILES = build/*
+DISTCLEANFILES = ${RELEASE_DIR} ${RELEASE_TARBALL} ${RELEASE_DEPS_TARBALL}
all: ${PROGRAM}
-${PROGRAM}: build.lisp
- LANG=C.UTF-8 ${LISP_LOAD} build.lisp
+deps:
+ LANG=C.UTF-8 ${LISP_LOAD} prepare-build.lisp --quit
-clean:
- rm -rf build/*
+build/systems.lisp: prepare-build.lisp adams.asd
+ LANG=C.UTF-8 ${LISP_LOAD} prepare-build.lisp --quit
+
+${PROGRAM}: build.lisp config.lisp build/systems.lisp toplevel.lisp
+ LANG=C.UTF-8 ${LISP_LOAD} build.lisp --quit
-install: ${PROGRAM}
+install:
install -m 0755 ${PROGRAM} ${PREFIX}/bin
-.PHONY: all clean install ${PROGRAM}
+release: ${RELEASE_TARBALL} ${RELEASE_DEPS_TARBALL}
+
+${RELEASE_TARBALL}:
+ mkdir ${RELEASE_DIR}
+ find . -name build -prune -or -name '*.lisp' -or -name '*.asd' -or -name '*.md' | cpio -pd ${RELEASE_DIR}
+ tar czf ${RELEASE_TARBALL} ${RELEASE_DIR}
+
+${RELEASE_DEPS_TARBALL}:
+ tar czf ${RELEASE_DEPS_TARBALL} build/*.lisp
+
+clean:
+ rm -rf ${CLEANFILES}
+
+distclean:
+ rm -rf ${DISTCLEANFILES}
+
+.PHONY: all clean deps install ${PROGRAM} release
diff --git a/README.md b/README.md
index 0756a5b..3408ef9 100644
--- a/README.md
+++ b/README.md
@@ -1,27 +1,40 @@
-Adams
-=====
-
-Adams is our new cybernetic DevOps. Please welcome him and make him feel
-at home, I hope he will find a nice place to work amongst us. So far he's
-been a brilliant student though a bit dumb and formal, I hope he will find
-a warm and welcoming place in our hearts.
-For the next months he will remain in formation so if you would please
-consider handing him any rookie task you might have he shall gladly take
-them upon him and will probably crash the system and need your help to fix it
-but, hey, that's what unpaid interns are for, right ?
+Adams 0.3.2
+===========
+
+Adams is a UNIX system administration tool written in Common Lisp.
+
+You describe your systems (hosts) using resources having properties.
+
+The properties are then probed and synchronized by Adams using only
+`/bin/sh` on the remote host, and `/usr/bin/ssh` on the control host.
+
+
+Configuration example
+---------------------
+
+Check out
+<https://github.com/kmx-io/kmx-io/>
+for a detailed example of Adams usage.
+
Current status
--------------
-Adams is currently able to use a local shell or connect to remote hosts via
-ssh.
-He is quite the hardcore hacker wannabe using only /bin/sh though ksh and
-bash suit him fine too.
-He's still green but he can already gather basic information about users,
-groups and files.
+Adams is currently able to use a local shell or connect to remote hosts
+via ssh.
+
+Adams is this hardcore hacker using only `/bin/sh` commands.
+This makes `ksh` and `bash` suitable shells for adams as they are
+compatible with `/bin/sh`.
+
+Supported resource types :
+ - Host (hostname)
+ - User (useradd, usermod, userdel)
+ - Group (groupadd, groupmod, groupdel)
+ - File (owner, group, permissions, content)
+ - Directory (owner, group, permissions)
+ - Package (Debian, OpenBSD)
-We are currently teaching him about new kinds of resources and how to read
-resource specification manifests.
Security design
---------------
@@ -37,5 +50,103 @@ Adams does not grant access to data belonging to any host.
Adams does not send any data that is not of direct concern to the host.
In short, all UNIX permissions are respected, Adams is a regular UNIX user.
+
Usage
-----
+
+
+### 1. Install [repo](https://github.com/common-lisp-repo/repo).
+
+
+### 2. Fetch adams sources.
+
+``` shell
+ $ sbcl --eval '(repo:install :adams)'
+```
+
+
+### 3. Build and install the `adams` binary
+
+``` shell
+ $ cd ~/common-lisp/cl-adams/adams
+ $ make
+ $ sudo cp build/adams /usr/local/bin/adams
+```
+
+
+### 4. Configure emacs (optional)
+
+In your `~/.emacs` file :
+``` emacs-lisp
+ ;; Adams
+ (add-to-list 'auto-mode-alist '("\\.adams\\'" . lisp-mode))
+```
+
+
+### 5. Write some resources in a `.adams` script
+
+In the `tutorial.adams` file :
+``` common-lisp
+ #!/usr/local/bin/adams --script
+
+ (resource 'host "adams.kmx.io"
+ :user "adams"
+ (resource 'user "adams"
+ :shell "/bin/sh"
+ :ensure :present))
+
+ (with-host "adams.kmx.io"
+ (sync *host*))
+```
+
+
+### 6. Profit.
+
+``` shell
+ $ chmod 755 tutorial.adams
+ $ ./tutorial.adams
+```
+
+The `tutorial.adams` script will synchronize the host "adams.kmx.io"
+according to the resource specifications given in the file.
+
+
+### 7. DRY up your scripts using `#.(include "file")`
+
+In the `user/dx.adams` file :
+``` common-lisp
+ ;; Thomas de Grivel (kmx.io)
+ (resource 'group "dx"
+ :gid 19256
+ :ensure :present)
+ (resource 'user "dx"
+ :uid 19256
+ :gid 19256
+ :home "/home/dx"
+ :ensure :present)
+```
+
+In your main script :
+``` common-lisp
+ #!/usr/local/bin/adams --script
+
+ (resource 'host "adams.kmx.io"
+ :user "adams"
+ (resource 'user "adams"
+ :shell "/bin/sh"
+ :ensure :present)
+ #.(include "user/dx"))
+
+ (with-host "adams.kmx.io"
+ (sync *host*))
+```
+
+
+[License](LICENSE.md)
+---------------------
+
+
+Authors
+-------
+
+Thomas de Grivel <thodg@kmx.io>
diff --git a/adams.asd b/adams.asd
index d1fb1bd..00eab78 100644
--- a/adams.asd
+++ b/adams.asd
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(defpackage :adams.system
(:use :cl :asdf))
@@ -45,13 +30,15 @@
#+sbcl
(:file "sb-shell" :depends-on ("shell"))))
(:module "core" :depends-on ("package" "shell")
- :components
- ((:file "defs")
- (:file "host" :depends-on ("defs" "os" "resource-container"
- "syntaxes"))
+ :components
+ ((:file "defs")
+ (:file "helpers")
+ (:file "host" :depends-on ("defs" "os" "resource-container"
+ "syntaxes"))
+ (:file "include")
+ (:file "operation" :depends-on ("defs" "host" "properties"))
(:file "os")
(:file "probe" :depends-on ("defs" "host" "properties"))
- (:file "operation" :depends-on ("defs" "host" "properties"))
(:file "properties" :depends-on ("defs"))
(:file "resource" :depends-on ("defs" "probe"))
(:file "resource-container" :depends-on ("defs"))
@@ -65,6 +52,7 @@
(:file "linux" :depends-on ("commands" "defs"))
(:file "openbsd" :depends-on ("commands" "defs"))
(:file "freebsd" :depends-on ("commands" "defs"))
+ (:file "darwin" :depends-on ("commands" "defs"))
(:file "operations" :depends-on ("commands" "defs"))
(:file "probes" :depends-on ("commands" "defs"
"stat" "syntaxes"))
diff --git a/build.lisp b/build.lisp
index 36e8848..5f38baf 100644
--- a/build.lisp
+++ b/build.lisp
@@ -1,182 +1,29 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :common-lisp-user)
-(defgeneric collect-sources (x))
-
-(defmethod collect-sources ((x symbol))
- (collect-sources (asdf:find-system x)))
-
-(defmethod collect-sources ((x string))
- (collect-sources (asdf:find-system x)))
-
-(defun sort-components (list)
- (declare (type list list))
- (let (components roots)
- (declare (type list components roots))
- (labels ((map-dependencies (comp fn)
- (declare (type asdf:component comp))
- (dolist (id (asdf:component-sideway-dependencies comp))
- (let ((dep (find id list :test #'string=
- :key #'asdf:component-name)))
- (when dep
- (funcall (the function fn) dep)))))
- (dfs (comp)
- (declare (type asdf:component comp))
- (map-dependencies comp #'dfs)
- (pushnew comp components)))
- (dolist (comp list)
- (declare (type asdf:component comp))
- (pushnew comp roots))
- (dolist (comp list)
- (declare (type asdf:component comp))
- (map-dependencies comp (lambda (dep)
- (setf roots (delete dep roots)))))
- (dolist (comp roots)
- (dfs comp)))
- (nreverse components)))
-
-(defmethod collect-sources ((x asdf:parent-component))
- (let ((children (sort-components (asdf:component-children x))))
- (mapcan #'collect-sources children)))
-
-(defmethod collect-sources ((req asdf:require-system))
- (list `(require ,(string-upcase (asdf:component-name req)))))
-
-(defmethod collect-sources ((x asdf:cl-source-file))
- (list `(compile-lisp ,(asdf:component-pathname x))))
-
-(defmethod collect-sources ((x asdf:file-component))
- (list `(quote ,(asdf:component-pathname x))))
-
-(defmethod collect-sources :around ((x asdf:component))
- (let ((if-feature (asdf::component-if-feature x)))
- (if if-feature
- (when (find (the symbol if-feature) *features*)
- (call-next-method))
- (call-next-method))))
-
-#+nil (collect-sources :adams)
-
-(defvar *system-directory*
- (make-hash-table))
-
-(defun system-directory (system)
- (or #1=(gethash system *system-directory*)
- (let* ((sys (typecase system (asdf:system system)
- (t (asdf:find-system system))))
- (asd (asdf:system-source-file sys)))
- (setf #1#
- (make-pathname :name nil :type nil :defaults asd)))))
-
-(defun system-file (system &rest parts)
- (let ((str (apply #'concatenate 'string parts)))
- (merge-pathnames str (system-directory system))))
-
-(defun namestring* (x)
- (etypecase x
- (null "")
- (pathname (namestring x))
- (string x)))
-
-(defparameter *dir* (namestring* (system-file :adams "")))
+(declaim (optimize (speed 1)
+ (space 1)
+ (safety 3)
+ (debug 3)
+ (compilation-speed 0)))
(defun compile-lisp (path)
- (let* ((adams-dir *dir*)
- (dir (pathname-directory path))
- (name (pathname-name path))
- (fasl (with-output-to-string (out)
- (write-string adams-dir out)
- (write-string "build/" out)
- (dolist (d (rest dir))
- (write-string d out)
- (write-char #\- out))
- (write-string name out)
- (write-string ".fasl" out))))
- (print fasl)
- (unless (and (probe-file fasl)
- (<= (file-write-date path)
- (file-write-date fasl)))
- (print path)
- (ensure-directories-exist fasl)
- (compile-file path :output-file fasl))
- (load fasl)))
-
-(defun write-system-build-file (system sbf)
- (format t "~&~A~%" sbf) (force-output)
- (with-open-file (out sbf :direction :output
- :element-type 'character
- :if-exists :supersede
- :if-does-not-exist :create
- :external-format :utf-8)
- (declare (type stream out))
- (format out "~&;; ~A" (asdf:component-name system))
- (dolist (src (collect-sources system))
- (print src out))))
-
-(defun system-build-file (system)
- (let* ((adams-dir *dir*)
- (asd (asdf:system-source-file system))
- (name (substitute #\- #\/ (asdf:component-name system)))
- (sbf (concatenate 'string adams-dir "build/" name ".lisp")))
- (unless (and (probe-file sbf)
- (<= (file-write-date asd)
- (file-write-date sbf)))
- (write-system-build-file system sbf))
- sbf))
-
-(defun system-and-dependencies (name)
- (let (dependencies)
- (labels ((dfs (name)
- (let ((sys (asdf:find-system name)))
- (when sys
- (locally (declare (type asdf:system sys))
- (map 'nil #'dfs (asdf:system-depends-on sys))
- (pushnew sys dependencies))))))
- (dfs name)
- (nreverse dependencies))))
-
-(defun write-build-systems-file (system)
- (unless (typep system 'asdf:system)
- (setq system (asdf:find-system system)))
- (let* ((path (system-file system "build/systems.lisp")))
- (print path) (force-output)
- (ensure-directories-exist path)
- (with-open-file (out path :direction :output
- :element-type 'character
- :external-format :utf-8
- :if-exists :supersede
- :if-does-not-exist :create)
- (declare (type stream out))
- (dolist (sys (system-and-dependencies system))
- (let* ((build-file (system-build-file sys))
- (load-form `(load ,build-file)))
- (format t "~& ~A~%" sys) (force-output)
- (print load-form out)))
- (fresh-line out))))
-
-(write-build-systems-file :adams)
+ (let* ((fasl (make-pathname :type "fasl" :defaults path))
+ (fasl (merge-pathnames fasl)))
+ (print fasl)
+ (unless (and (probe-file fasl)
+ (<= (file-write-date path)
+ (file-write-date fasl)))
+ (print path)
+ (compile-file path :output-file fasl))
+ (load fasl)))
(defun load* (path)
(format t "~&Loading ~S" path)
(load path))
-(load* (system-file :adams "config.lisp"))
-(load* (system-file :adams "build/systems.lisp"))
-(load* (system-file :adams "toplevel.lisp"))
+(load* "config.lisp")
+(load* "build/systems.lisp")
+(load* "toplevel.lisp")
diff --git a/config.lisp b/config.lisp
index 207c5fe..c039f50 100644
--- a/config.lisp
+++ b/config.lisp
@@ -1,2 +1,4 @@
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(declaim (optimize (debug 3) (safety 3) (speed 3)))
diff --git a/core/defs.lisp b/core/defs.lisp
index cf6fbf4..d2123a1 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -195,6 +180,7 @@
(probe-host-locale :properties (:locale))
(probe-host-packages :properties (:packages))
(probe-boot-time :properties (:boot-time))
+ (probe-host-homedir :properties (:homedir))
(probe-host-user :properties (:user))
(probe-hostname :properties (:hostname)))
((op-host-locale :properties (:locale))
@@ -252,7 +238,7 @@
((property :initarg :property)))
(define-condition resource-operation-failed (resource-operation-error)
- ((operation :initarg :operation)
+ ((operation :initarg :operation :type operation)
(diff :initarg :diff)))
;; Operators on property lists
@@ -261,3 +247,7 @@
`(loop
(unless (remf ,place ,indicator)
(return))))
+
+;; Shebang
+
+(set-dispatch-macro-character #\# #\! #'read-line)
diff --git a/core/helpers.lisp b/core/helpers.lisp
new file mode 100644
index 0000000..8955517
--- /dev/null
+++ b/core/helpers.lisp
@@ -0,0 +1,32 @@
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+
+(in-package :adams)
+
+(defun read-file (&rest path-parts)
+ (let ((path (str path-parts)))
+ (with-output-to-string (out)
+ (with-open-file (stream path :element-type 'character)
+ (let ((buf (make-string 4096)))
+ (loop
+ (let ((size (read-sequence buf stream)))
+ (when (zerop size)
+ (return))
+ (write-sequence buf out :end size))))))))
+
+(defun static-file (path &rest plist)
+ (resource 'file path
+ :content (read-file (hostname *host*) path)
+ plist))
+
+(defun static-directory (directory &rest plist)
+ (let* ((host-dir (truename (pathname (the string
+ (str (hostname) #\/)))))
+ (dir-path (str host-dir directory)))
+ (print dir-path)
+ (mapcar (lambda (path)
+ (let ((name (enough-namestring path host-dir)))
+ (resource 'file (str "/" name)
+ :content (read-file path)
+ plist)))
+ (directory dir-path))))
diff --git a/core/host.lisp b/core/host.lisp
index fe6cc24..5a17214 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -1,34 +1,25 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
(defun run (&rest command)
"Run a command at the current host. COMMAND is assembled using STR."
- (if (and (boundp '*host*)
- (symbol-value '*host*))
- (apply #'host-run *host* command)
- (with-shell (shell)
- (apply #'shell-run shell command))))
+ (apply #'host-run (current-host) command))
-;; localhost
+(defun strip-last-newline (string)
+ (when (stringp string)
+ (let* ((len (length string))
+ (len-1 (1- len)))
+ (if (< len 1)
+ string
+ (when (char= #\Newline (char string len-1))
+ (subseq string 0 len-1))))))
+
+(defun run-1 (&rest command)
+ (strip-last-newline (first (apply #'run command))))
-(assert (string= (machine-instance) (first (run "hostname"))))
+;; localhost
(defun local-hostname ()
(machine-instance))
@@ -61,15 +52,30 @@
shell))
(defun current-host ()
- (or (when (boundp '*host*)
- (symbol-value '*host*))
- (localhost)))
+ (or *host* (localhost)))
;; Host
-(defun hostname (host)
+(defun hostname (&optional (host (current-host)))
(resource-id (the host host)))
+(defun homedir (user &optional (host (current-host)))
+ (str (etypecase (host-os host)
+ (os-darwin "/Users")
+ (os "/home"))
+ "/"
+ (etypecase user
+ (user (resource-id user))
+ (string user))))
+
+(defgeneric probe-host-homedir (host os))
+
+(defmethod probe-host-homedir (host (os os-unix))
+ '(:homedir "/home"))
+
+(defmethod probe-host-homedir (host (os os-darwin))
+ '(:homedir "/Users"))
+
;; Host shell
(defmethod host-shell ((host host))
@@ -172,7 +178,7 @@
(list :os os)))))))
(defmethod probe-hostname ((host host) (os os-unix))
- (list :hostname (first (run "hostname"))))
+ (list :hostname (run-1 "hostname")))
(defmethod probe-boot-time ((host host) (os os-unix))
(with-uptime<1> (time uptime users load1 load5 load15) (run "uptime")
@@ -180,7 +186,7 @@
(str uptime " seconds ago"))))))
(defmethod probe-host-user ((host host) (os os-unix))
- (list :user (first (run "whoami"))))
+ (list :user (run-1 "whoami")))
(defmethod compare-property-values ((host host)
(property (eql :os))
@@ -192,7 +198,8 @@
(defmethod match-specified-value ((res host)
(property (eql :packages))
(specified list)
- (probed list))
+ (probed list)
+ os)
(format t "~&match-specified-value specified ~S~%" specified)
(format t "~&match-specified-value probed ~S~%" probed)
(force-output)
diff --git a/core/include.lisp b/core/include.lisp
new file mode 100644
index 0000000..da6142a
--- /dev/null
+++ b/core/include.lisp
@@ -0,0 +1,34 @@
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+
+(in-package :adams)
+
+(defun include/resolve-filename (spec)
+ (flet ((try (&rest parts)
+ (let ((path (str parts)))
+ (when (probe-file path)
+ (return-from include/resolve-filename path)))))
+ (try spec ".adams")
+ (try spec)))
+
+(defun include/resolve-filename! (spec)
+ (or (include/resolve-filename spec)
+ (error "(include ~S) => file not found.~%
+Current directory : ~S" spec *default-pathname-defaults*)))
+
+(defun include (&rest sources)
+ (let* ((head (cons 'list nil))
+ (tail head)
+ (eof (gensym "EOF")))
+ (dolist (source sources)
+ (let ((path (include/resolve-filename! source)))
+ (with-open-file (in path
+ :element-type 'character
+ :external-format :utf-8)
+ (loop
+ (let ((form (read in nil eof)))
+ (when (eq form eof)
+ (return))
+ (setf (rest tail) (cons form nil)
+ tail (rest tail)))))))
+ head))
diff --git a/core/operation.lisp b/core/operation.lisp
index da2e003..76e4ead 100644
--- a/core/operation.lisp
+++ b/core/operation.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -90,7 +75,7 @@
(error 'resource-operation-not-found
:resource res
:property property
- :host (current-host)
+ :host *host*
:os os))
(pushnew (the operation op) operations)))
(nreverse operations)))
@@ -137,6 +122,8 @@
(sorted-ops (sort-operations res operations))
(results))
(loop
+ (when (endp sorted-ops)
+ (return))
(let* ((op (pop sorted-ops))
(result (apply (operation-generic-function op)
res os plist)))
@@ -168,14 +155,13 @@
(defun print-diff (stream diff)
(dolist (item diff)
(destructuring-bind (property expected probed) item
- (declare (type symbol property)
- (type list expected probed))
+ (declare (type symbol property))
(write-str stream property #\Newline
" expected ")
- (print-list expected stream)
+ (prin1 expected stream)
(write-str stream #\Newline
" probed ")
- (print-list probed stream)
+ (prin1 probed stream)
(write-str stream #\Newline))))
(defmethod print-object ((c resource-operation-failed) stream)
diff --git a/core/os.lisp b/core/os.lisp
index df27ed5..0ffdace 100644
--- a/core/os.lisp
+++ b/core/os.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -31,7 +16,7 @@
(format nil "~A ~A ~A ~A"
machine name release version)))
-(defmethod match-specified-value ((host host) (property (eql :os)) specified probed)
+(defmethod match-specified-value ((host host) (property (eql :os)) specified probed os)
(re-match `(:sequence ,specified) probed))
;; UNIX
diff --git a/core/probe.lisp b/core/probe.lisp
index fc29db0..c9fc2be 100644
--- a/core/probe.lisp
+++ b/core/probe.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -75,6 +60,10 @@
(probes-of r)))
(defun add-probed-properties (resource properties)
+ (format t "~&(resource '~A ~S ~{~S ~S~^ ~})~%"
+ (class-name (class-of resource))
+ (resource-id resource)
+ properties)
(setf #1=(probed-properties resource)
(merge-properties resource #1# properties)))
diff --git a/core/properties.lisp b/core/properties.lisp
index a232b4b..d97f345 100644
--- a/core/properties.lisp
+++ b/core/properties.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/core/resource-container.lisp b/core/resource-container.lisp
index b102d5c..43636f4 100644
--- a/core/resource-container.lisp
+++ b/core/resource-container.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/core/resource.lisp b/core/resource.lisp
index be9f8c2..a07c641 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -110,6 +95,7 @@
value))
(defun plist-keys (plist)
+ (declare (type list plist))
(let ((keys))
(loop
(when (endp plist)
@@ -176,7 +162,7 @@
(let* ((probed (get-probed res property))
(desc (describe-probed-property-value res property
probed)))
- (unless (match-specified-value res property specified desc)
+ (unless (match-specified-value res property specified desc os)
(push (list property specified desc) failed))))))
(setq failed (nreverse failed))
(when failed
@@ -201,6 +187,7 @@
(op-keys (operation-properties op))
(op-plist (get-properties op-keys plist))
(op-fun (operation-generic-function op)))
+ (format t "~%")
(apply (the function op-fun) res os op-plist)
(clear-probed res op-keys)
(sync-check host res op op-keys op-plist os))))))
@@ -208,4 +195,5 @@
(defmethod sync ((host host))
(with-host host
(resource-additional-specs host (host-os host))
- (call-next-method)))
+ (call-next-method)
+ (format t "~&sync ~A complete~%" (resource-id host))))
diff --git a/core/spec.lisp b/core/spec.lisp
index 31c690a..13a2853 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -37,10 +22,12 @@
;; Parse specifications
(defmethod parse-next-specification ((res resource) spec)
- (let ((property (pop spec))
- (value (pop spec)))
- (setf (get-specified res property) value)
- spec))
+ (when (and (symbolp (first spec))
+ (consp (rest spec)))
+ (let ((property (pop spec))
+ (value (pop spec)))
+ (setf (get-specified res property) value)
+ spec)))
(defmethod parse-next-specification ((res resource-container) spec)
(cond ((typep (first spec) 'resource)
@@ -56,10 +43,13 @@
(loop
(when (endp spec)
(return))
- (let ((next-spec (parse-next-specification res spec)))
- (when (eq spec next-spec)
- (error "Invalid specification : ~S" spec))
- (setq spec next-spec)))
+ (typecase (first spec)
+ (cons (parse-specification res (first spec))
+ (setq spec (rest spec)))
+ (t (let ((next-spec (parse-next-specification res spec)))
+ (when (eq spec next-spec)
+ (error "Invalid specification : ~S" spec))
+ (setq spec next-spec)))))
res)
#+nil
@@ -97,14 +87,15 @@
;; Methods for matching specified and probed values
-(defgeneric match-specified-value (resource property specified probed))
+(defgeneric match-specified-value (resource property specified probed os))
-(defmethod match-specified-value (resource property specified probed)
+(defmethod match-specified-value (resource property specified probed os)
(equalp specified (describe-probed-property-value resource property probed)))
(defmethod match-specified-value (resource (property (eql :ensure))
(specified (eql :present))
- (probed null))
+ (probed null)
+ os)
t)
;; Methods to get current status of resource
@@ -116,17 +107,36 @@ First value lists properties out of specification in the following format :
Second value lists properties in line with spec. Format is
(PROPERTY-NAME VALUE)"))
-(defmethod resource-diff ((res resource))
- (let ((specified-properties (specified-properties res))
- diff)
+(defvar *virtual-properties*
+ '(:after
+ :before)
+ "Special properties that will not be synchronized.")
+
+(declaim (type list *virtual-properties*))
+
+(defun diffable-properties (specified-properties)
+ (let ((properties))
(loop
(when (endp specified-properties)
- (return))
+ (return (nreverse properties)))
(let* ((property (pop specified-properties))
- (specified (pop specified-properties))
+ (specified (pop specified-properties)))
+ (unless (find property *virtual-properties* :test #'eq)
+ (push property properties)
+ (push specified properties))))))
+
+(defmethod resource-diff ((res resource))
+ (let* ((specified-properties (specified-properties res))
+ (properties (diffable-properties specified-properties))
+ diff)
+ (loop
+ (when (endp properties)
+ (return))
+ (let* ((property (pop properties))
+ (specified (pop properties))
(probed (get-probed res property))
(desc (describe-probed-property-value res property probed)))
- (unless (match-specified-value res property specified desc)
+ (unless (match-specified-value res property specified desc (host-os *host*))
(push `(,property ,specified ,desc) diff))))
(nreverse diff)))
diff --git a/core/syntaxes.lisp b/core/syntaxes.lisp
index 60638a9..8b8d6b4 100644
--- a/core/syntaxes.lisp
+++ b/core/syntaxes.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/package.lisp b/package.lisp
index 62b67e4..efca103 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :cl-user)
@@ -115,6 +100,7 @@
#:resource-diff
;; Host
#:current-host
+ #:homedir
#:host
#:host-connect
#:host-disconnect
@@ -123,6 +109,8 @@
#:host-run
#:localhost
#:run
+ #:run-as-root
+ #:run-as-root-command
#:ssh-host
#:with-connected-host
#:with-host
@@ -143,6 +131,7 @@
#:ssh-authorized-key
#:stat
#:stat<1>
+ #:symlink
#:+timestamp-offset+
#:timestamp-to-universal-time
#:universal-time-to-timestamp
@@ -150,6 +139,12 @@
#:with-uptime<1>
;; OpenBSD
#:openbsd-pkg
+ ;; helpers
+ #:include
+ #:read-file
+ #:static-file
+ #:static-directory
+ #:str
))
(defpackage :adams-user
diff --git a/prepare-build.lisp b/prepare-build.lisp
new file mode 100644
index 0000000..3c8234a
--- /dev/null
+++ b/prepare-build.lisp
@@ -0,0 +1,179 @@
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+
+(in-package :common-lisp-user)
+
+(defvar *system-directory*
+ (make-hash-table))
+
+(defun system-directory (system)
+ (or #1=(gethash system *system-directory*)
+ (let* ((sys (typecase system (asdf:system system)
+ (t (asdf:find-system system))))
+ (asd (asdf:system-source-file sys)))
+ (setf #1#
+ (make-pathname :name nil :type nil :defaults asd)))))
+
+(defun system-file (system &rest parts)
+ (let ((str (apply #'concatenate 'string parts)))
+ (merge-pathnames str (system-directory system))))
+
+(asdf:load-system :alexandria)
+
+(defun namestring* (x)
+ (etypecase x
+ (null "")
+ (pathname (namestring x))
+ (string x)))
+
+(defparameter *dir* (namestring* (system-file :adams "")))
+
+(defgeneric collect-sources (x))
+
+(defmethod collect-sources ((x symbol))
+ (collect-sources (asdf:find-system x)))
+
+(defmethod collect-sources ((x string))
+ (collect-sources (asdf:find-system x)))
+
+(defun sort-components (list)
+ (declare (type list list))
+ (let (components roots)
+ (declare (type list components roots))
+ (labels ((map-dependencies (comp fn)
+ (declare (type asdf:component comp))
+ (dolist (id (asdf:component-sideway-dependencies comp))
+ (let ((dep (find id list :test #'string=
+ :key #'asdf:component-name)))
+ (when dep
+ (funcall (the function fn) dep)))))
+ (dfs (comp)
+ (declare (type asdf:component comp))
+ (map-dependencies comp #'dfs)
+ (pushnew comp components)))
+ (dolist (comp list)
+ (declare (type asdf:component comp))
+ (pushnew comp roots))
+ (dolist (comp list)
+ (declare (type asdf:component comp))
+ (map-dependencies comp (lambda (dep)
+ (setf roots (delete dep roots)))))
+ (dolist (comp roots)
+ (dfs comp)))
+ (nreverse components)))
+
+(defmethod collect-sources ((x asdf:parent-component))
+ (let ((children (sort-components (asdf:component-children x))))
+ (mapcan #'collect-sources children)))
+
+(defmethod collect-sources ((req asdf:require-system))
+ (list `(require ,(string-upcase (asdf:component-name req)))))
+
+(defun strip-common-lisp-directory (dir)
+ (declare (type list dir))
+ (let ((pos (position "common-lisp" dir :test #'string=)))
+ (if pos
+ (nthcdr pos dir)
+ dir)))
+
+(defun dependency-path (src)
+ (let* ((adams-dir *dir*)
+ (path (pathname src))
+ (dir (pathname-directory path))
+ (name (pathname-name path))
+ (type (pathname-type path)))
+ (with-output-to-string (out)
+ (write-string adams-dir out)
+ (write-string "build/" out)
+ (let ((dir (strip-common-lisp-directory dir)))
+ (dolist (d (rest dir))
+ (write-string d out)
+ (write-char #\- out)))
+ (write-string name out)
+ (write-char #\. out)
+ (write-string type out))))
+
+(defun copy-dependency (src)
+ (let ((dep (dependency-path src)))
+ (alexandria:copy-file src dep)
+ (enough-namestring dep *dir*)))
+
+(defmethod collect-sources ((x asdf:cl-source-file))
+ (let* ((src (asdf:component-pathname x))
+ (dep (copy-dependency src)))
+ (list `(compile-lisp ,dep))))
+
+(defmethod collect-sources ((x asdf:file-component))
+ (list `(quote ,(asdf:component-pathname x))))
+
+(defmethod collect-sources :around ((x asdf:component))
+ (let ((if-feature (asdf::component-if-feature x)))
+ (etypecase if-feature
+ (null
+ (call-next-method))
+ (symbol
+ (when (find (the symbol if-feature) *features*)
+ (call-next-method)))
+ (cons
+ (cond ((string-equal 'not (first if-feature))
+ (unless (find (the symbol (second if-feature)) *features*)
+ (call-next-method)))
+ (t (error "Bad if-feature")))))))
+
+#+nil (collect-sources :adams)
+
+(defun write-system-build-file (system sbf)
+ (format t "~&~A~%" sbf) (force-output)
+ (with-open-file (out sbf :direction :output
+ :element-type 'character
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf-8)
+ (declare (type stream out))
+ (format out "~&;; ~A" (asdf:component-name system))
+ (dolist (src (collect-sources system))
+ (print src out))))
+
+(defun system-build-file (system)
+ (let* ((asd (asdf:system-source-file system))
+ (name (substitute #\- #\/ (asdf:component-name system)))
+ (sbf (concatenate 'string "build/" name ".lisp")))
+ (unless (and (probe-file sbf)
+ (<= (file-write-date asd)
+ (file-write-date sbf)))
+ (write-system-build-file system sbf))
+ sbf))
+
+(defun system-and-dependencies (name)
+ (let (dependencies)
+ (labels ((dfs (name)
+ (let ((sys (asdf:find-system name)))
+ (when (and sys (not (find sys dependencies)))
+ (locally (declare (type asdf:system sys))
+ (format t "~& ~A" sys) (force-output)
+ (map 'nil #'dfs (asdf:system-depends-on sys))
+ (push sys dependencies))))))
+ (dfs name)
+ (nreverse dependencies))))
+
+(defun write-build-systems-file (system)
+ (unless (typep system 'asdf:system)
+ (setq system (asdf:find-system system)))
+ (let* ((path (system-file system "build/systems.lisp")))
+ (print path) (force-output)
+ (ensure-directories-exist path)
+ (with-open-file (out path :direction :output
+ :element-type 'character
+ :external-format :utf-8
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (declare (type stream out))
+ (dolist (sys (system-and-dependencies system))
+ (let* ((build-file (system-build-file sys))
+ (load-form `(load ,build-file)))
+ (format t "~& ~A~%" sys) (force-output)
+ (print load-form out)))
+ (fresh-line out)
+ (force-output out))))
+
+(write-build-systems-file :adams)
diff --git a/shell/sb-shell.lisp b/shell/sb-shell.lisp
index 9abbbee..e7627f9 100644
--- a/shell/sb-shell.lisp
+++ b/shell/sb-shell.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/shell/shell.lisp b/shell/shell.lisp
index edbe68f..c4aa608 100644
--- a/shell/shell.lisp
+++ b/shell/shell.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -74,7 +59,9 @@ Error: ~S"
(defun sh-quote (&rest str)
(let ((str (str str)))
- (if (cl-ppcre:scan "^[-+/=.,:^_0-9A-Za-z]*$" str)
+ (declare (type string str))
+ (if (and (not (position #\Newline str))
+ (cl-ppcre:scan "^[-+/=.,:^_0-9A-Za-z]*$" str))
str
(str #\" (re-subst "([$`\\\\\"])" "\\\\\\1" str) #\"))))
@@ -128,25 +115,29 @@ Error: ~S"
(force-output log))))
(defmethod shell-status ((shell shell))
- (let* ((delim (make-delimiter))
+ (let* ((delim (the string (make-delimiter)))
(len (length delim))
- (lines-head (cons nil nil))
+ (lines-head (cons (str #\Newline) nil))
(lines-tail lines-head))
(shell-in (format nil " ; echo \"~%~A $?\"~%" delim) shell)
- (let* ((status (do ((line #1=(shell-out/line shell) #1#)
- (prev nil line))
- ((or (null line)
- (and (< len (length line))
- (string= delim line :end2 len)))
- (when line
- (when (debug-p :shell*)
- (debug-out "$ "))
- (parse-integer line :start len)))
- (when prev
- (when (debug-p :shell*)
- (debug-out "~A~%" prev))
- (setf (cdr lines-tail) (cons prev nil)
- lines-tail (cdr lines-tail)))))
+ (let* ((prev nil)
+ (status
+ (loop (let ((line (shell-out/line shell)))
+ (when (or (null line)
+ (and (< len (length line))
+ (string= delim line :end2 len)))
+ (unless (or (null prev) (string= "" prev))
+ (setf (cdr lines-tail) (cons prev nil)))
+ (return (when line
+ (when (debug-p :shell*)
+ (debug-out "$ "))
+ (parse-integer line :start len))))
+ (when prev
+ (when (debug-p :shell*)
+ (debug-out "~A~%" prev))
+ (setf (cdr lines-tail) (cons (str prev #\Newline) nil)
+ lines-tail (cdr lines-tail)))
+ (setf prev line))))
(out (cdr lines-head))
(err (shell-err/line shell)))
(when (shell-log-p shell)
@@ -154,7 +145,7 @@ Error: ~S"
(shell-log shell "| ~A~%" line))
(dolist (line err)
(shell-log shell "# ~A~&" line))
- (unless (= 0 status)
+ (unless (and status (= 0 status))
(shell-log shell " ⇒ ~D~%" status)))
(values status out err))))
diff --git a/test.lisp b/test.lisp
index d147259..e57cce3 100644
--- a/test.lisp
+++ b/test.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :cl-user)
@@ -25,18 +10,53 @@
;; TEST
(setf (debug-p :shell) t)
-
-(with-host "root@dc"
- (describe-probed (make-instance 'user :id "root")))
-
-(with-manifest "root@dc"
- (make-instance 'user :id "thodg"))
-
- (with-host "root@dc"
- (adams::apply-manifest "root@dc")
-
-(manifest-resources (manifest "h"))
-
-(apply-manifest "h")
-
-(remove-manifest "h")
+(setf (debug-p :sb-shell) nil)
+
+(assert (string= (machine-instance) (run-1 "hostname")))
+
+(adams:clear-resources)
+(adams:clear-probed)
+
+(resource 'symlink "/home/dx/test-symlink"
+ :owner "dx"
+ :group "dx"
+ :target "../test")
+
+(resource 'host "ams.kmx.io"
+ :user "root"
+ :hostname "ams"
+ :packages '("emacs:no_x11" "git" "rsync" "sbcl" "texinfo" "texlive_texmf-full")
+ (resource 'group "dx"
+ :gid 19256)
+ (resource 'user "dx"
+ :uid 19256
+ :gid 19256
+ :home "/home/dx"))
+
+(with-host "ams.kmx.io"
+ (sync *host*))
+
+(resource 'host "vu.kmx.io"
+ :user "root"
+ :hostname "vu"
+ :packages '("emacs:no_x11" "git" "rsync" "sbcl" "texinfo" "texlive_texmf-full")
+ (resource 'group "dx"
+ :gid 19256
+ :ensure :present)
+ (resource 'user "dx"
+ :uid 19256
+ :gid 19256
+ :home "/home/dx"
+ :ensure :present)
+ (resource 'group "git"
+ :gid 7000
+ :ensure :present)
+ (resource 'user "git"
+ :uid 7000
+ :gid 7000
+ :home "/home/git"
+ :shell "/usr/local/bin/git-auth"
+ :ensure :present))
+
+(with-host "vu.kmx.io"
+ (sync *host*))
diff --git a/toplevel.lisp b/toplevel.lisp
index 3396cc6..576873b 100644
--- a/toplevel.lisp
+++ b/toplevel.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/unix/commands.lisp b/unix/commands.lisp
index 0a7c506..90868f2 100644
--- a/unix/commands.lisp
+++ b/unix/commands.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -23,7 +8,7 @@
(defun uname ()
(re-bind #~"^(\S+) (\S+) (\S+) (.+) (\S+)$"
(os-name node-name os-release os-version machine)
- (first (run "uname -a"))))
+ (run-1 "uname -a")))
(defun grep_ (pattern &rest files)
(join-str " " "grep" (sh-quote pattern) (mapcar #'sh-quote files)))
@@ -54,3 +39,9 @@
(defun sudo (&rest command)
(run (apply #'sudo_ command)))
+
+(defun doas_ (&rest command)
+ (join-str " " "doas" command))
+
+(defun doas (&rest command)
+ (run (apply #'doas_ command)))
diff --git a/unix/darwin.lisp b/unix/darwin.lisp
new file mode 100644
index 0000000..0e48d54
--- /dev/null
+++ b/unix/darwin.lisp
@@ -0,0 +1,192 @@
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+
+(in-package :adams)
+
+(in-re-readtable)
+
+(defmethod echo-command ((host t) (os os-darwin))
+ "printf %s ")
+
+(defmethod probe-hostname ((host host) (os os-darwin))
+ (list :hostname (run-1 "hostname -s")))
+
+(define-resource-class brew-pkg (pkg)
+ ()
+ ((probe-brew-pkg :properties (:ensure :flavor :version)))
+ ((op-brew-pkg :properties (:ensure :version))))
+
+(defgeneric probe-brew-pkg (resource os))
+
+(defgeneric op-brew-pkg (pkg os &key ensure version))
+
+(defmethod probe-host-packages ((host host) (os os-darwin))
+ (list :packages ()))
+
+(defmethod op-host-packages ((host host) (os os-darwin) &key packages)
+ nil)
+
+(defmethod op-hostname ((host host) (os os-unix) &key hostname)
+ (run-as-root "hostname -s " (sh-quote hostname)))
+
+(defmethod probe-group ((group group) (os os-darwin))
+ (let ((id (resource-id group))
+ (ensure :absent)
+ (gid nil))
+ (multiple-value-bind (out status)
+ (run "dscl . -read /Groups/" (sh-quote id))
+ (when (= 0 status)
+ (setq ensure :present)
+ (dolist (line out)
+ (re-bind "PrimaryGroupID: ([0-9]+)" (n) line
+ (setq gid (parse-number n)))))
+ (properties* ensure gid))))
+
+#+nil
+(probe (resource 'group "dx") :gid)
+
+(defmethod probe-user ((user user) (os os-darwin))
+ (let* ((id (resource-id user))
+ (sh-id (sh-quote id))
+ (ensure :absent)
+ uid
+ gid
+ shell
+ home)
+ (multiple-value-bind (out status)
+ (run "dscl . -read /Users/" sh-id)
+ (when (= 0 status)
+ (setq ensure :present)
+ (dolist (line out)
+ (re-bind #~|^UniqueID: ([0-9]+)| (n) line
+ (setq uid (parse-number n)))
+ (re-bind #~|^PrimaryGroupID: ([0-9]+)| (n) line
+ (setq gid (parse-number n)))
+ (re-bind #~|^UserShell: (/[^ \n]+)| (s) line
+ (setq shell s))
+ (re-bind #~|^NFSHomeDirectory: (/[^ \n]+)| (h) line
+ (setq home h)))))
+ (let ((realname (string-trim
+ '(#\Space #\Newline)
+ (second (run "dscl . -read /Users/" sh-id
+ " RealName")))))
+ (properties* ensure uid gid shell home realname))))
+
+#+nil
+(probe (resource 'user "root") :gid)
+
+(define-syntax id<1>-tr ((#'parse-integer gid) name)
+ #~|([0-9]+)[(]([^)]+)|)
+
+(defmethod probe-user-groups ((user user) (os os-darwin))
+ (let ((id (resource-id user))
+ (groups nil))
+ (unless (eq :absent (get-probed user :ensure))
+ (let ((user-gid (get-probed user :gid))
+ (user-group nil))
+ (with-id<1>-tr (gid name) (run "id " (sh-quote id)
+ " | tr ' ,=' '\\n'")
+ (when gid
+ (when (= user-gid gid)
+ (setq user-group (resource 'group name)))
+ (push (resource 'group name) groups)))
+ (setq groups (sort groups #'string< :key #'resource-id)
+ groups (if user-group
+ (cons user-group
+ (remove (resource-id user-group)
+ groups :key #'resource-id
+ :test #'string=))
+ groups)
+ groups (remove-if (lambda (x)
+ (find (resource-id x)
+ '("_lpoperator"
+ "com.apple.access_ssh"
+ "com.apple.sharepoint.group.1"
+ "com.apple.sharepoint.group.2"
+ "everyone"
+ "localaccounts")
+ :test #'string=))
+ groups))))
+ (properties* groups)))
+
+#+nil
+(probe (resource 'user "root") :groups)
+
+(defmethod op-update-group ((group group) (os os-darwin) &key ensure gid)
+ (let ((id (resource-id group)))
+ (run-as-root
+ (join-str
+ " "
+ "dscl ."
+ (ecase ensure
+ ((:absent) "-delete")
+ ((:present) "-create")
+ ((nil) "-change"))
+ (str "/Groups/" (sh-quote id))
+ (when gid
+ `("PrimaryGroupID"
+ ,(unless ensure
+ (sh-quote (get-probed group :gid)))
+ ,(sh-quote gid)))))))
+
+(defmethod op-update-user ((user user) (os os-darwin)
+ &key ensure uid gid realname home shell
+ login-class groups)
+ (declare (ignore login-class))
+ (sync-groups)
+ (let* ((id (resource-id user))
+ (sh-id (sh-quote id)))
+ (when ensure
+ (run-as-root
+ "dscl . "
+ (ecase ensure
+ ((:absent) "-delete ")
+ ((:present) "-create "))
+ (str "/Users/" sh-id)))
+ (when uid
+ (run-as-root
+ "dscl . -create /Users/" sh-id
+ " UniqueID "
+ (sh-quote uid)))
+ (when gid
+ (run-as-root
+ "dscl . -create /Users/" sh-id
+ " PrimaryGroupID "
+ (sh-quote gid)))
+ (when home
+ (run-as-root
+ "dscl . -create /Users/" sh-id
+ " NFSHomeDirectory "
+ (sh-quote home)))
+ (when shell
+ (run-as-root
+ "dscl . -create /Users/" sh-id
+ " UserShell "
+ (sh-quote shell)))
+ (dolist (group (get-probed user :groups))
+ (unless (find (resource-id group) groups)
+ (run-as-root
+ "dscl . -delete /Groups/" (sh-quote (resource-id group))
+ " GroupMembership " sh-id)))
+ (dolist (group groups)
+ (run-as-root
+ "dscl . -append /Groups/" (sh-quote group)
+ " GroupMembership " sh-id))))
+
+#+nil
+(clear-resources)
+
+#+nil
+(describe-probed (resource 'openbsd-pkg "emacs"))
+
+#+nil
+(probe-host-packages *host* (host-os *host*))
+
+#+nil
+(probe *host* :packages)
+
+#+nil
+(map nil #'describe-probed (probe-installed-packages))
+
+#+nil
+(run "pkg_info -q | grep emacs-")
diff --git a/unix/debian.lisp b/unix/debian.lisp
index a9d3f54..734e4b9 100644
--- a/unix/debian.lisp
+++ b/unix/debian.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/unix/defs.lisp b/unix/defs.lisp
index 8592d5a..7bb5065 100644
--- a/unix/defs.lisp
+++ b/unix/defs.lisp
@@ -1,41 +1,26 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
;; Group
(define-resource-class group () ()
- ((probe-group-in-/etc/group :properties (:ensure :name :passwd :gid :members)))
+ ((probe-group :properties (:ensure :name :passwd :gid :members)))
((op-update-group :properties (:ensure :gid))))
-(defgeneric probe-group-in-/etc/group (resource os))
+(defgeneric probe-group (resource os))
(defgeneric op-update-group (resource os &key ensure gid))
;; User
(define-resource-class user (resource-container)
()
- ((probe-user-in-/etc/passwd :properties (:ensure :login :uid :gid :realname
- :home :shell))
- (probe-user-groups-in-/etc/group :properties (:groups)))
+ ((probe-user :properties (:ensure :login :uid :gid :realname
+ :home :shell))
+ (probe-user-groups :properties (:groups)))
((op-update-user :properties (:ensure :uid :gid :realname :home :shell
- :login-class :groups))))
+ :login-class :groups))))
(defgeneric probe-user-in-/etc/passwd (resource os))
(defgeneric probe-user-groups-in-/etc/group (resource os))
@@ -75,7 +60,7 @@
`(:md5 :rmd160 :sha1 :sha224 :sha256 :sha384 :sha512
,@*cksum-legacy-algorithms*)))
-(defvar *probe-file-content-size-limit* 8192)
+(defvar *probe-file-content-size-limit* (* 1024 1024))
(define-resource-class file (vnode)
()
@@ -86,11 +71,26 @@
:properties (,algorithm))
algorithms))
(nreverse algorithms)))
- ((op-file-ensure :properties (:ensure)))
- ((:op-properties (:ensure :mode :uid :gid :owner :group))))
+ ((op-file-ensure :properties (:ensure))
+ (op-file-content :properties (:content)))
+ ((:op-properties (:content :ensure :mode :uid :gid :owner :group))))
(defgeneric probe-file-content (resource os))
(defgeneric op-file-ensure (resource os &key ensure))
+(defgeneric op-file-content (resource os &key content))
+
+;; Symbolic link
+
+(define-resource-class symlink (vnode)
+ ()
+ ((probe-symlink-target :properties (:target)))
+ ((op-symlink-ensure :properties (:ensure))
+ (op-symlink-target :properties (:target)))
+ ((:op-properties (:ensure :target))))
+
+(defgeneric probe-symlink-target (resource os))
+(defgeneric op-symlink-ensure (resource os &key ensure))
+(defgeneric op-symlink-target (resource os &key target))
;; Directory
diff --git a/unix/freebsd.lisp b/unix/freebsd.lisp
index e279a38..9b34175 100644
--- a/unix/freebsd.lisp
+++ b/unix/freebsd.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -35,7 +20,7 @@
file)))
(defmethod probe-hostname ((host host) (os os-freebsd))
- (let ((hostname (first (run "hostname")))
+ (let ((hostname (run-1 "hostname"))
(rc-conf (get-sh-var "hostname" "/etc/rc.conf")))
(list :hostname (if (equal hostname rc-conf)
hostname
diff --git a/unix/linux.lisp b/unix/linux.lisp
index be4b6b3..4d2f441 100644
--- a/unix/linux.lisp
+++ b/unix/linux.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/unix/openbsd.lisp b/unix/openbsd.lisp
index ab3b13e..6ba2960 100644
--- a/unix/openbsd.lisp
+++ b/unix/openbsd.lisp
@@ -1,63 +1,111 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
(in-re-readtable)
+(defmethod echo-command ((host t) (os os-openbsd))
+ "echo -E -n ")
+
+(defmethod run-as-root-command ((host t) (os os-openbsd))
+ "doas ")
+
+(defmethod probe-hostname ((host host) (os os-openbsd))
+ (list :hostname (run-1 "hostname -s")))
+
(define-resource-class openbsd-pkg (pkg)
()
- ((probe-openbsd-pkg :properties (:versions))))
+ ((probe-openbsd-pkg :properties (:ensure :flavor :version)))
+ ((op-openbsd-pkg :properties (:ensure :version))))
-(define-syntax pkg_info<1> (name version)
- #~|\s*([^-\s]+(?:-[^-0-9\s][^-\s]*)*)-([0-9][^-\s]*(?:-[^\s]+)*)|
+(define-syntax pkg_info<1> (name version flavor installed)
+ #~|\s*([^-\s]+(?:-[^-0-9\s][^-\s]+)*)-([0-9][^-\s]*)(?:-([^-\s]+))?( \(installed\))?|
"Syntax for pkg_info(1) on OpenBSD"
- (values name (list version)))
+ (values name version flavor (and installed t)))
+
+(define-syntax openbsd-pkg-id (name version flavor)
+ #~|^(.*?)(?:-([0-9].*?))?(?::(.+))?$|
+ "Syntax for openbsd-pkg id")
(defgeneric probe-openbsd-pkg (resource os))
(defmethod probe-openbsd-pkg ((pkg openbsd-pkg) (os os-openbsd))
(let ((id (resource-id pkg))
(ensure :absent))
- (multiple-value-bind (versions)
- (with-pkg_info<1> (name versions)
- (run "pkg_info | egrep " (sh-quote (str "^" id "-")))
- (when (string= id name)
- (setf ensure :installed)
- (return (values versions))))
- (properties* ensure versions))))
-
-(defmethod merge-property-values ((pkg openbsd-pkg)
- (property (eql :versions))
- (old list)
- (new list))
- (sort (remove-duplicates (append old new))
- #'string<))
+ (with-openbsd-pkg-id (id-name id-version id-flavor) (list id)
+ (format t "~&id-name ~S id-flavor ~S~%" id-name id-flavor)
+ (multiple-value-bind (version flavor)
+ (with-pkg_info<1> (name version flavor installed)
+ (run "pkg_info | egrep " (sh-quote (str "^" id-name)))
+ (format t "~&name ~S version ~S flavor ~S installed ~S~%" name version flavor installed)
+ (when (and (string= id-name name)
+ (or (and (null id-flavor) (null flavor))
+ (and id-flavor flavor
+ (string= id-flavor flavor)))
+ (or (null id-version)
+ (string= id-version version)))
+ (setf ensure :installed)
+ (return (values version flavor))))
+ (return (properties* ensure version flavor))))))
+
+(defmethod match-specified-value ((res host)
+ (property (eql :packages))
+ (specified list)
+ (probed list)
+ (os os-openbsd))
+ (dolist (pkg-id specified)
+ (unless (find pkg-id probed :test #'string=)
+ (return-from match-specified-value nil)))
+ t)
+
+(defmethod op-openbsd-pkg ((pkg openbsd-pkg) (os os-openbsd) &key ensure version)
+ (with-openbsd-pkg-id (id-name id-version id-flavor) (list (resource-id pkg))
+ (setq version
+ (or version
+ id-version
+ (progn (probe pkg :version)
+ (get-probed pkg :version))))
+ (let ((pkg-string (str id-name
+ (when version
+ `(#\- ,version))
+ (when id-flavor
+ `(#\- ,id-flavor)))))
+ (cond
+ ((eq ensure :absent)
+ (run "pkg_delete " (sh-quote pkg-string)))
+ ((eq ensure :installed)
+ (run "pkg_add " (sh-quote pkg-string)))
+ (t
+ (error "unknown ensure value: ~S" ensure))))))
(defmethod probe-host-packages ((host host) (os os-openbsd))
(with-host host
- (let ((packages))
- (with-pkg_info<1> (name versions) (run "pkg_info")
- (let ((pkg (resource 'openbsd-pkg name)))
- (add-probed-properties pkg (properties* name versions))
- (push pkg packages)))
+ (let ((packages)
+ (ensure :installed))
+ (with-pkg_info<1> (name version flavor installed) (run "pkg_info")
+ (when (and name version)
+ (when flavor
+ (setq name (str name #\: flavor)))
+ (let ((pkg (resource 'openbsd-pkg name)))
+ (add-probed-properties pkg (properties* name version flavor ensure))
+ (push pkg packages))))
(list :packages (nreverse packages)))))
+(defmethod op-host-packages ((host host) (os os-openbsd) &key packages)
+ (with-host host
+ (dolist (pkg-id packages)
+ (with-openbsd-pkg-id (name version flavor) (list pkg-id)
+ (let ((pkg (resource 'openbsd-pkg pkg-id
+ :ensure :installed)))
+ (when version
+ (resource 'openbsd-pkg pkg-id
+ :version version))
+ (when flavor
+ (resource 'openbsd-pkg pkg-id
+ :flavor flavor))
+ (sync pkg))))))
+
#+nil
(clear-resources)
@@ -65,7 +113,10 @@
(describe-probed (resource 'openbsd-pkg "emacs"))
#+nil
-(probe-installed-packages)
+(probe-host-packages *host* (host-os *host*))
+
+#+nil
+(probe *host* :packages)
#+nil
(map nil #'describe-probed (probe-installed-packages))
diff --git a/unix/operations.lisp b/unix/operations.lisp
index ecfdfea..fdd219c 100644
--- a/unix/operations.lisp
+++ b/unix/operations.lisp
@@ -1,28 +1,35 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
+;; Echo
+
+(defgeneric echo-command (host os))
+
+(defmethod echo-command ((host t) (os t))
+ "echo -n ")
+
+(defun echo_ (&rest parts)
+ (let* ((host (current-host))
+ (cmd (echo-command host (host-os host))))
+ (str cmd (sh-quote parts))))
+
+(defun echo (&rest parts)
+ (run (echo_ parts)))
+
+;; Run as root
+
+(defgeneric run-as-root-command (host os))
+
+(defmethod run-as-root-command ((host t) (os os-unix))
+ "sudo ")
+
(defun run-as-root (&rest command)
- (apply #'run
- (unless (equal "root" (get-probed (current-host) :user))
- "sudo ")
- command))
+ (let* ((host (current-host))
+ (prefix (unless (equal "root" (get-probed host :user))
+ (run-as-root-command host (get-probed host :os)))))
+ (apply #'run prefix command)))
;; Host operations
@@ -43,20 +50,32 @@
;; User
+(defun sync-groups ()
+ (do-resources (res) (current-host)
+ (when (typep res 'group)
+ (sync res))))
+
(defmethod op-update-user ((user user) (os os-unix)
&key ensure uid gid realname home shell
login-class groups)
+ (sync-groups)
(run-as-root
(join-str " "
(ecase ensure
((:absent) "userdel")
- ((:present) "useradd -m")
+ ((:present) `("useradd"
+ ,(unless (eq :present
+ (get-probed
+ (resource 'directory (homedir
+ user))
+ :ensure))
+ "-m")))
((nil) "usermod"))
(when realname `("-c" ,(sh-quote realname)))
(when home `("-d" ,(sh-quote home)))
(when gid `("-g" ,(sh-quote gid)))
(when login-class `("-L" ,(sh-quote login-class)))
- (when groups `("-S" ,(join-str "," (mapcar #'sh-quote
+ (when groups `("-G" ,(join-str "," (mapcar #'sh-quote
groups))))
(when shell `("-s" ,(sh-quote shell)))
(when uid `("-u" ,(sh-quote uid)))
@@ -64,6 +83,30 @@
;; VNode
+(defgeneric vnode-owner (res))
+
+(defmethod vnode-owner ((res vnode))
+ (let ((owner-spec (get-specified res :owner)))
+ (when owner-spec
+ (resource 'user owner-spec))))
+
+(defgeneric vnode-group (res))
+
+(defmethod vnode-group ((res vnode))
+ (let ((group-spec (get-specified res :group)))
+ (when group-spec
+ (resource 'user group-spec))))
+
+(defgeneric sync-owner-and-group (res))
+
+(defmethod sync-owner-and-group ((res vnode))
+ (let ((owner (vnode-owner res))
+ (group (vnode-group res)))
+ (when group
+ (sync group))
+ (when owner
+ (sync owner))))
+
(defmethod op-chown ((res vnode) (os os-unix) &key uid gid owner group
&allow-other-keys)
(when (stringp owner)
@@ -74,20 +117,48 @@
(assert (= uid (get-probed owner :uid))))
(when (and gid group)
(assert (= gid (get-probed group :gid))))
+ (when group
+ (sync group))
+ (when owner
+ (sync owner))
(let ((u (or (when owner (resource-id owner))
uid))
(g (or (when group (resource-id group))
gid)))
- (run "chown " u (when g `(":" ,g)) " " (resource-id res))))
+ (run "chown "
+ (sh-quote u)
+ (when g `(":" ,(sh-quote g)))
+ " "
+ (sh-quote (resource-id res)))))
(defmethod op-chmod ((res vnode) (os os-unix) &key mode
&allow-other-keys)
+ (sync-owner-and-group res)
(run "chmod " (octal (mode-permissions mode)) " "
(sh-quote (resource-id res))))
;; File
+(defun path-parent-directory (&rest path-parts)
+ (let* ((path (the string (str path-parts)))
+ (sep (position #\/ path
+ :from-end t
+ :end (1- (length path))
+ :test #'char=)))
+ (if sep
+ (subseq path 0 sep)
+ "/")))
+
+(defgeneric parent-directory (x))
+
+(defmethod parent-directory ((res vnode))
+ (let* ((path (resource-id res))
+ (parent-path (path-parent-directory path)))
+ (resource 'directory parent-path)))
+
(defmethod op-file-ensure ((res file) (os os-unix) &key ensure)
+ (sync-owner-and-group res)
+ (sync (parent-directory res))
(let* ((id (resource-id res))
(sh-id (sh-quote id)))
(ecase ensure
@@ -95,10 +166,43 @@
((:present) (run "touch " sh-id))
((nil)))))
+(defmethod op-file-content ((res file) (os os-unix) &key content)
+ (sync-owner-and-group res)
+ (sync (parent-directory res))
+ (let ((id (resource-id res)))
+ (run (echo_ content) " > " (sh-quote id))
+ (when-let (after (get-specified res :after))
+ (funcall (the function after) res os))
+ (clear-probed res)))
+
+;; Symlink
+
+(defmethod op-symlink-ensure ((res symlink) (os os-unix)
+ &key ensure)
+ (sync-owner-and-group res)
+ (sync (parent-directory res))
+ (let* ((id (resource-id res))
+ (sh-id (sh-quote id))
+ (target (get-specified res :target))
+ (sh-target (sh-quote target)))
+ (ecase ensure
+ ((:absent) (run "rm " sh-id))
+ ((:present) (run "ln -s " sh-target " " sh-id))
+ ((nil)))))
+
+(defmethod op-symlink-target ((res symlink) (os os-unix)
+ &key target)
+ (let* ((id (resource-id res))
+ (sh-id (sh-quote id))
+ (sh-target (sh-quote target)))
+ (run "ln -sf " sh-target " " sh-id)))
+
;; Directory
(defmethod op-directory-ensure ((res directory) (os os-unix)
&key ensure)
+ (sync-owner-and-group res)
+ (sync (parent-directory res))
(let* ((id (resource-id res))
(sh-id (sh-quote id)))
(ecase ensure
diff --git a/unix/probes.lisp b/unix/probes.lisp
index 9af299e..4c62883 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -1,50 +1,29 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
;; Group
-(defmethod probe-group-in-/etc/group ((group group) (os os-unix))
+(defmethod probe-group ((group group) (os os-unix))
(let ((id (resource-id group))
(ensure :absent))
(multiple-value-bind #1=(name passwd gid members)
- (with-group<5> #1# (grep (str id) "/etc/group")
- (when (etypecase id
- (integer (= id gid))
- (string (string= id name)))
+ (with-group<5> #1# (egrep (str "^" id ":") "/etc/group")
+ (when (string= id name)
(setq ensure nil)
(return (values* #1#))))
(properties* (ensure . #1#)))))
;; User
-(defmethod probe-user-in-/etc/passwd ((user user) (os os-unix))
+(defmethod probe-user ((user user) (os os-unix))
(let ((id (resource-id user))
(ensure :absent))
(multiple-value-bind #1=(login pass uid gid realname home shell)
(with-passwd<5> #1#
- (etypecase id
- (integer (grep (str #\: id #\:) "/etc/passwd"))
- (string (egrep (str #\^ id #\:) "/etc/passwd")))
- (when (etypecase id
- (string (string= id login))
- (integer (= id uid)))
+ (egrep (str #\^ id #\:) "/etc/passwd")
+ (when (string= id login)
(with-parent-resource *host*
(setq ensure nil
home (resource 'directory home)
@@ -52,13 +31,11 @@
(return (values* #1#))))
(properties* (ensure . #1#)))))
-(defmethod probe-user-groups-in-/etc/group ((user user) (os os-unix))
+(defmethod probe-user-groups ((user user) (os os-unix))
(let ((id (resource-id user))
groups)
(unless (eq :absent (get-probed user :ensure))
- (let* ((user-login (if (stringp id)
- id
- (get-probed user :login)))
+ (let* ((user-login id)
(user-gid (get-probed user :gid))
(user-group nil))
(with-group<5> (name passwd gid members)
@@ -68,10 +45,14 @@
(cond ((= user-gid gid)
(setq user-group (resource 'group name)))
((find user-login members :test #'string=)
- (push (resource 'group name) groups))))
+ (unless (find name groups :key #'resource-id :test #'string=)
+ (push (resource 'group name) groups)))))
(setq groups (sort groups #'string< :key #'resource-id)
groups (if user-group
- (cons user-group groups)
+ (cons user-group
+ (remove (resource-id user-group)
+ groups :key #'resource-id
+ :test #'string=))
groups))))))
(properties* groups)))
@@ -80,13 +61,14 @@
(defmethod probe-vnode-using-ls ((vnode vnode) (os os-unix))
(let ((id (resource-id vnode))
(ensure :absent))
- (multiple-value-bind #1=(mode links owner group size mtime)
+ (multiple-value-bind #1=(mode links owner group size mtime target)
(with-ls<1>-lT #.(cons 'name '#1#)
- (ls "-ldT" (sh-quote id))
- (when (string= id name)
+ (ls "-ldT" id)
+ (when (string= id (the string name))
(setq mode (mode (mode-permissions mode))
owner (resource 'user owner)
group (resource 'group group)
+ size (parse-integer size)
ensure :present)
(return (values* #1#))))
(properties* (ensure . #1#)))))
@@ -99,16 +81,17 @@
(with-stat<1>-r (name . #1#) (stat "-r" (sh-quote id))
(when (and name (string= id (the string name)))
(setq mode (mode (mode-permissions mode))
+ size (parse-integer size)
ensure :present)
(return (values* #1#))))
(properties* (ensure . #1#)))))
;; Regular file
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (:compile-toplevel :load-toplevel)
(defparameter *cksum-defs* nil))
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (:compile-toplevel :load-toplevel)
(defun cksum-defs ()
(dolist (algorithm *cksum-algorithms*)
(declare (type symbol algorithm))
@@ -135,17 +118,25 @@
(setf *cksum-defs* (nreverse *cksum-defs*))
(push 'progn *cksum-defs*)))
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (:compile-toplevel :load-toplevel)
#.(cksum-defs))
(defmethod probe-file-content ((file file) (os os-unix))
(let* ((size (get-probed file :size))
(content (when size
(if (< size *probe-file-content-size-limit*)
- (run "cat " (sh-quote (resource-id file)))
+ (str (run "cat " (sh-quote (resource-id file))))
:file-too-large))))
(properties* content)))
+;; Symlink
+
+(defmethod probe-symlink-target ((symlink symlink) (os os-unix))
+ (let ((target (string-trim '(#\Newline)
+ (run-1 "readlink "
+ (sh-quote (resource-id symlink))))))
+ (properties* target)))
+
;; Directory
(defmethod probe-directory-content ((dir directory) (os os-unix))
@@ -195,12 +186,10 @@
(multiple-value-bind #1=(user pid cpu mem vsz rss tt state start time cmd)
(with-ps<1>-u #1# (run "ps auxww | grep " (sh-quote id))
(print #.(cons 'list '#1#))
- (when (typecase id
- (integer (= id pid))
- (string (and (<= (length id) (length cmd))
- (string= id cmd :end2 (length id))
- (or (= (length id) (length cmd))
- (char= #\Space (char cmd (length id)))))))
+ (when (and (<= (length id) (length cmd))
+ (string= id cmd :end2 (length id))
+ (or (= (length id) (length cmd))
+ (char= #\Space (char cmd (length id)))))
(return (values* #1#))))
(properties* #1#))))
diff --git a/unix/ssh.lisp b/unix/ssh.lisp
index f6c3c0a..0dda1af 100644
--- a/unix/ssh.lisp
+++ b/unix/ssh.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
diff --git a/unix/stat.lisp b/unix/stat.lisp
index 5297a8f..28ec881 100644
--- a/unix/stat.lisp
+++ b/unix/stat.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -143,5 +128,8 @@
(= (mode-fixnum value1) (mode-fixnum value2)))
(defmethod match-specified-value ((resource vnode) (property (eql :mode))
- specified probed)
- (= (mode-fixnum specified) (mode-fixnum probed)))
+ specified probed os)
+ (or (eq specified probed)
+ (and specified
+ probed
+ (= (mode-fixnum specified) (mode-fixnum probed)))))
diff --git a/unix/syntaxes.lisp b/unix/syntaxes.lisp
index 78cc79d..74b54aa 100644
--- a/unix/syntaxes.lisp
+++ b/unix/syntaxes.lisp
@@ -1,20 +1,5 @@
-;;
-;; adams - system administrator written in Common Lisp
-;;
-;; Copyright 2013,2014,2018 Thomas de Grivel <thoxdg@gmail.com>
-;;
-;; Permission to use, copy, modify, and distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all copies.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
+;; Adams - UNIX system administration tool written in Common Lisp
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
(in-package :adams)
@@ -25,12 +10,13 @@
(define-syntax group<5> (name passwd
(#'parse-integer gid)
((lambda (m) (cl-ppcre:split "," m)) members))
- #~|^([^:]*):([^:]*):([^:]*):([^:]*)$|
+ #~|^([^:]*):([^:]*):([^:]*):([^:\s]*)\s*$|
"Syntax of the group permissions file /etc/group. See group(5).")
(define-syntax passwd<5> (name pass
(#'parse-integer uid gid)
- realname home shell)
+ realname home
+ (#'strip-last-newline shell))
#~|^([^:]*):([^:]*):([^:]*):([^:]*):([^:]*):([^:]*):([^:]*)$|
"Syntax for the password file /etc/passwd. See passwd(5).")
@@ -40,10 +26,11 @@
group
(#'sh-parse-integer size)
(#'chronicity:parse time)
- name)
- #~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+ \S+ \S+ \S+)\s+(.+)$|
+ name
+ target)
+ #~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+\s+\S+ \S+ \S+)\s+(.+?)(?: -> (.*))?$|
"Syntax for `ls -lT` output. See ls(1)."
- (values name mode links owner group size time))
+ (values name mode links owner group size time target))
(define-syntax stat<1>-r ((#'sh-parse-integer
dev ino mode links uid gid rdev size)