Commit e5a1093e5bdf4e50235323c2a797ce5de4d1a718
2020-03-18T11:04:00
fix openbsd package installation with version specified in package id
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
diff --git a/core/resource.lisp b/core/resource.lisp
index dc27ace..d5ea4e5 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -177,7 +177,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
@@ -202,6 +202,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))))))
diff --git a/core/spec.lisp b/core/spec.lisp
index 31c690a..4d063c4 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -97,14 +97,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
@@ -126,7 +127,7 @@ Second value lists properties in line with spec. Format is
(specified (pop specified-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/unix/openbsd.lisp b/unix/openbsd.lisp
index acc4cef..64908d3 100644
--- a/unix/openbsd.lisp
+++ b/unix/openbsd.lisp
@@ -33,8 +33,8 @@
"Syntax for pkg_info(1) on OpenBSD"
(values name version flavor (and installed t)))
-(define-syntax openbsd-pkg-id (name flavor)
- #~|^([^:]+)(?::(.+)$)?|
+(define-syntax openbsd-pkg-id (name version flavor)
+ #~|^(.*?)(?:-([0-9].*?))?(?::(.+))?$|
"Syntax for openbsd-pkg id")
(defgeneric probe-openbsd-pkg (resource os))
@@ -42,18 +42,19 @@
(defmethod probe-openbsd-pkg ((pkg openbsd-pkg) (os os-openbsd))
(let ((id (resource-id pkg))
(ensure :absent))
- (with-openbsd-pkg-id (id-name id-flavor) (list id)
+ (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 -Q " (sh-quote id-name))
+ (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))))
- (when installed
- (setf ensure :installed))
+ (string= id-flavor flavor)))
+ (or (null id-version)
+ (string= id-version version)))
+ (setf ensure :installed)
(return (values version flavor))))
(return (properties* ensure version flavor))))))
@@ -64,14 +65,29 @@
(sort (remove-duplicates (append old new))
#'string<))
+(defmethod match-specified-value ((res host)
+ (property (eql :packages))
+ (specified list)
+ (probed list)
+ (os os-openbsd))
+ (format t "~&match-specified-value specified ~S~%" specified)
+ (format t "~&match-specified-value probed ~S~%" probed)
+ (force-output)
+ (with-openbsd-pkg-id (name version flavor) specified
+ (unless (find name probed :test #'string=)
+ (return nil)))
+ t)
+
(defmethod op-openbsd-pkg ((pkg openbsd-pkg) (os os-openbsd) &key ensure)
- (with-openbsd-pkg-id (id-name id-flavor) (list (resource-id pkg))
- (when id-flavor
+ (with-openbsd-pkg-id (id-name id-version id-flavor) (list (resource-id pkg))
+ (when (and id-flavor (not id-version))
(probe pkg :version))
(let ((pkg-string (str id-name
+ (when (or id-version id-flavor)
+ `(#\- ,(or id-version
+ (get-probed pkg :version))))
(when id-flavor
- `(#\- ,(get-probed pkg :version)
- #\- ,id-flavor)))))
+ `(#\- ,id-flavor)))))
(cond
((eq ensure :absent)
(run "pkg_delete " (sh-quote pkg-string)))
@@ -95,8 +111,15 @@
(defmethod op-host-packages ((host host) (os os-openbsd) &key packages)
(with-host host
- (dolist (id packages)
- (let ((pkg (resource 'openbsd-pkg id :ensure :installed)))
+ (with-openbsd-pkg-id (name version flavor) packages
+ (let ((pkg (resource 'openbsd-pkg name
+ :ensure :installed)))
+ (when version
+ (resource 'openbsd-pkg name
+ :version version))
+ (when flavor
+ (resource 'openbsd-pkg name
+ :flavor flavor))
(sync pkg)))))
#+nil
diff --git a/unix/stat.lisp b/unix/stat.lisp
index 5297a8f..703ffea 100644
--- a/unix/stat.lisp
+++ b/unix/stat.lisp
@@ -143,5 +143,5 @@
(= (mode-fixnum value1) (mode-fixnum value2)))
(defmethod match-specified-value ((resource vnode) (property (eql :mode))
- specified probed)
+ specified probed os)
(= (mode-fixnum specified) (mode-fixnum probed)))