aboutsummaryrefslogtreecommitdiff
-*- mode: org; coding: utf-8; -*-

#+TITLE: What's left to do?
#+STARTUP: content hidestars

Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>

  Copying and distribution of this file, with or without modification,
  are permitted in any medium without royalty provided the copyright
  notice and this notice are preserved.

* MAYBE Add a substituter that uses the GNUnet DHT or [[http://libswift.org][libswift]]

Would be neat if binaries could be pushed to and pulled from the GNUnet DHT or
rather libswift (since DHTs aren’t suited for large payloads).  Guix users
would sign their binaries, and define which binaries they trust.

Use UPnP and similar to traverse NAT, like ‘filegive’ does.

* user interface
** add guile-ncurses interface

* extend <package>
** add ‘recommends’ field

For instance, glibc, binutils, gcc, and ld-wrapper would recommend each other.
‘guix package -i’ could ask interactively (?), or allow users to follow all or
none of the recommendations.

** add a ‘user-environment-hook’

This should specify builder code to be run when building a user
environment with ‘guix-package’.  For instance, Texinfo’s hook would
create a new ‘dir’.

** extend ‘propagated-build-inputs’ with support for multiple outputs

#+BEGIN_SRC scheme
  (outputs '("out" "include"))
  (propagated-build-inputs
    `(((("i1" ,p1 "o1")
        ("i2" ,p2))
       => "include")
      ("i3" ,p3)))
#+END_SRC

* synchronize non-GNU package descriptions with the [[http://directory.fsf.org][FSD]]

Meta-data for GNU packages, including descriptions and synopses, can be
dumped from the FSD:
http://directory.fsf.org/wiki?title=GNU/Export&action=purge .
We could periodically synchronize with that.

* add a guildhall build system

The Guildhall is Guile’s packaging system.  It should be easy to add a
‘guildhall-build-system’ that does the right thing based on guildhall
recipes.

* union

Support sophisticated collision handling when building a union: honor
per-package priorities, etc.

* add GUIX_ALLOW_EXPENSIVE_TESTS

Tests that need to download stuff or otherwise take a long time would only be
run when that is defined.

* guix build utils
** MAYBE Change ‘ld-wrapper’ to add RPATH for libs passed by file name

** MAYBE Add equivalent to chrpath that uses [[https://gitorious.org/guile-dlhacks/guile-dlhacks/][guile-dlhacks]]

** MAYBE Add a hash-rewriting thing for deep dependency replacement without rebuild

See [[https://github.com/NixOS/nixpkgs/commit/d1662d715514e6ef9d3dc29f132f1b3d8e608a18][Shea Levy's `replace-dependency' in Nixpkgs]].

* distro
** port to GNU/Hurd, aka. ‘i686-gnu’

Problems include that current glibc releases do not build on GNU/Hurd.
In addition, there haven’t been stable releases of GNU Mach, MiG, and
Hurd, which would be a pre-condition.

* Installer
** Fix impossibility to restart on error after cow-store has been started
See https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
- Force reboot upon installer failure
- Unshare the installer process
- Run the installer process in a separate namespace
** Partitioning
*** Add RAID support
*** Add more partitioning schemes
The actual schemes are taken from Debian Installer but some are not
implemented yet: like "Separate partitions for /home /var and /tmp".
*** Replace wait page "Partition formating is in progress, please wait"
Create a new waiting page describing what's being done:

[              20%              ]
Running mkfs.ext4 on /dev/sda2 ...

[              40%              ]
Running mkfs.ext4 on /dev/sda3 ...
*** Add a confirmation page before formating/partitioning
** Desktop environments
*** Allow for no desktop environments
Propose to choose between "headless server" and "lightweight X11" in a new
page.
*** Add services selection feature
Add a services page to the configuration. Ask for services to be installed
like SSH, bluetooth, TLP in a checkbox list?
** Locale and keymap
*** Try to guess user locale and keymap by probing BIOS or HW (dmidecode)
** Timezone
*** Regroup everything in one single page
Under the form:
(UTC + 1) Europe/Paris
(UTC + 2) Africa/Cairo
...
** Display issue
*** Investigate display issue described here:
https://lists.gnu.org/archive/html/guix-devel/2019-01/msg00305.html
8'>128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services herd)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:export (%shepherd-socket-file

            shepherd-error?
            service-not-found-error?
            service-not-found-error-service
            action-not-found-error?
            action-not-found-error-service
            action-not-found-error-action
            action-exception-error?
            action-exception-error-service
            action-exception-error-action
            action-exception-error-key
            action-exception-error-arguments
            unknown-shepherd-error?
            unknown-shepherd-error-sexp

            live-service?
            live-service-provision
            live-service-requirement
            live-service-running

            current-services
            unload-services
            unload-service
            load-services
            start-service
            stop-service))

;;; Commentary:
;;;
;;; This module provides an interface to the GNU Shepherd, similar to the
;;; 'herd' command.  Essentially it implements a subset of the (shepherd comm)
;;; module, but focusing only on the parts relevant to 'guix system
;;; reconfigure'.
;;;
;;; Code:

(define %shepherd-socket-file
  (make-parameter "/var/run/shepherd/socket"))

(define* (open-connection #:optional (file (%shepherd-socket-file)))
  "Open a connection to the daemon, using the Unix-domain socket at FILE, and
return the socket."
  ;; The protocol is sexp-based and UTF-8-encoded.
  (with-fluids ((%default-port-encoding "UTF-8"))
    (let ((sock    (socket PF_UNIX SOCK_STREAM 0))
          (address (make-socket-address PF_UNIX file)))
      (catch 'system-error
        (lambda ()
          (connect sock address)
          (setvbuf sock _IOFBF 1024)
          sock)
        (lambda args
          (close-port sock)
          (apply throw args))))))

(define-syntax-rule (with-shepherd connection body ...)
  "Evaluate BODY... with CONNECTION bound to an open socket to PID 1."
  (let ((connection (open-connection)))
    body ...))

(define-condition-type &shepherd-error &error
  shepherd-error?)

(define-condition-type &service-not-found-error &shepherd-error
  service-not-found-error?
  (service service-not-found-error-service))

(define-condition-type &action-not-found-error &shepherd-error
  action-not-found-error?
  (service action-not-found-error-service)
  (action  action-not-found-error-action))

(define-condition-type &action-exception-error &shepherd-error
  action-exception-error?
  (service action-exception-error-service)
  (action  action-exception-error-action)
  (key     action-exception-error-key)
  (args    action-exception-error-arguments))

(define-condition-type &unknown-shepherd-error &shepherd-error
  unknown-shepherd-error?
  (sexp   unknown-shepherd-error-sexp))

(define (raise-shepherd-error error)
  "Raise an error condition corresponding to ERROR, an sexp received by a
shepherd client in reply to COMMAND, a command object.  Return #t if ERROR
does not denote an error."
  (match error
    (('error ('version 0 x ...) 'service-not-found service)
     (raise (condition (&service-not-found-error
                        (service service)))))
    (('error ('version 0 x ...) 'action-not-found action service)
     (raise (condition (&action-not-found-error
                        (service service)
                        (action action)))))
    (('error ('version 0 x ...) 'action-exception action service
             key (args ...))
     (raise (condition (&action-exception-error
                        (service service)
                        (action action)
                        (key key) (args args)))))
    (('error . _)
     (raise (condition (&unknown-shepherd-error (sexp error)))))
    (#f                                           ;not an error
     #t)))

(define (display-message message)
  (format (current-error-port) "shepherd: ~a~%" message))

(define* (invoke-action service action arguments cont)
  "Invoke ACTION on SERVICE with ARGUMENTS.  On success, call CONT with the
list of results (one result per instance with the name SERVICE).  Otherwise
return #f."
  (with-shepherd sock
    (write `(shepherd-command (version 0)
                              (action ,action)
                              (service ,service)
                              (arguments ,arguments)
                              (directory ,(getcwd)))
           sock)
    (force-output sock)

    (match (read sock)
      (('reply ('version 0 _ ...) ('result result) ('error #f)
               ('messages messages))
       (for-each display-message messages)
       (cont result))
      (('reply ('version 0 x ...) ('result y) ('error error)
               ('messages messages))
       (for-each display-message messages)
       (raise-shepherd-error error)
       #f)
      (x
       ;; invalid reply
       #f))))

(define-syntax-rule (with-shepherd-action service (action args ...)
                      result body ...)
  (invoke-action service action (list args ...)
                 (lambda (result) body ...)))

(define-syntax alist-let*
  (syntax-rules ()
    "Bind the given KEYs in EXP to the corresponding items in ALIST.  ALIST
is assumed to be a list of two-element tuples rather than a traditional list
of pairs."
    ((_ alist (key ...) exp ...)
     (let ((key (and=> (assoc-ref alist 'key) car)) ...)
       exp ...))))

;; Information about live Shepherd services.
(define-record-type <live-service>
  (live-service provision requirement running)
  live-service?
  (provision    live-service-provision)           ;list of symbols
  (requirement  live-service-requirement)         ;list of symbols
  (running      live-service-running))            ;#f | object

(define (current-services)
  "Return the list of currently defined Shepherd services, represented as
<live-service> objects.  Return #f if the list of services could not be
obtained."
  (with-shepherd-action 'root ('status) results
    ;; We get a list of results, one for each service with the name 'root'.
    ;; In practice there's only one such service though.
    (match results
      ((services _ ...)
       (match services
         ((('service ('version 0 _ ...) _ ...) ...)
          (map (lambda (service)
                 (alist-let* service (provides requires running)
                   (live-service provides requires running)))
               services))
         (x
          #f))))))

(define (unload-service service)
  "Unload SERVICE, a symbol name; return #t on success."
  (with-shepherd-action 'root ('unload (symbol->string service)) result
    (first result)))

(define (%load-file file)
  "Load FILE in the Shepherd."
  (with-shepherd-action 'root ('load file) result
    (first result)))

(define (eval-there exp)
  "Eval EXP in the Shepherd."
  (with-shepherd-action 'root ('eval (object->string exp)) result
    (first result)))

(define (load-services files)
  "Load and register the services from FILES, where FILES contain code that
returns a shepherd <service> object."
  (eval-there `(register-services
                ,@(map (lambda (file)
                         `(primitive-load ,file))
                       files))))

(define (start-service name)
  (with-shepherd-action name ('start) result
    result))

(define (stop-service name)
  (with-shepherd-action name ('stop) result
    result))

;; Local Variables:
;; eval: (put 'alist-let* 'scheme-indent-function 2)
;; eval: (put 'with-shepherd 'scheme-indent-function 1)
;; eval: (put 'with-shepherd-action 'scheme-indent-function 3)
;; End:

;;; herd.scm ends here