aboutsummaryrefslogtreecommitdiff
Important: to avoid polarizing/hurtful discussions in our public spaces, any
matter pertaining to our use of this Code of Conduct should be brought
privately to the Guix maintainers at guix-maintainers@gnu.org.  Failure to do
so will be considered as a violation of this Code of Conduct.

Contributor Covenant Code of Conduct

Our Pledge
We as members, contributors, and leaders pledge to make participation in our
community a harassment-free experience for everyone, regardless of age, body
size, visible or invisible disability, ethnicity, sex characteristics, gender
identity and expression, level of experience, education, socio-economic status,
nationality, personal appearance, race, caste, color, religion, or sexual
identity and orientation.
We pledge to act and interact in ways that contribute to an open, welcoming,
diverse, inclusive, and healthy community.
Our Standards
Examples of behavior that contributes to a positive environment for our
community include:

* Demonstrating empathy and kindness toward other people
* Being respectful of differing opinions, viewpoints, and experiences
* Giving and gracefully accepting constructive feedback
* Accepting responsibility and apologizing to those affected by our mistakes,
and learning from the experience
* Focusing on what is best not just for us as individuals, but for the overall
community

Examples of unacceptable behavior include:

* The use of sexualized language or imagery, and sexual attention or advances of
any kind
* Trolling, insulting or derogatory comments, and personal or political attacks
* Public or private harassment
* Publishing others’ private information, such as a physical or email address,
without their explicit permission
* Other conduct which could reasonably be considered inappropriate in a
professional setting

Enforcement Responsibilities
Community leaders are responsible for clarifying and enforcing our standards of
acceptable behavior and will take appropriate and fair corrective action in
response to any behavior that they deem inappropriate, threatening, offensive,
or harmful.
Community leaders have the right and responsibility to remove, edit, or reject
comments, commits, code, wiki edits, issues, and other contributions that are
not aligned to this Code of Conduct, and will communicate reasons for moderation
decisions when appropriate.
Scope
This Code of Conduct applies within all community spaces, and also applies when
an individual is officially representing the community in public spaces.
Examples of representing our community include using an official e-mail address,
posting via an official social media account, or acting as an appointed
representative at an online or offline event.
Enforcement
Instances of abusive, harassing, or otherwise unacceptable behavior may be
reported to the community leaders responsible for enforcement at
guix-maintainers@gnu.org.
All complaints will be reviewed and investigated promptly and fairly.
All community leaders are obligated to respect the privacy and security of the
reporter of any incident.
Enforcement Guidelines
Community leaders will follow these Community Impact Guidelines in determining
the consequences for any action they deem in violation of this Code of Conduct:
1. Correction
Community Impact: Use of inappropriate language or other behavior deemed
unprofessional or unwelcome in the community.
Consequence: A private, written warning from community leaders, providing
clarity around the nature of the violation and an explanation of why the
behavior was inappropriate. A public apology may be requested.
2. Warning
Community Impact: A violation through a single incident or series of
actions.
Consequence: A warning with consequences for continued behavior. No
interaction with the people involved, including unsolicited interaction with
those enforcing the Code of Conduct, for a specified period of time. This
includes avoiding interactions in community spaces as well as external channels
like social media. Violating these terms may lead to a temporary or permanent
ban.
3. Temporary Ban
Community Impact: A serious violation of community standards, including
sustained inappropriate behavior.
Consequence: A temporary ban from any sort of interaction or public
communication with the community for a specified period of time. No public or
private interaction with the people involved, including unsolicited interaction
with those enforcing the Code of Conduct, is allowed during this period.
Violating these terms may lead to a permanent ban.
4. Permanent Ban
Community Impact: Demonstrating a pattern of violation of community
standards, including sustained inappropriate behavior, harassment of an
individual, or aggression toward or disparagement of classes of individuals.
Consequence: A permanent ban from any sort of public interaction within the
community.
Attribution
This Code of Conduct is adapted from the Contributor Covenant,
version 2.1, available at
https://www.contributor-covenant.org/version/2/1/code_of_conduct.html.
Community Impact Guidelines were inspired by
Mozilla’s code of conduct enforcement ladder.
For answers to common questions about this code of conduct, see the FAQ at
https://www.contributor-covenant.org/faq. Translations are available at
https://www.contributor-covenant.org/translations.

> 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 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; 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 build hurd-boot)
  #:use-module (system repl error-handling)
  #:autoload   (system repl repl) (start-repl)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:use-module (guix build utils)
  #:use-module ((guix build syscalls)
                #:hide (file-system-type))
  #:export (make-hurd-device-nodes
            boot-hurd-system))

;;; Commentary:
;;;
;;; Utility procedures useful to boot a Hurd system.
;;;
;;; Code:

;; XXX FIXME c&p from linux-boot.scm
(define (find-long-option option arguments)
  "Find OPTION among ARGUMENTS, where OPTION is something like \"--load\".
Return the value associated with OPTION, or #f on failure."
  (let ((opt (string-append option "=")))
    (and=> (find (cut string-prefix? opt <>)
                 arguments)
           (lambda (arg)
             (substring arg (+ 1 (string-index arg #\=)))))))

;; XXX FIXME c&p from guix/utils.scm
(define (readlink* file)
  "Call 'readlink' until the result is not a symlink."
  (define %max-symlink-depth 50)

  (let loop ((file  file)
             (depth 0))
    (define (absolute target)
      (if (absolute-file-name? target)
          target
          (string-append (dirname file) "/" target)))

    (if (>= depth %max-symlink-depth)
        file
        (call-with-values
            (lambda ()
              (catch 'system-error
                (lambda ()
                  (values #t (readlink file)))
                (lambda args
                  (let ((errno (system-error-errno args)))
                    (if (or (= errno EINVAL))
                        (values #f file)
                        (apply throw args))))))
          (lambda (success? target)
            (if success?
                (loop (absolute target) (+ depth 1))
                file))))))

(define* (make-hurd-device-nodes #:optional (root "/"))
  "Make some of the nodes needed on GNU/Hurd."
  (define (scope dir)
    (string-append root (if (string-suffix? "/" root) "" "/") dir))

  (mkdir (scope "dev"))
  ;; Don't create /dev/null etc just yet; the store
  ;; messes-up the permission bits.
  ;; Don't create /dev/console, /dev/vcs, etc.: they are created by
  ;; console-run on first boot.

  (mkdir (scope "servers"))
  (for-each (lambda (file)
              (call-with-output-file (scope (string-append "servers/" file))
                (lambda (port)
                  (display file port)   ;avoid hard-linking
                  (chmod port #o444))))
            '("startup"
              "exec"
              "proc"
              "password"
              "default-pager"
              "crash-dump-core"
              "kill"
              "suspend"))

  (mkdir (scope "servers/socket"))
  ;; Don't create /servers/socket/1 & co: runsystem does that on first boot.

  ;; TODO: Set the 'gnu.translator' extended attribute for passive translator
  ;; settings?
  )

(define (passive-translator-xattr? file-name)
  "Return true if FILE-NAME has an extended @code{gnu.translator} attribute
set."
  (catch 'system-error
    (lambda _ (not (string-null? (getxattr file-name "gnu.translator"))))
    (lambda args
      (if (= ENODATA (system-error-errno args))
          #f
          (apply throw args)))))

(define (passive-translator-installed? file-name)
  "Return true if @file{showtrans} finds a translator installed on FILE-NAME."
  (with-output-to-port (%make-void-port "w")
    (lambda _
      (with-error-to-port (%make-void-port "w")
        (lambda _
          (zero? (system* "showtrans" "--silent" file-name)))))))

(define (translated? file-name)
  "Return true if a translator is installed on FILE-NAME."
  (if (string-contains %host-type "linux-gnu")
      (passive-translator-xattr? file-name)
      (passive-translator-installed? file-name)))

(define* (set-translator file-name command #:optional (mode #o600))
  "Setup translator COMMAND on FILE-NAME."
  (unless (translated? file-name)
    (let ((dir (dirname file-name)))
      (unless (directory-exists? dir)
        (mkdir-p dir))
      (unless (file-exists? file-name)
        (call-with-output-file file-name
          (lambda (port)
            (display file-name port)  ;avoid hard-linking
            (chmod port mode)))))
    (catch 'system-error
      (lambda _
        (setxattr file-name "gnu.translator" (string-join command "\0" 'suffix)))
      (lambda (key . args)
        (let ((errno (system-error-errno (cons key args))))
          (format (current-error-port) "~a: ~a\n"
                  (strerror errno) file-name)
          (format (current-error-port) "Ignoring...Good Luck!\n"))))))

(define-syntax-rule (false-if-EEXIST exp)
  "Evaluate EXP but return #f if it raises to 'system-error with EEXIST."
  (catch 'system-error
    (lambda () exp)
    (lambda args
      (if (= EEXIST (system-error-errno args))
          #f
          (apply throw args)))))

(define* (set-hurd-device-translators #:optional (root "/"))
  "Make some of the device nodes needed on GNU/Hurd."

  (define (scope dir)
    (string-append root (if (string-suffix? "/" root) "" "/") dir))

  (define scope-set-translator
    (match-lambda
      ((file-name command)
       (scope-set-translator (list file-name command #o600)))
      ((file-name command mode)
       (let ((mount-point (scope file-name)))
         (set-translator mount-point command mode)))))

  (define (mkdir* dir)
    (let ((dir (scope dir)))
     (unless (file-exists? dir)
       (mkdir-p dir))))

  (define servers
    '(("servers/crash-dump-core" ("/hurd/crash" "--dump-core"))
      ("servers/crash-kill"      ("/hurd/crash" "--kill"))
      ("servers/crash-suspend"   ("/hurd/crash" "--suspend"))
      ("servers/password"        ("/hurd/password"))
      ("servers/socket/1"        ("/hurd/pflocal"))
      ("servers/socket/2"        ("/hurd/pfinet"
                                  "--interface" "eth0"
                                  "--address"
                                  "10.0.2.15" ;the default QEMU guest IP
                                  "--netmask" "255.255.255.0"
                                  "--gateway" "10.0.2.2"
                                  "--ipv6" "/servers/socket/26"))
      ("proc"                    ("/hurd/procfs" "--stat-mode=444"))))

  (define devices
    '(("dev/full"    ("/hurd/null"     "--full")            #o666)
      ("dev/null"    ("/hurd/null")                         #o666)
      ("dev/random"  ("/hurd/random"   "--seed-file" "/var/lib/random-seed")
                                                            #o644)
      ("dev/zero"    ("/hurd/storeio"  "--store-type=zero") #o666)

      ("dev/console" ("/hurd/term"     "/dev/console" "device" "console"))

      ("dev/klog"    ("/hurd/streamio" "kmsg"))
      ("dev/mem"     ("/hurd/storeio"  "--no-cache" "mem")  #o660)
      ("dev/shm"     ("/hurd/tmpfs"    "--mode=1777" "50%") #o644)
      ("dev/time"    ("/hurd/storeio"  "--no-cache" "time") #o644)

      ("dev/vcs"     ("/hurd/console"))
      ("dev/tty"     ("/hurd/magic"    "tty")               #o666)

      ;; 'fd_to_filename' in libc expects it.
      ("dev/fd"      ("/hurd/magic"    "--directory" "fd")  #o555)

      ("dev/tty1"    ("/hurd/term"     "/dev/tty1" "hurdio" "/dev/vcs/1/console")
                                                            #o666)
      ("dev/tty2"    ("/hurd/term"     "/dev/tty2" "hurdio" "/dev/vcs/2/console")
                                                            #o666)
      ("dev/tty3"    ("/hurd/term"     "/dev/tty3" "hurdio" "/dev/vcs/3/console")
                                                            #o666)

      ("dev/ptyp0"   ("/hurd/term"     "/dev/ptyp0" "pty-master" "/dev/ttyp0")
                                                            #o666)
      ("dev/ptyp1"   ("/hurd/term"     "/dev/ptyp1" "pty-master" "/dev/ttyp1")
                                                            #o666)
      ("dev/ptyp2"   ("/hurd/term"     "/dev/ptyp2" "pty-master" "/dev/ttyp2")
                                                            #o666)

      ("dev/ttyp0"   ("/hurd/term"     "/dev/ttyp0" "pty-slave" "/dev/ptyp0")
                                                            #o666)
      ("dev/ttyp1"   ("/hurd/term"     "/dev/ttyp1" "pty-slave" "/dev/ptyp1")
                                                            #o666)
      ("dev/ttyp2"   ("/hurd/term"     "/dev/ttyp2" "pty-slave" "/dev/ptyp2")
                                                            #o666)))

  (for-each scope-set-translator servers)
  (mkdir* "dev/vcs/1")
  (mkdir* "dev/vcs/2")
  (mkdir* "dev/vcs/2")
  (rename-file (scope "dev/console") (scope "dev/console-"))
  (for-each scope-set-translator devices)

  (false-if-EEXIST (symlink "/dev/random" (scope "dev/urandom")))
  (false-if-EEXIST (symlink "/dev/fd/0" (scope "dev/stdin")))
  (false-if-EEXIST (symlink "/dev/fd/1" (scope "dev/stdout")))
  (false-if-EEXIST (symlink "/dev/fd/2" (scope "dev/stderr")))
  (false-if-EEXIST (symlink "crash-dump-core" (scope "servers/crash")))

  ;; Make sure /etc/mtab is a symlink to /proc/mounts.
  (false-if-exception (delete-file (scope "etc/mtab")))
  (mkdir* (scope "etc"))
  (symlink "/proc/mounts" (scope "etc/mtab")))


(define* (boot-hurd-system #:key (on-error 'debug))
  "This procedure is meant to be called from an early RC script.

Install the relevant passive translators on the first boot.  Then, run system
activation by using the kernel command-line options '--system' and '--load';
starting the Shepherd.

XXX TODO: see linux-boot.scm:boot-system.
XXX TODO: add proper file-system checking, mounting
XXX TODO: move bits to (new?) (hurd?) (activation?) services
XXX TODO: use Linux xattr/setxattr to remove (settrans in) /libexec/RUNSYSTEM

"

  (display "Welcome, this is GNU's early boot Guile.\n")
  (display "Use '--repl' for an initrd REPL.\n\n")

  (call-with-error-handling
   (lambda ()

     (let* ((args    (command-line))
            (system  (find-long-option "--system" args))
            (to-load (find-long-option "--load" args)))

       (format #t "Setting-up essential translators...\n")
       (setenv "PATH" (string-append system "/profile/bin"))
       (set-hurd-device-translators)

       (false-if-exception (delete-file "/hurd"))
       (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
         (symlink hurd/hurd "/hurd"))

       (format #t "Starting pager...\n")
       (unless (zero? (system* "/hurd/mach-defpager"))
         (format #t "FAILED...Good luck!\n"))

       (cond ((member "--repl" args)
              (format #t "Starting repl...\n")
              (start-repl))
             (to-load
              (format #t "loading '~a'...\n" to-load)
              (primitive-load to-load)
              (format (current-error-port)
                      "boot program '~a' terminated, rebooting~%"
                      to-load)
              (sleep 2)
              (reboot))
             (else
              (display "no boot file passed via '--load'\n")
              (display "entering a warm and cozy REPL\n")
              (start-repl)))))
   #:on-error on-error))

;;; hurd-boot.scm ends here