[bug#39602] Generate font catalogues for the X server

[Ivan Kozlov]

Is nobody interested in this? I don’t see any problems with the patch.

This must have been of concern at least once, judging by fonts-dir-file’s 
existence. The fontpath mechanism is the only way today to make the core 
(server-side) fonts work reasonably.

14.02.2020, 20:17, "Ivan Kozlov" <kanichos@yandex.ru>:
> Actually, I am sending this as a patch.
>
> This should produce a "share/fontpath.d" directory in the profile which is a 
> font catalogue as described in Xserver(1). Then the X server font path can be 
> set to include this catalogue and it will find the installed fonts. This 
> concerns all legacy X11 applications using the core fonts system, and most 
> importantly xterm.
>
> The hook ‘fonts-dir-file’ was originally added for this purpose as the 
> comments can tell; you would include e. g. "share/fonts/X11/misc" from the 
> profile in the font path, which is a union directory with symbolic links to 
> fonts that want to install there and a fonts.dir file describing all of them. 
> This has not been working for ages, since the X.org server stopped following 
> symbolic links to font files for security reasons. It should be removed.
>
> --- a/guix/profiles.scm 2020-01-01 13:03:15.579056969 +0300
> +++ b/guix/profiles.scm 2020-02-14 19:52:51.979902836 +0300
> @@ -1293,6 +1293,37 @@
>                      `((type . profile-hook)
>                        (hook . fonts-dir))))
>
> +(define (fontpath-file manifest)
> + (define build
> + #~(begin
> + (use-modules (srfi srfi-1) (srfi srfi-26) (guix build utils))
> + (let* ((top-font-dirs (filter file-exists?
> + (map (cut string-append <>
> + "/share/fonts")
> + '#$(manifest-inputs manifest))))
> + (font-dirs (append-map (lambda (dir)
> + (find-files dir
> + (lambda (file stat)
> + (and (eq? 'directory (stat:type stat))
> + (file-exists? (string-append file "/fonts.dir"))))
> + #:directories? #t)) top-font-dirs))
> + (fonpath-dir (string-append #$output "/share/fontpath.d")))
> + (mkdir-p fontpath-dir)
> + (chdir fontpath-dir)
> + (for-each (lambda (dir pri)
> + (symlink dir (string-append (basename dir) ":pri=" (number->string pri))))
> + font-dirs
> + (iota (length font-dirs) 1)))))
> + (gexp->derivation "fontpath.d" build
> + #:modules '((guix build utils)
> + (srfi srfi-1)
> + (srfi srfi-26))
> + #:local-build? #t
> + #:substitutable? #f
> + #:properties
> + `((type . profile-hook)
> + (hook . fontpath-dir))))
> +
>  (define (manual-database manifest)
>    "Return a derivation that builds the manual page database (\"mandb\") for
>  the entries in MANIFEST."
> @@ -1430,6 +1461,7 @@
>    (list info-dir-file
>          manual-database
>          fonts-dir-file
> + fontpath-file
>          ghc-package-cache-file
>          ca-certificate-bundle
>          glib-schemas