[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: installer: Don't use the shell for every little thing.
|
From: |
Danny Milosavljevic |
|
Subject: |
03/03: installer: Don't use the shell for every little thing. |
|
Date: |
Fri, 7 Jul 2017 01:02:58 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit d9ef096a520659ded2bbb6e2529494cb1413980b
Author: Danny Milosavljevic <address@hidden>
Date: Fri Jul 7 06:58:07 2017 +0200
installer: Don't use the shell for every little thing.
* gnu/system/installer/utils.scm (slurp): Delete variable.
(slurp*): New variable.
(key-value-slurp): Delete variable.
(key-value-slurp*): New variable.
(open-input-pipe-with-fallback): Delete variable.
(open-input-pipe-with-fallback*): New variable.
* gnu/system/installer/filesystems.scm (make-file-system-spec): Use slurp*.
* gnu/system/installer/format.scm (device-attributes): Use key-value-slurp*.
* gnu/system/installer/guixsd-installer.scm (main-options): Use slurp*.
* gnu/system/installer/locale.scm (locale-description): Use
key-value-slurp*.
* gnu/system/installer/network.scm (name->description): Use slurp*.
* gnu/system/installer/partition-reader.scm (read-partition-info): Use
open-input-pipe-with-fallback*.
* gnu/system/installer/wireless.scm (scan-wifi): Use slurp*.
---
gnu/system/installer/filesystems.scm | 2 +-
gnu/system/installer/format.scm | 2 +-
gnu/system/installer/guixsd-installer.scm | 2 +-
gnu/system/installer/locale.scm | 3 +-
gnu/system/installer/network.scm | 16 +++++++---
gnu/system/installer/partition-reader.scm | 2 +-
gnu/system/installer/utils.scm | 52 ++++++++++++++++---------------
gnu/system/installer/wireless.scm | 2 +-
8 files changed, 44 insertions(+), 37 deletions(-)
diff --git a/gnu/system/installer/filesystems.scm
b/gnu/system/installer/filesystems.scm
index 86c1c7d..a557c71 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -81,7 +81,7 @@
(define (make-file-system-spec mount-point label type)
(if (member type valid-file-system-types)
- (let ((uuid (slurp "uuidgen" identity)))
+ (let ((uuid (slurp* "uuidgen")))
(make-file-system-spec' mount-point label
(string->symbol type)
(car uuid)))
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index 0bb0c2a..ef99fd7 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -36,7 +36,7 @@
(include "i18n.scm")
(define (device-attributes dev)
- (key-value-slurp (string-append "blkid -o export " dev)))
+ (key-value-slurp* "blkid" "-o" "export" dev))
(define (device-fs-uuid dev)
"Retrieve the UUID of the filesystem on DEV, where DEV is the name of the
diff --git a/gnu/system/installer/guixsd-installer.scm
b/gnu/system/installer/guixsd-installer.scm
index e786220..f08d489 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -116,7 +116,7 @@
page
(or
(getenv "TZDIR")
- (string-append (car (slurp "guix build tzdata"
#f))
+ (string-append (car (slurp* "guix" "build"
"tzdata"))
"/share/zoneinfo"))))))
(hostname . ,(make-task hostname-menu-title
diff --git a/gnu/system/installer/locale.scm b/gnu/system/installer/locale.scm
index e7e565d..da0da7a 100644
--- a/gnu/system/installer/locale.scm
+++ b/gnu/system/installer/locale.scm
@@ -73,8 +73,7 @@
(dynamic-wind
(lambda () (set! loc (getenv lc-all))
(setenv lc-all locale))
- (lambda () (let ((str (assq-ref (key-value-slurp
- (string-append "locale -k LC_IDENTIFICATION"))
+ (lambda () (let ((str (assq-ref (key-value-slurp* "locale" "-k"
"LC_IDENTIFICATION")
'title)))
;; String enclosing "" if they exist
(if (and (eqv? (string-ref str 0) #\")
diff --git a/gnu/system/installer/network.scm b/gnu/system/installer/network.scm
index 4f8cf44..2403112 100644
--- a/gnu/system/installer/network.scm
+++ b/gnu/system/installer/network.scm
@@ -79,14 +79,20 @@
(func (match->elem m 4))
(usb-slot (match->elem m 5)))
(assoc-ref
- (slurp
- (format #f "lspci -v -mm -s~x:~x:~x.~x"
- domain bus slot func)
- (lambda (x)
+ (map
+ (lambda (x)
(let ((idx (string-index x #\:)))
(cons (substring x 0 idx)
(string-trim
- (substring x (1+ idx)))))))
+ (substring x (1+ idx))))))
+ (apply slurp*
+ "lspci"
+ (list "-v" "-mm" (format #f "-s~x:~x:~x.~x"
+ domain bus slot func))
+ ; TODO lsusb -s 2:2 (in decimal); first is bus number.
+ ; TODO traverse full port chain.
+ ; TODO check /sys/class/net/wlp0s29f7u2/phy80211
+ ))
"Device"))))))
(define my-buttons `((continue ,(M_ "_Continue") #t)
diff --git a/gnu/system/installer/partition-reader.scm
b/gnu/system/installer/partition-reader.scm
index 98dae46..2308fb8 100644
--- a/gnu/system/installer/partition-reader.scm
+++ b/gnu/system/installer/partition-reader.scm
@@ -159,7 +159,7 @@ number of Megabytes"
(parse-disk port l)
(parse-partition port l))))))))
- (let* ((port (open-input-pipe-with-fallback "parted -lm"))
+ (let* ((port (open-input-pipe-with-fallback* "parted" "-lm"))
(r (read-partition-info' port '())))
(close-pipe port)
r))
diff --git a/gnu/system/installer/utils.scm b/gnu/system/installer/utils.scm
index f635351..bafd98c 100644
--- a/gnu/system/installer/utils.scm
+++ b/gnu/system/installer/utils.scm
@@ -20,8 +20,8 @@
#:export (
justify*
addstr*
- slurp
- key-value-slurp
+ slurp*
+ key-value-slurp*
quit-key?
push-cursor
@@ -34,7 +34,7 @@
inner
outer
- open-input-pipe-with-fallback
+ open-input-pipe-with-fallback*
find-mount-device
@@ -141,35 +141,37 @@ This version assumes some external entity puts in the
carriage returns."
"Call the curses addstr procedure passing STR to justify to the width of WIN"
(addstr win (justify* str (getmaxx win)) #:y y #:x x))
-(define (open-input-pipe-with-fallback cmd)
+(define (open-input-pipe* program . args)
+ (apply open-pipe* OPEN_READ program args))
+
+(define (open-input-pipe-with-fallback* program . args)
"Kludge for testing"
(let* ((subst (string-append (dirname (current-filename)) "/pipe-subst/"
- (string-map (lambda (c) (case c
- ((#\space) #\%)
- ((#\/) #\,)
- (else c)))
- cmd))))
+ (string-map (lambda (c) (case c
+ ((#\space) #\%)
+ ((#\/) #\,)
+ (else c)))
+ (string-append program " " (string-join args "
"))))))
(if (and (not (eqv? 0 (geteuid)))
- (file-exists? subst))
- (open-input-pipe (string-append "cat " subst))
- (open-input-pipe cmd))))
+ (file-exists? subst))
+ (open-input-pipe* "cat" subst)
+ (apply open-input-pipe* program args))))
-(define (slurp cmd proc)
+(define (slurp* program . args)
(let ((port #f)
(status #f)
(result #f))
- (dynamic-wind (lambda () (set! port (open-input-pipe-with-fallback cmd)))
- (lambda () (set! result (slurp-real port proc)))
- (lambda () (set! status (close-pipe port))))
+ (dynamic-wind (lambda () (set! port (apply open-input-pipe-with-fallback*
program args)))
+ (lambda () (set! result (slurp-real port)))
+ (lambda () (set! status (close-pipe port))))
(if (zero? (status:exit-val status))
result
#f)))
-(define (key-value-slurp cmd)
+(define (key-value-slurp* program . args)
"Slurp CMD, which is expected to give an output of key-value pairs -
each pair terminated with a newline and the key/value delimited with ="
- (slurp cmd
- (lambda (x)
+ (map (lambda (x)
(let ((idx (string-index x #\=)))
(cons (string->symbol (string-fold
(lambda (c acc)
@@ -178,13 +180,13 @@ each pair terminated with a newline and the key/value
delimited with ="
(make-string 1 (char-downcase c))))
""
(substring x 0 idx)))
- (substring x (1+ idx) (string-length x)))))))
+ (substring x (1+ idx) (string-length x)))))
+ (apply slurp* program args)))
+(define (slurp-real port)
+ "Return a list of strings from PORT, one per line.
-(define (slurp-real port proc)
- "Execute CMD in a shell and return a list of strings from its standard
output,
-one per line. If PROC is not #f then it must be a procedure taking a string
-which will process each string before returning it."
+Ignore blank lines."
(let lp ((line-list '()))
(let ((l (read-line port)))
(if (eof-object? l)
@@ -192,7 +194,7 @@ which will process each string before returning it."
(lp
(if (string= l "") ;; Ignore blank lines
line-list
- (cons (if proc (proc l) l) line-list)))))))
+ (cons l line-list)))))))
diff --git a/gnu/system/installer/wireless.scm
b/gnu/system/installer/wireless.scm
index 4726fdb..28825bb 100644
--- a/gnu/system/installer/wireless.scm
+++ b/gnu/system/installer/wireless.scm
@@ -181,7 +181,7 @@
"" s))
(define (scan-wifi ifce)
- (match (slurp (string-append "iwlist " ifce " scan") string-trim-both)
+ (match (map string-trim-both (slurp* "iwlist" ifce "scan"))
(#f '())
((_ . lines) lines))) ;; Ignore the first line