libgpg-error: Prevent silent miscompilation some systems.

* gnu/packages/gpg.scm
  (libgpgerror)[arguments]<#:phases>{cross-symlinks}: Only
  link to src/syscfg/lock-obj-pub.linux-gnu.h if the package
  is being compiled for a Linux target. Do not link either
  if the architecture is unknown, as the headers vary with
  the architecture.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
Maxime Devos 2021-07-14 13:12:54 +02:00 committed by Mathieu Othacehe
parent e444cf3ef4
commit deb4f0a595
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -18,6 +18,7 @@
;;; Copyright © 2018 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Fredrik Salomonsson <plattfot@posteo.net>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -77,6 +78,7 @@ (define-module (gnu packages gnupg)
#:use-module (guix build-system gnu)
#:use-module (guix build-system perl)
#:use-module (guix build-system python)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1))
(define-public libgpg-error
@ -94,27 +96,37 @@ (define-public libgpg-error
(build-system gnu-build-system)
(arguments
(if (%current-target-system)
`(#:modules ((ice-9 match)
(guix build gnu-build-system)
`(#:modules ((guix build gnu-build-system)
(guix build utils))
#:phases
(modify-phases %standard-phases
;; When cross-compiling, some platform specific properties cannot
;; be detected. Create a symlink to the appropriate platform
;; file. See Cross-Compiling section at:
;; file if required. Note that these platform files depend on
;; both the operating system and architecture!
;;
;; See Cross-Compiling section at:
;; https://github.com/gpg/libgpg-error/blob/master/README
(add-after 'unpack 'cross-symlinks
(lambda* (#:key target inputs #:allow-other-keys)
(let ((triplet
(match (string-take target
(string-index target #\-))
("armhf" "arm-unknown-linux-gnueabi")
("mips64el" "mips-unknown-linux-gnu")
(x
(string-append x "-unknown-linux-gnu")))))
(symlink
(string-append "lock-obj-pub." triplet ".h")
"src/syscfg/lock-obj-pub.linux-gnu.h"))))))
(lambda _
(define (link triplet source)
(symlink (string-append "lock-obj-pub." triplet ".h")
(string-append "src/syscfg/lock-obj-pub."
source ".h")))
,(let* ((target (%current-target-system))
(architecture
(string-take target (string-index target #\-))))
(cond ((target-linux? target)
(match architecture
("armhf"
`(link "arm-unknown-linux-gnueabi" "linux-gnu"))
("mips64el"
`(link "mips-unknown-linux-gnu" "linux-gnu"))
;; Don't always link to the "linux-gnu"
;; configuration, as this is not correct for
;; all architectures.
(_ #t)))
(#t #t)))))))
'()))
(native-inputs `(("gettext" ,gettext-minimal)))
(home-page "https://gnupg.org")