From e1fcc777ff23d8dd1a704ae2d4b372c22529ca08 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Mon, 11 Sep 2017 19:16:16 -0700 Subject: [PATCH] devops: Specify just one (Debian) architecture in host declarations. --- src/devops/build.scm | 2 +- src/devops/devops.scm | 14 +++++++++----- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/devops/build.scm b/src/devops/build.scm index e475615be..1c65e84d1 100644 --- a/src/devops/build.scm +++ b/src/devops/build.scm @@ -184,7 +184,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (find (lambda (line) (string=? "DISTRIB_ID=Ubuntu" line)) (file-lines "/etc/lsb-release")))) -(define (debian-architecture) +(define (read-debian-architecture) (car (shell-lines "dpkg-architecture -qDEB_TARGET_ARCH"))) (load-option 'regular-expression) diff --git a/src/devops/devops.scm b/src/devops/devops.scm index 02f45aa79..6d4a304c2 100644 --- a/src/devops/devops.scm +++ b/src/devops/devops.scm @@ -544,7 +544,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (close-output-port i/o)) (define (verify-host-debian-architecture host i/o) - (let ((darch (read-reply '(debian-architecture) i/o))) + (let ((darch (read-reply '(read-debian-architecture) i/o))) (if (not (string? darch)) (error "no Debian architecture")) (if (not (string=? darch (host-debian-architecture host))) @@ -648,14 +648,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (name plugin-name) (directory plugin-directory)) -(define (host name user directory sarch darch os) +(define (host name user directory arch os) (let ((duplicate (find (lambda (h) (string=? name (host-name h))) host-list))) (if duplicate (error (string "Host "name" already defined.")))) (set! host-list (append! host-list - (list (make-host name user directory sarch darch os)))) + (list (make-host name user directory arch os)))) unspecific) (define (hosts) (list-copy host-list)) @@ -673,18 +673,22 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. n))) (define-record-type - (make-host name user directory sarch darch os) + (make-host name user directory darch os) host? (name host-name) (user host-user) (directory host-directory) - (sarch host-scheme-architecture) (darch host-debian-architecture) (os host-os)) (define (host-ubuntu? host) (os-ubuntu? (host-os host))) +(define (host-scheme-architecture darch) + (cond ((string=? "amd64" darch) "x86-64") + ((string=? "i386" darch) "i386") + (else (error "unknown Debian architecture:" darch)))) + (define (host-ubuntu-codename host) (ubuntu-os-codename (host-os host))) -- 2.25.1