diff options
-rw-r--r-- | src/host.lisp | 8 | ||||
-rw-r--r-- | src/package.lisp | 3 | ||||
-rw-r--r-- | src/property.lisp | 6 |
3 files changed, 17 insertions, 0 deletions
diff --git a/src/host.lisp b/src/host.lisp index cbc756d..f4f9ec2 100644 --- a/src/host.lisp +++ b/src/host.lisp @@ -70,6 +70,14 @@ values higher up the call stack.")) (make-instance 'unpreprocessed-host :hostattrs hostattrs :propspec propspec)) +(defun make-child-host (&key hostattrs propspec) + "Make a host object to represent a chroot, container or the like. +Called by properties which set up such subhosts, like CHROOT:OS-BOOTSTRAPPED." + (make-instance + 'unpreprocessed-host + :propspec propspec + :hostattrs (list* :parent-hostattrs (hostattrs *host*) hostattrs))) + (defmethod print-object ((host host) stream) (format stream "#.~S" `(make-instance ',(type-of host) diff --git a/src/package.lisp b/src/package.lisp index bcb83d2..b2e7b7f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -99,6 +99,8 @@ #:inapplicable-property #:get-hostattrs #:get-hostattrs-car + #:get-parent-hostattrs + #:get-parent-hostattrs-car #:push-hostattrs #:pushnew-hostattrs #:get-hostname @@ -124,6 +126,7 @@ #:host #:defhost #:make-host + #:make-child-host #:hostattrs #:preprocess-host diff --git a/src/property.lisp b/src/property.lisp index 1adebb4..ec73d26 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -415,6 +415,12 @@ Called by property :HOSTATTRS, :APPLY and :UNAPPLY subroutines." (defun get-hostattrs-car (k) (car (get-hostattrs k))) +(defun get-parent-hostattrs (k) + (getf (get-hostattrs :parent-hostattrs) k)) + +(defun get-parent-hostattrs-car (k) + (car (get-parent-hostattrs k))) + (defun push-hostattrs (k &rest vs) "Push new static informational attributes VS of type KEY. |