devops: Specify just one (Debian) architecture in host declarations.

diff --git a/src/devops/build.scm b/src/devops/build.scm
index e475615bea306f5eb33b6f63b98cba237959a890..1c65e84d1216fd952cd96571dcff6e4b82ac4c71 100644 (file)
--- 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 02f45aa79bc4f92d01c116bc616d55f4df3db299..6d4a304c277d3d53d1294950b1749f0782761540 100644 (file)
--- 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 <host>
-    (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)))