[bug#30604] [PATCH v8 2/7] linux-modules: Add install-modules.

[Ludovic Courtès]

Danny Milosavljevic <address@hidden> skribis:

> * gnu/build/linux-modules.scm (install-modules): New procedure.
> (%not-dash): New variable.

We could reuse modules.alias and modules.devname from the ‘linux-libre’
package (right?), but I guess it doesn’t hurt to generate custom ones.

> +(define (install-module-files module-files output)
> +  "Install MODULE-FILES to OUTPUT.
> +Precondition: OUTPUT is an empty directory."
> +  (let ((aliases
> +         (map (lambda (module-file-name)
> +                (format #t "copying '~a'...~%" module-file-name)
> +                (copy-file module-file-name
> +                           (string-append output "/"
> +                                          (basename module-file-name)))
> +                `(,(file-name->module-name module-file-name) .
> +                  ,(module-aliases module-file-name)))
> +              (sort module-files string<))))
> +    (call-with-output-file (string-append output "/modules.alias")
> +      (lambda (port)
> +        (format port
> +                "# Aliases extracted from modules themselves.\n")
> +        (for-each (match-lambda ((module . aliases)
> +                                 (for-each (lambda (alias)
> +                                             (format port "alias ~a ~a\n" 
> alias
> +                                                     module))
> +                                           aliases)))
> +                  aliases)))
> +    (call-with-output-file (string-append output "/modules.devname")
> +      (lambda (port)
> +        (format port
> +                "# Device nodes to trigger on-demand module loading.\n")
> +        (let* ((aliases (append-map (match-lambda
> +                                     ((module . aliases) aliases))
> +                                    aliases))
> +               (devname #f))
> +          ;; Note: there's only one devname and then only one 
> (char-major|block-major).
> +          (for-each
> +           (match-lambda
> +            (((? (cut string-prefix? "devname:" <>) alias) . value)
> +             (set! devname (string-drop value (string-length "devname:"))))
> +            (((? (cut string-prefix? "char-major-" <>) alias) . value)
> +             (let ((parts (string-tokenize %not-dash)))
> +               (match parts
> +                      ((a b major minor)
> +                       (format port "~a ~a ~a:~a\n" devname "c" major 
> minor)))))
> +            (((? (cut string-prefix? "block-major-" <>) alias) . value)
> +             (let ((parts (string-tokenize %not-dash)))
> +               (match parts
> +                      ((a b major minor)
> +                       (format port "~a ~a ~a:~a\n" devname "b" major 
> minor)))))
> +            (_ #f))
> +           aliases))))))

I think we need different procedures here:

  (write-module-alias-database modules port)  ;for “modules.alias”
  (write-module-device-database modules port) ;for “modules.devname”

with docstrings.

I’m not sure we need ‘install-module-files’ itself.  Perhaps we can
inline it at the call site?

For the devname code, please avoid ‘set!’.  Instead you can thread the
current devname as the state of a loop:

  (let loop ((devname #f)
             (aliases aliases))
    (match aliases
      (() …)
      (((? devname-alias? devname) . rest)
       (loop devname rest))
      …))
       
The indentation of ‘match’ forms is wrong.  Would it be OK for you to
pass it through ./etc/indent-code.el?  (It’s non interactive, you don’t
need to actually use Emacs.)

Thanks,
Ludo’.