add a way for chroots, containers etc. to get at parent hostattrs

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

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.