[bug#36382] A service for adding support for running portable binaries built for most linux distributions that use the filesystem hierarchy standard

[Efraim Flashner]

I've added some inline notes. My computer isn't powerful enough to
really test it out, but I've heard that you've had success with it as it
currently is.


On Wed, Jun 26, 2019 at 12:00:38AM +0100, address@hidden wrote:
> Hi Guix, for a while now I have been using a service I wrote that allows you 
> to run portable binaries, such as AppImages, which expect to be run on 
> distros that respect the filesystem hierarchy standard i.e store required 
> libraries in /usr, /lib, etc, which is most distros.
> 
> I think it could be a valuable tool to have in Guix, as it allows you to run 
> software that hasn't yet been packaged in Guix that is distributed as 
> binaries by the author. Also, if builds are failing in Guix, it's useful to 
> have the alternative - for example, calibre currently can't be built due to 
> build failure of a dependency (qtwebkit), so I use the Calibre tar bundle 
> distributed by the website for now.
> 
> This still requires some work before it's ready for inclusion in Guix - 
> decisions on how it's implemented need to be made, and the code needs 
> cleanup. But if I don't submit it in it's imperfect state, i won't get 
> anything done on it.
> 
> I've done a little writeup on how it works here: 
> http://miha.info/2019/June/24/guix-fhs-service
> 
> I've attached a patch for it. To build a guix system with it, add to the guix 
> system services:
> 
> (service fhs-binaries-compatibility-service-type
>   (fhs-configuration
>     (lib-packages <list of package objects to provide libraries for the 
> binaries>)
>     (additional-special-files <more special files to add>)
>     (additional-profile-packages <packages to add to system profile>)))
> 
> The additional-special-files and additional-profile-packages are functionally 
> exactly the same as using special-files-service-type and profile-service-type 
> separately, it's purely for organising the config so the admin knows why 
> those special files and profile packages were added.
> 
> 
> 
> 
> 

> diff --git a/gnu/services/fhs.scm b/gnu/services/fhs.scm
> new file mode 100644
> index 0000000..9ca6ab9
> --- /dev/null
> +++ b/gnu/services/fhs.scm
> @@ -0,0 +1,140 @@
> +(define-module (gnu services fhs)
> +  #:use-module (ice-9 ftw) ;; for creating recursive list of directories of 
> libs for FHS  #:use-module (guix download)
> +  #:use-module (srfi srfi-1) ;; For filter-map
> +  #:use-module (guix records) ;; For defining record types
> +  #:use-module (guix profiles) ;; for  manifest-entries
> +  #:use-module (gnu services) ;; For defining services
> +  #:use-module (guix gexp) ;; For computed-file and other things
> +  #:use-module (guix packages) ;; For package
> +  #:use-module (gnu packages) ;; For specifications->manifest
> +  #:use-module (gnu packages base) ;; For glibc
> +
> +  #:export (fhs-binaries-compatibility-service-type
> +            fhs-binaries-compatibility-service
> +            fhs-configuration))
> +
> +(define (32bit-package pkg)
> +  (package (inherit pkg)
> +           (name (string-append (package-name pkg) "-i686-linux"))
> +        (arguments
> +         `(#:system "i686-linux"
> +           ,@(package-arguments pkg)))))

This one should probably be parameterized so x86_64 -> i686 and
aarch64 -> armhf. Duplicating it and making one i686-package and the
second armhf-package would be easier though.

> +
> +(define glibc-for-fhs
> +  (package (inherit glibc)
> +           (name "glibc-for-fhs") ;; Maybe rename this to 
> "glibc-with-ldconfig-for-fhs"
> +           (source (origin
> +                    (inherit (package-source glibc))
> +                    (snippet #f))))) ;; Re-enable ldconfig
> +
> +
> +(define (packages->ld.so.conf packages)
> +  (computed-file
> +   "ld.so.conf"
> +   (with-imported-modules
> +    `((guix build union)
> +      (guix build utils))
> +    #~(begin
> +        (use-modules (guix build union)
> +                     (guix build utils))
> +        (let* ((packages '#$packages) ;; Need to quote "#$packages" as 
> #$packages tries to "apply" the first item to the rest, like a procedure.
> +               (find-lib-directories-in-single-package
> +                (lambda (package)
> +                  (find-files (string-append package "/lib")
> +                              (lambda (file stat)
> +                                ;; setting keyword "stat" to "stat" means it 
> will follow
> +                                ;; symlinks, unlike what it's set to by 
> default ("lstat").
> +                                (eq? 'directory (stat:type stat)))
> +                              #:stat stat
> +                              #:directories? #t)))
> +               (find-lib-directories-in-all-packages
> +                (lambda (packages)
> +                  (apply append ;; Concatenate the directory lists from 
> "map" into one list
> +                         (map (lambda (package)
> +                                (find-lib-directories-in-single-package 
> package))
> +                              packages))))
> +               (fhs-lib-dirs
> +                 (find-lib-directories-in-all-packages packages)))
> +               (with-output-to-file
> +                   #$output
> +                 (lambda _
> +                   (format #t
> +                           (string-join fhs-lib-dirs "\n"))
> +                   #$output)))))))
> +
> +(define (ld.so.conf->ld.so.cache ld-conf)
> +  (computed-file "ld.so.cache"
> +                 (with-imported-modules `((guix build utils))
> +                                        #~(begin
> +                                            (use-modules (guix build utils))
> +                                            (let* ((ldconfig (string-append 
> #$glibc-for-fhs "/sbin/ldconfig")))
> +                                              (invoke ldconfig
> +                                                      "-X" ;; Don't update 
> symbolic links
> +                                                      "-f" #$ld-conf ;; Use 
> #$configuration as configuration file
> +                                                      "-C" #$output)))))) ;; 
> Use #$output as cache file
> +
> +(define (packages->ld.so.cache packages)
> +  (ld.so.conf->ld.so.cache (packages->ld.so.conf packages)))
> +
> +(define-record-type* <fhs-configuration>
> +  fhs-configuration
> +  make-fhs-configuration
> +  fhs-configuration?
> +  (lib-packages                   fhs-configuration-lib-packages
> +                                  (default '()))
> +  (additional-profile-packages    
> fhs-configuration-additional-profile-packages ;; For putting programs in 
> $PATH and for share data
> +                                  (default '()))
> +  (additional-special-files       fhs-configuration-additional-special-files
> +                                  (default '())))
> +
> +(define* (union name packages #:key options)
> +  (computed-file name
> +                 (with-imported-modules `((guix build union))
> +                                        #~(begin
> +                                            (use-modules (guix build union))
> +                                            (union-build #$output 
> '#$packages)))
> +                 #:options options))
> +
> +(define* (fhs-libs-union packages #:key system)
> +  (let* ((name (if system
> +                   (string-append "fhs-libs-" system)
> +                   "fhs-libs")))
> +    (union name
> +           packages
> +           #:options `(#:system ,system))))
> +
> +(define (fhs-special-files-service config)
> +  "Return the list of special files for the fhs service"
> +  (let* ((fhs-lib-packages (fhs-configuration-lib-packages config))
> +         (fhs-lib-package-unions (append fhs-lib-packages
> +                                         `(,(fhs-libs-union fhs-lib-packages 
> #:system "i686-linux"))))

The following might work, but likely needs tweaking

,(match %current-system
  ("x86_64-linux"
    (fhs-libs-union fhs-lib-packages #:system "i686-linux"))
  ("aarch64-linux"
    (fhs-libs-union fhs-lib-packages #:system "armhf-linux"))
  (_
    '()))


> +         (fhs-glibc-special-files
> +          `(("/etc/ld.so.cache" ,(packages->ld.so.cache 
> fhs-lib-package-unions))
> +            ("/etc/ld.so.conf" ,(packages->ld.so.conf 
> fhs-lib-package-unions)) ;;Not needed to function, but put it here anyway for 
> debugging purposes

Can the two above be rewritten as etc-service-type configs?
               (simple-service 'ld.so.cache etc-service-type
                               `(("ld.so.cache" ,(package->ld.so.cache 
fhs-lib-package-unions))))
               (simple-service 'ld.so.conf etc-service-type
                               `(("ld.so.conf" ,(package->ld.so.conf 
fhs-lib-package-unions))))

> +            ("/lib64/ld-linux-x86-64.so.2" ,(file-append (canonical-package 
> glibc-for-fhs) "/lib/ld-linux-x86-64.so.2"))
> +            ("/lib/ld-linux.so.2" ,(file-append (canonical-package 
> (32bit-package glibc-for-fhs)) "/lib/ld-linux.so.2"))))

This I'd probably go with match also and point you at (gnu packages
bootstrap) for the other ones.

> +         ;;             ("/fhs/libs" ,(file-append (canonical-package 
> fhs-libs-64) "/lib"))
> +         (fhs-additional-special-files 
> (fhs-configuration-additional-special-files config)))
> +    (append fhs-glibc-special-files
> +            fhs-additional-special-files)))
> +
> +(define (fhs-profile-service config)
> +  "Return the list of packages to add to the system profile"
> +  ;; Get list of packages from config to add to system profile and return 
> them
> +  (fhs-configuration-additional-profile-packages config))
> +
> +
> +(define fhs-binaries-compatibility-service-type
> +  (service-type (name 'fhs-compatibility-service)
> +                (extensions
> +                 (list (service-extension special-files-service-type
> +                                          fhs-special-files-service)
> +                       (service-extension profile-service-type
> +                                          fhs-profile-service)
> +                       ))
> +                (description
> +                 "Support binaries compiled for the filesystem hierarchy 
> standard.")
> +                (default-value (fhs-configuration))))
> +

This one you probably don't need since we want all the services to be
foo-bar-service-type.

> +(define fhs-binaries-compatibility-service
> +  (service fhs-binaries-compatibility-service-type))

One last note, since I don't want to go back and re-edit all my previous
notes: I would change the service to take an architecture keyword, so
that this can be combined with the qemu-binfmt service without having to
do fancy footwork to see which architectures are supported and which
ones aren't at any given time on a machine.

Then someone could put:

(service fhs-binaries-compatibility-service-type
  config =>
  (fhs-configuration
    (inherit config)
    (architectures '("x86_64-linux" "i686-linux" "armhf-linux"))))

I don't think I'd go so far as to extend the binfmt service though, but
that's just me. I'm not sure how that'd work with someone explicitly
adding some other architectures and marking 'with-guix-support #t'

-- 
Efraim Flashner   <address@hidden>   אפרים פלשנר
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted

signature.asc
Description: PGP signature