thodg/cl-unix-cybernetics

diff --git a/adams.asd b/adams.asd
index d6590f8..55be707 100644
--- a/adams.asd
+++ b/adams.asd
@@ -67,6 +67,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/unix/darwin.lisp b/unix/darwin.lisp
new file mode 100644
index 0000000..9a4a78c
--- /dev/null
+++ b/unix/darwin.lisp
@@ -0,0 +1,155 @@
+;;
+;;  adams - system administrator written in Common Lisp
+;;
+;;  Copyright 2013,2014,2018,2021 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.
+;;
+
+(in-package :adams)
+
+(in-re-readtable)
+
+(defmethod echo-command ((host t) (os os-darwin))
+  "echo -E -n ")
+
+(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))
+        (ensure :absent)
+        (uid nil)
+        (gid nil))
+    (multiple-value-bind (out status)
+        (run "dscl . -read /Users/" (sh-quote 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)))))
+      (properties* ensure uid gid))))
+
+#+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))))
+    (properties* groups)))
+
+#+nil
+(probe (resource 'user "root") :groups)
+
+(defmethod op-update-group ((group group) (os os-unix) &key ensure gid)
+  (run-as-root
+   (join-str " "
+             (ecase ensure
+               ((:absent)  "groupdel")
+               ((:present) "groupadd")
+               ((nil)      "groupmod"))
+             (when gid `("-g" ,(sh-quote gid)))
+             (sh-quote (resource-id group)))))
+
+(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) "dscl -create")
+               ((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 `("-G" ,(join-str "," (mapcar #'sh-quote
+                                                        groups))))
+             (when shell `("-s" ,(sh-quote shell)))
+             (when uid `("-u" ,(sh-quote uid)))
+             (sh-quote (resource-id user)))))
+
+#+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/defs.lisp b/unix/defs.lisp
index fb32d1b..580bc09 100644
--- a/unix/defs.lisp
+++ b/unix/defs.lisp
@@ -21,21 +21,21 @@
 ;;  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))
diff --git a/unix/probes.lisp b/unix/probes.lisp
index b749b1c..c4cf2ce 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -20,7 +20,7 @@
 
 ;;  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)
@@ -32,7 +32,7 @@
 
 ;;  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)
@@ -46,7 +46,7 @@
           (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))