diff --git a/unix/openbsd.lisp b/unix/openbsd.lisp
index ab3b13e..ab7078d 100644
--- a/unix/openbsd.lisp
+++ b/unix/openbsd.lisp
@@ -20,27 +20,29 @@
(in-re-readtable)
+(defmethod probe-hostname ((host host) (os os-openbsd))
+ (list :hostname (first (run "hostname -s"))))
+
(define-resource-class openbsd-pkg (pkg)
()
- ((probe-openbsd-pkg :properties (:versions))))
+ ((probe-openbsd-pkg :properties (:versions :ensure :flavor))))
-(define-syntax pkg_info<1> (name version)
- #~|\s*([^-\s]+(?:-[^-0-9\s][^-\s]*)*)-([0-9][^-\s]*(?:-[^\s]+)*)|
- "Syntax for pkg_info(1) on OpenBSD"
- (values name (list version)))
+(define-syntax pkg_info<1> (name version flavor)
+ #~|\s*([^-\s]+(?:-[^-0-9\s][^-\s]*)*)-([0-9][^-\s]*)(?:-([^-\s]+))|
+ "Syntax for pkg_info(1) on OpenBSD")
(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)
+ (multiple-value-bind (version flavor)
+ (with-pkg_info<1> (name version flavor)
(run "pkg_info | egrep " (sh-quote (str "^" id "-")))
(when (string= id name)
(setf ensure :installed)
- (return (values versions))))
- (properties* ensure versions))))
+ (return (values version flavor))))
+ (properties* ensure version flavor))))
(defmethod merge-property-values ((pkg openbsd-pkg)
(property (eql :versions))
@@ -52,9 +54,9 @@
(defmethod probe-host-packages ((host host) (os os-openbsd))
(with-host host
(let ((packages))
- (with-pkg_info<1> (name versions) (run "pkg_info")
+ (with-pkg_info<1> (name version flavor) (run "pkg_info")
(let ((pkg (resource 'openbsd-pkg name)))
- (add-probed-properties pkg (properties* name versions))
+ (add-probed-properties pkg (properties* name version flavor))
(push pkg packages)))
(list :packages (nreverse packages)))))
diff --git a/unix/probes.lisp b/unix/probes.lisp
index 9af299e..b19bd6a 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -25,9 +25,7 @@
(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)))
+ (when (string= id name)
(setq ensure nil)
(return (values* #1#))))
(properties* (ensure . #1#)))))
@@ -39,12 +37,8 @@
(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)
@@ -56,9 +50,7 @@
(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 +60,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)))
@@ -195,12 +191,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#))))