1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
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)))))
(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"))))
(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
("/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"))))
;; ("/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))))
(define fhs-binaries-compatibility-service
(service fhs-binaries-compatibility-service-type))
|