rewrite guix installer
This commit is contained in:
parent
e0c62036ce
commit
48edfadc67
GPG key ID:
9FBC6FFD6D2DBF17
13 changed files with 820 additions and 375 deletions
|
|
@ -4,8 +4,8 @@
|
|||
|
||||
### Instructions
|
||||
|
||||
- Create USB with Guix installation image
|
||||
- Boot and immediately drop into shell, skip graphical installer
|
||||
- Install git `guix shell git`, and pull this repo `git clone https://g.freya.cat/freya/dotfiles-guix.git`
|
||||
- Enter the `installer` directory and run `./guix-setup`
|
||||
- Build Guix ISO Image with `systems/installer.scm`
|
||||
- Boot into it and get root shell
|
||||
- Pull this repo `git clone https://g.freya.cat/freya/dotfiles-guix.git`
|
||||
- Execute `scripts/install-system`
|
||||
- Its Guixing time
|
||||
|
|
|
|||
52
files/base.scm.m4
Normal file
52
files/base.scm.m4
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
divert(-1)
|
||||
changecom(`//')
|
||||
//
|
||||
// This is the base system file for the installer.
|
||||
//
|
||||
// Macro definitions:
|
||||
//
|
||||
// Required:
|
||||
// HOST: The systems hostname
|
||||
// BOOT: Boot partition uuid
|
||||
// ROOT: Root partition uuid
|
||||
// FSYS: Root filesystem
|
||||
//
|
||||
// Optional:
|
||||
// SWAP: Swap partition uuid
|
||||
// CRYPT: If using luks (boolean)
|
||||
//
|
||||
divert(0)dnl
|
||||
(use-modules (freya system)
|
||||
(gnu))
|
||||
|
||||
(operating-system
|
||||
(inherit %desktop-freya-operating-system)
|
||||
(host-name "HOST")
|
||||
ifdef(`CRYPT', `dnl
|
||||
(mapped-devices (list (mapped-device
|
||||
(source (uuid
|
||||
"ROOT"))
|
||||
(target "root")
|
||||
(type luks-device-mapping))))
|
||||
')dnl
|
||||
ifdef(`SWAP', `dnl
|
||||
(swap-devices (list (swap-space
|
||||
(target (uuid
|
||||
"SWAP")))))
|
||||
')dnl
|
||||
(file-systems (cons* (file-system
|
||||
(mount-point "/")
|
||||
ifdef(`CRYPT', `dnl
|
||||
(device "/dev/mapper/root")
|
||||
', `dnl
|
||||
(device (uuid "ROOT"))
|
||||
')dnl
|
||||
(type "FSYS")
|
||||
(dependencies mapped-devices))
|
||||
(file-system
|
||||
(mount-point "/boot/efi")
|
||||
(device (uuid "BOOT"
|
||||
'fat32))
|
||||
(type "vfat"))
|
||||
(operating-system-file-systems
|
||||
%desktop-freya-operating-system))))
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
source ./guix-log
|
||||
source ./guix-env
|
||||
|
||||
HOSTNAME=""
|
||||
CRYPT_UUID=""
|
||||
EFI_UUID=""
|
||||
|
||||
get_uuid() {
|
||||
blkid -s UUID -o value $1
|
||||
}
|
||||
|
||||
CRYPT_UUID=$(get_uuid $CRYPT_PARTITION)
|
||||
EFI_UUID=$(get_uuid $EFI_PARTITION)
|
||||
|
||||
get_hostname() {
|
||||
CONFIRM=""
|
||||
read -p "Enter system hostname: " HOSTNAME
|
||||
if [ ! -z "$HOSTNAME" -a "$HOSTNAME" != " " ]; then
|
||||
(confirm "$HOSTNAME");
|
||||
if [ "$?" -ne 0 ]; then
|
||||
get_hostname
|
||||
fi
|
||||
else
|
||||
ERROR "'$HOSTNAME' is not a valid hostname"
|
||||
fi
|
||||
}
|
||||
|
||||
EVENT "Getting hostname"
|
||||
|
||||
get_hostname
|
||||
|
||||
EVENT "Hostname set to '$HOSTNAME'"
|
||||
|
||||
EVENT "Generating system config file"
|
||||
|
||||
cp system.scm "$HOSTNAME.scm"
|
||||
sed -i "s/SED_CRYPT_UUID/$CRYPT_UUID/" ./$HOSTNAME.scm
|
||||
sed -i "s/SED_EFI_UUID/$EFI_UUID/" ./$HOSTNAME.scm
|
||||
sed -i "s/SED_HOSTNAME/$HOSTNAME/" ./$HOSTNAME.scm
|
||||
|
||||
mv "$HOSTNAME.scm" ..
|
||||
|
||||
EVENT "Successfully configured $HOSTNAME.scm"
|
||||
|
||||
echo "HOSTNAME=\"$HOSTNAME\"" >> ./guix-env
|
||||
echo "CRYPT_UUID=\"$CRYPT_UUID\"" >> ./guix-env
|
||||
echo "EFI_UUID=\"$EFI_UUID\"" >> ./guix-env
|
||||
|
|
@ -1,70 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
source ./guix-log
|
||||
source ./guix-env
|
||||
|
||||
CRYPT_PARTITION=""
|
||||
EFI_PARTITION=""
|
||||
PASSWORD=""
|
||||
PASSWORD_CONFIRM=""
|
||||
|
||||
EVENT "Setting up disk encryption with luks"
|
||||
|
||||
if [[ $DISK == "/dev/sd"* ]]; then
|
||||
CRYPT_PARTITION="$DISK""2"
|
||||
EFI_PARTITION="$DISK""1"
|
||||
elif [[ $DISK == "/dev/vd"* ]]; then
|
||||
CRYPT_PARTITION="$DISK""2"
|
||||
EFI_PARTITION="$DISK""1"
|
||||
elif [[ $DISK == "/dev/nvme"* ]]; then
|
||||
CRYPT_PARTITION="$DISK""p2"
|
||||
EFI_PARTITION="$DISK""p1"
|
||||
else
|
||||
ERROR "Unsupported drive type, must be sata or nvme!"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
get_password() {
|
||||
read -s -p "LUKS password: " PASSWORD
|
||||
printf "\n"
|
||||
read -s -p "Confirm password: " PASSWORD_CONFIRM
|
||||
printf "\n"
|
||||
if [ "$PASSWORD" == "$PASSWORD_CONFIRM" ]; then
|
||||
return
|
||||
else
|
||||
ERROR "Passwords do not match"
|
||||
get_password
|
||||
fi
|
||||
}
|
||||
|
||||
get_password
|
||||
|
||||
EVENT "Setting up luks"
|
||||
|
||||
cryptsetup luksFormat --type luks1 "$CRYPT_PARTITION" <<EOF
|
||||
$PASSWORD
|
||||
$PASSWORD_CONFIRM
|
||||
EOF
|
||||
|
||||
EVENT "Opening root"
|
||||
|
||||
cryptsetup open "$CRYPT_PARTITION" root <<EOF
|
||||
$PASSWORD
|
||||
EOF
|
||||
|
||||
EVENT "Setting up root btrfs"
|
||||
|
||||
mkfs.btrfs "/dev/mapper/root"
|
||||
|
||||
EVENT "Mounting root"
|
||||
|
||||
mount /dev/mapper/root /mnt
|
||||
|
||||
EVENT "Setting up EFI vfat"
|
||||
|
||||
mkfs.vfat "-F32" "$EFI_PARTITION"
|
||||
|
||||
EVENT "Successfully setup efi vfat and luks"
|
||||
|
||||
echo "CRYPT_PARTITION=\"$CRYPT_PARTITION\"" >> ./guix-env
|
||||
echo "EFI_PARTITION=\"$EFI_PARTITION\"" >> ./guix-env
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
source ./guix-env
|
||||
source ./guix-log
|
||||
|
||||
EVENT "Mounting /gnu/store to destination disk..."
|
||||
herd start cow-store /mnt
|
||||
|
||||
EVENT "Installing non-guix signing keys for substitutes..."
|
||||
curl -o /tmp/sign-key.pub https://substitutes.nonguix.org/signing-key.pub
|
||||
guix archive --authorize < /tmp/sign-key.pub
|
||||
|
||||
EVENT "Installing GNU Guix"
|
||||
guix time-machine -C ../channels.scm -- system -L ../modules --substitute-urls='https://substitutes.nonguix.org https://bordeaux.guix.gnu.org https://ci.guix.gnu.org' init ../$HOSTNAME.scm /mnt
|
||||
|
||||
EVENT "Installing User Environment"
|
||||
|
||||
USER=freya
|
||||
guix shell git -- git clone https://g.freya.cat/freya/dotfiles /mnt/home/$USER/.config/guix
|
||||
cp ../$HOSTNAME.scm /mnt/home/$USER/.config/guix/$HOSTNAME.scm
|
||||
cp ./guix-setup-user /mnt/home/$USER/.zprofile
|
||||
|
||||
chown 1000:1000 -R /mnt/home/$USER
|
||||
|
||||
EVENT "Successflly installed Guix root and user"
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
ERROR() {
|
||||
>&2 printf "\x1b[91mError: \x1b[0m\x1b[98m$1\n"
|
||||
}
|
||||
|
||||
EVENT() {
|
||||
printf "\x1b[95m>>> \x1b[0m\x1b[98m$1\n"
|
||||
}
|
||||
|
||||
CONFIRM=""
|
||||
|
||||
confirm() {
|
||||
if [ "$CONFIRM" == "y" ]; then
|
||||
exit 0
|
||||
fi
|
||||
read -p "Are you sure: ($1)? [y/N] " CONFIRM
|
||||
if [ "$CONFIRM" == "y" ]; then
|
||||
exit 0
|
||||
else
|
||||
exit 1
|
||||
fi
|
||||
}
|
||||
|
|
@ -1,66 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
set -o emacs;
|
||||
|
||||
DISK=""
|
||||
|
||||
source ./guix-log
|
||||
source ./guix-env
|
||||
|
||||
EVENT "Partitioning disks"
|
||||
|
||||
check_disk() {
|
||||
lsblk $1 &> /dev/null || exit 1
|
||||
FS=$(df $1 | tail -n 1 | awk '{print $1}')
|
||||
if [ "$FS" == "none" ]; then
|
||||
exit 0
|
||||
else
|
||||
exit 1
|
||||
fi
|
||||
}
|
||||
|
||||
get_disk() {
|
||||
CONFIRM=""
|
||||
read -ep "Enter disk (e.g. /dev/sda): " DISK
|
||||
if [ ! -b "$DISK" ]; then
|
||||
ERROR "$DISK: file does not exist"
|
||||
get_disk
|
||||
return
|
||||
fi
|
||||
(check_disk "$DISK");
|
||||
if [ "$?" -ne 0 ]; then
|
||||
ERROR "$DISK: not a valid disk"
|
||||
get_disk
|
||||
return
|
||||
fi
|
||||
(confirm "$DISK");
|
||||
if [ "$?" -ne 0 ]; then
|
||||
get_disk
|
||||
fi
|
||||
}
|
||||
|
||||
get_disk
|
||||
|
||||
EVENT "Partitioning disks with fdisk..."
|
||||
|
||||
fdisk "$DISK" <<EOF
|
||||
g
|
||||
n
|
||||
|
||||
|
||||
+1GiB
|
||||
t
|
||||
EFI System
|
||||
n
|
||||
|
||||
|
||||
|
||||
t
|
||||
2
|
||||
Linux Filesystem
|
||||
w
|
||||
EOF
|
||||
|
||||
echo "DISK=\"$DISK\"" >> ./guix-env
|
||||
|
||||
EVENT "Disks have been successfully partitioned on $DISK"
|
||||
|
|
@ -1,51 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
USER_PASSWORD=""
|
||||
ROOT_PASSWORD=""
|
||||
|
||||
source ./guix-env
|
||||
source ./guix-log
|
||||
|
||||
get_root_password() {
|
||||
read -s -p "Root password: " PASSWORD
|
||||
printf "\n"
|
||||
read -s -p "Confirm password: " PASSWORD_CONFIRM
|
||||
printf "\n"
|
||||
if [ "$PASSWORD" == "$PASSWORD_CONFIRM" ]; then
|
||||
ROOT_PASSWORD=$PASSWORD
|
||||
return
|
||||
else
|
||||
ERROR "Passwords do not match"
|
||||
get_root_password
|
||||
fi
|
||||
}
|
||||
|
||||
get_user_password() {
|
||||
read -s -p "User password: " PASSWORD
|
||||
printf "\n"
|
||||
read -s -p "Confirm password: " PASSWORD_CONFIRM
|
||||
printf "\n"
|
||||
if [ "$PASSWORD" == "$PASSWORD_CONFIRM" ]; then
|
||||
USER_PASSWORD=$PASSWORD
|
||||
return
|
||||
else
|
||||
ERROR "Passwords do not match"
|
||||
get_user_password
|
||||
fi
|
||||
}
|
||||
|
||||
EVENT "Setup /etc/shadow for root and user"
|
||||
|
||||
get_root_password
|
||||
get_user_password
|
||||
|
||||
cat << EOF | chroot /mnt
|
||||
passwd
|
||||
$ROOT_PASSWORD
|
||||
$ROOT_PASSWORD
|
||||
passwd freya
|
||||
$USER_PASSWORD
|
||||
$USER_PASSWORD
|
||||
EOF
|
||||
|
||||
EVENT "Successfully set passwords"
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
echo "#!/run/current-system/profile/bin/bash" > ./guix-env
|
||||
echo "" > ./guix-env
|
||||
|
||||
welcome() {
|
||||
cat<<"EOF"
|
||||
░░░ ░░░
|
||||
░░▒▒░░░░░░░░░ ░░░░░░░░░▒▒░░
|
||||
░░▒▒▒▒▒░░░░░░░ ░░░░░░░▒▒▒▒▒░
|
||||
░▒▒▒░░▒▒▒▒▒ ░░░░░░░▒▒░
|
||||
░▒▒▒▒░ ░░░░░░
|
||||
▒▒▒▒▒ ░░░░░░
|
||||
▒▒▒▒▒ ░░░░░
|
||||
░▒▒▒▒▒ ░░░░░
|
||||
▒▒▒▒▒ ░░░░░
|
||||
▒▒▒▒▒ ░░░░░
|
||||
░▒▒▒▒▒░░░░░
|
||||
▒▒▒▒▒▒░░░
|
||||
▒▒▒▒▒▒░
|
||||
____ _ _ _____ __ ____ _
|
||||
/ ___| | | |_ _\ \/ / / ___|| |_ _ __ __ _ _ __
|
||||
| | _| | | || | \ / \___ \| __| '__/ _` | '_ \
|
||||
| |_| | |_| || | / \ ___) | |_| | | (_| | |_) |
|
||||
\____|\___/|___/_/\_\ |____/ \__|_| \__,_| .__/
|
||||
|_|
|
||||
This script installs GNU Guix on your system
|
||||
|
||||
https://www.gnu.org/software/guix/
|
||||
EOF
|
||||
echo -n "Press return to continue..."
|
||||
read -r ANSWER
|
||||
}
|
||||
|
||||
welcome
|
||||
./guix-partition
|
||||
./guix-crypt
|
||||
./guix-configure
|
||||
./guix-install
|
||||
./guix-password
|
||||
|
||||
echo "GNU Guix has been installed, you can now reboot..."
|
||||
exit 0
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
#!/run/current-system/profile/bin/bash
|
||||
|
||||
# This should run on user first logon, so let's a go!
|
||||
# First, we should run a guix pull
|
||||
|
||||
guix pull
|
||||
|
||||
hash guix
|
||||
|
||||
guix home -L ~/.config/guix/modules reconfigure ~/.config/guix/home-config/home-configuration.scm
|
||||
|
||||
sudo -E herd restart nix-daemon
|
||||
|
||||
nix-channel --update
|
||||
|
||||
nix-shell '<home-manager>' -A install
|
||||
|
||||
rm ~/.zprofile
|
||||
source ~/.config/zsh/.zprofile
|
||||
|
||||
home-manager switch
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
(use-modules (home-config base-system)
|
||||
(gnu))
|
||||
|
||||
(operating-system
|
||||
(inherit base-operating-system)
|
||||
(host-name "SED_HOSTNAME")
|
||||
|
||||
(mapped-devices (list (mapped-device
|
||||
(source (uuid
|
||||
"SED_CRYPT_UUID"))
|
||||
(target "root")
|
||||
(type luks-device-mapping))))
|
||||
|
||||
(file-systems (cons* (file-system
|
||||
(mount-point "/")
|
||||
(device "/dev/mapper/root")
|
||||
(type "btrfs")
|
||||
(dependencies mapped-devices))
|
||||
(file-system
|
||||
(mount-point "/boot/efi")
|
||||
(device (uuid "SED_EFI_UUID"
|
||||
'fat32))
|
||||
(type "vfat")) %base-file-systems)))
|
||||
|
|
@ -120,6 +120,7 @@
|
|||
"ripgrep"
|
||||
"ncurses"
|
||||
"jq"
|
||||
"m4"
|
||||
"openssl"))
|
||||
;; append freyanet certs
|
||||
(list freya-ca-certs)
|
||||
|
|
|
|||
763
scripts/install-system
Executable file
763
scripts/install-system
Executable file
|
|
@ -0,0 +1,763 @@
|
|||
#!/run/current-system/profile/bin/guile -s
|
||||
!#
|
||||
;;; file: install-system
|
||||
;;; author: Freya Murphy <freya@freyacat.org>
|
||||
;;; desc: Installs Guix onto your system
|
||||
|
||||
;;
|
||||
;; root check
|
||||
;;
|
||||
|
||||
;; we need to be root to access block devices and mounts
|
||||
(if (not (string=? (getenv "USER") "root"))
|
||||
(begin
|
||||
(display "Requesting root user access...\n")
|
||||
(system* "sudo" "-E" (current-filename))
|
||||
;; dont continue as orig user... exit
|
||||
(exit 0)))
|
||||
|
||||
;;
|
||||
;; environment
|
||||
;;
|
||||
|
||||
(setenv "TERM" "xterm") ; this should fix more problems then it might cause
|
||||
; ...always can remove it if not the case
|
||||
|
||||
(setenv "PATH" (string-append (getenv "PATH") ;; needed for guix-retry
|
||||
":"
|
||||
(dirname (current-filename))))
|
||||
|
||||
(setenv "GUILE_HISTORY"
|
||||
(string-append (getenv "HOME")
|
||||
"/.guix_installer_history"))
|
||||
|
||||
;;
|
||||
;; import modules
|
||||
;;
|
||||
|
||||
(use-modules (guix records)
|
||||
(os process)
|
||||
(ice-9 popen)
|
||||
(ice-9 textual-ports)
|
||||
(ice-9 readline)
|
||||
(ice-9 match)
|
||||
(ice-9 regex)
|
||||
(ice-9 format)
|
||||
(srfi srfi-1) ; fold, last
|
||||
(srfi srfi-9) ; records
|
||||
(srfi srfi-34)) ; exceptions
|
||||
|
||||
(activate-readline)
|
||||
|
||||
;;
|
||||
;; config
|
||||
;;
|
||||
|
||||
(define %dotfiles-dir
|
||||
(dirname (dirname (current-filename))))
|
||||
|
||||
(define %user
|
||||
"freya")
|
||||
|
||||
(define %block-device-min
|
||||
;; smallest size in GiB a block device is allowed to be
|
||||
8)
|
||||
|
||||
(define %bypass-block-dev-check
|
||||
;; bypass checking if a file is a block device
|
||||
(getenv "DEBUG"))
|
||||
|
||||
;;
|
||||
;; option
|
||||
;;
|
||||
|
||||
(define (option? option)
|
||||
(and (list? option)
|
||||
(not (null? option))
|
||||
(eq? 'option (car option))))
|
||||
|
||||
(define (some? option)
|
||||
(and (option? option)
|
||||
(= (length option) 2)))
|
||||
|
||||
(define (none)
|
||||
`(option))
|
||||
|
||||
(define (some value)
|
||||
`(option ,value))
|
||||
|
||||
(define (match-option option onSome onNone)
|
||||
(if (option? option)
|
||||
(if (some? option)
|
||||
(onSome (cadr option))
|
||||
(onNone))
|
||||
(error "Expected option:" option)))
|
||||
|
||||
(define (unwrap-option option)
|
||||
(if (some? option)
|
||||
(cadr option)
|
||||
(error "Expected some:" option)))
|
||||
|
||||
(define (wrap-option value check?)
|
||||
(if (check? value)
|
||||
(some value)
|
||||
(none)))
|
||||
|
||||
;;
|
||||
;; shell functions
|
||||
;;
|
||||
|
||||
(define* (invoke command #:key (stdin #f))
|
||||
;; invokes a shell command with `args`
|
||||
;; and returns stdout as a string
|
||||
(let* (;; Spawn process
|
||||
(command* (map (lambda (value)
|
||||
(cond ((string? value) value)
|
||||
((number? value) (number->string value))
|
||||
((symbol? value) (symbol->string value))
|
||||
(#t (throw 'invalid-command-arg value))))
|
||||
(filter
|
||||
(lambda (value)
|
||||
(not (unspecified? value)))
|
||||
command)))
|
||||
(proc (apply run-with-pipe (cons* "r+" command*)))
|
||||
(pid (car proc))
|
||||
(in (cadr proc))
|
||||
(out (cddr proc)))
|
||||
;; write stdin
|
||||
(when stdin
|
||||
(put-string out stdin)
|
||||
(force-output out))
|
||||
;; close stdin
|
||||
(close-port out)
|
||||
;; read stdout
|
||||
(let* ((output (get-string-all in)))
|
||||
;; close stdout
|
||||
(close-port in)
|
||||
;; return
|
||||
output)))
|
||||
|
||||
(define* (invoke* prog . args)
|
||||
(invoke (cons* prog args)))
|
||||
|
||||
(define (read-file path)
|
||||
(call-with-input-file path get-string-all))
|
||||
|
||||
(define (write-file path contents)
|
||||
(call-with-output-file path (lambda (port)
|
||||
(put-string port contents))))
|
||||
|
||||
(define (string-trim-full content)
|
||||
(fold (lambda (char content)
|
||||
(string-trim-both content char))
|
||||
content
|
||||
(list #\tab
|
||||
#\space
|
||||
#\newline)))
|
||||
|
||||
;;
|
||||
;; exception functions
|
||||
;;
|
||||
|
||||
(define (catch-or thunk default)
|
||||
;; runs the provided `thunk` callback
|
||||
;; and returns `default` on any exception
|
||||
(with-exception-handler
|
||||
(lambda _ default)
|
||||
thunk
|
||||
#:unwind? #t))
|
||||
|
||||
(define-syntax-rule (catch-or* default . exprs)
|
||||
;; macro to not have to type lambda _
|
||||
(catch-or (lambda _ . exprs) default))
|
||||
|
||||
;;
|
||||
;; prompt functions
|
||||
;;
|
||||
|
||||
(define* (prompt* #:key
|
||||
(heading #f) ; header message
|
||||
(prompt ": ") ; prompt
|
||||
(err #f) ; error message to print on invalid input
|
||||
(fn some) ; transition function
|
||||
(confirm? #f) ; confirm input before returning value
|
||||
(clear? #t) ; clear terminal before prompt
|
||||
(passwd? #f) ; if we are prompting for a password
|
||||
(helper #f)) ; readline autocompletion helper
|
||||
;; prompts for user input
|
||||
;; - returns result of `fn` if some
|
||||
;; - retries on none
|
||||
(let inner ((err? #f))
|
||||
(let* (; reset function - sets up prompt terminal view
|
||||
(reset
|
||||
(lambda (err?)
|
||||
(if clear? (system "clear"))
|
||||
(if heading (display heading))
|
||||
(if err? (format (current-error-port) "\n~a\n\n" err))))
|
||||
; confirm function - confirms if input is what user wants
|
||||
(confirm
|
||||
(lambda (content)
|
||||
(if confirm?
|
||||
(prompt*
|
||||
#:prompt (string-append "confirm (" content ") y/N: ")
|
||||
#:fn (lambda (str)
|
||||
(some (string=? str "y")))
|
||||
#:clear? #f)
|
||||
#t)))
|
||||
; helper* - readline helper
|
||||
(helper*
|
||||
(cond ((list? helper)
|
||||
(make-completion-function helper))
|
||||
((procedure? helper)
|
||||
helper)
|
||||
(#t
|
||||
(lambda (text state) #f))))
|
||||
; readline* function
|
||||
(readline*
|
||||
(lambda (prompt)
|
||||
(if passwd?
|
||||
; dont use readline if prompting for password
|
||||
(getpass prompt)
|
||||
; use readline
|
||||
(with-readline-completion-function
|
||||
helper*
|
||||
(lambda () (readline prompt)))))))
|
||||
; setup terminal view
|
||||
(reset err?)
|
||||
; get input
|
||||
(let* ((content (readline* prompt))
|
||||
(content? (string? content))
|
||||
(content* (string-trim-full (if content? content ""))))
|
||||
;; exit script on EOF
|
||||
(if (eof-object? content)
|
||||
(exit 0))
|
||||
;; update readline history
|
||||
(if (and content?
|
||||
(not passwd?))
|
||||
(add-history content))
|
||||
;; handle result
|
||||
(match-option (fn content*)
|
||||
(lambda (value) ; onSome
|
||||
(if (confirm content*)
|
||||
value
|
||||
(inner #f)))
|
||||
(lambda _ ; onNone
|
||||
(inner #t)))))))
|
||||
|
||||
(define* (prompt-passwd #:key
|
||||
(heading #f) ; header message
|
||||
(fn some) ; transition function
|
||||
(confirm? #t) ; should the user confirm the password
|
||||
(clear? #t)) ; clear terminal before prompt
|
||||
(prompt*
|
||||
#:heading heading
|
||||
#:prompt "passwd: "
|
||||
#:err "Passwords did not match or do not meet requirements"
|
||||
#:fn (lambda (passwd)
|
||||
(if confirm?
|
||||
(let ((confirm-passwd (getpass "confirm: ")))
|
||||
(if (not (string=? passwd confirm-passwd))
|
||||
(none)
|
||||
(fn passwd)))
|
||||
(fn passwd)))
|
||||
#:clear? clear?
|
||||
#:passwd? #t))
|
||||
|
||||
(define* (prompt-bool #:key
|
||||
(heading #f) ; header message
|
||||
(prompt "y/n: ") ; prompt
|
||||
(fn some) ; transition function
|
||||
(confirm? #f) ; confirm input before returning value
|
||||
(clear? #t) ; clear terminal before prompt
|
||||
(passwd? #f)) ; if we are prompting for a password
|
||||
(prompt*
|
||||
#:heading heading
|
||||
#:prompt prompt
|
||||
#:err "Must type 'y' for yes, 'n' for no"
|
||||
#:fn (lambda (str)
|
||||
(match str
|
||||
("y" (fn #t))
|
||||
("n" (fn #f))
|
||||
(_ (none))))
|
||||
#:confirm? confirm?
|
||||
#:clear? clear?
|
||||
#:passwd? passwd?
|
||||
#:helper (list "y" "n")))
|
||||
|
||||
(define* (prompt-number #:key
|
||||
(heading #f) ; header message
|
||||
(prompt "#: ") ; prompt
|
||||
(fn some) ; transition function
|
||||
(confirm? #f) ; confirm input before returning value
|
||||
(clear? #t) ; clear terminal before prompt
|
||||
(passwd? #f)) ; if we are prompting for a password
|
||||
(prompt*
|
||||
#:heading heading
|
||||
#:prompt prompt
|
||||
#:err "Must type a valid integer"
|
||||
#:fn (lambda (str)
|
||||
(let ((num (string->number str)))
|
||||
(if (integer? num)
|
||||
(fn num)
|
||||
(none))))
|
||||
#:confirm? confirm?
|
||||
#:clear? clear?
|
||||
#:passwd? passwd?))
|
||||
|
||||
;;
|
||||
;; storage functions
|
||||
;;
|
||||
|
||||
(define (is-valid-block-device? path)
|
||||
;; #t if the path is a valid block device, otherwise #f
|
||||
(catch-or* #f
|
||||
(let* ((info (stat path))
|
||||
(type (stat:type info)))
|
||||
(cond ((and %bypass-block-dev-check
|
||||
(eq? type 'regular)) #t)
|
||||
((eq? type 'block-special) #t)
|
||||
(#t #f)))))
|
||||
|
||||
(define (block-device-size path)
|
||||
;; returns size of block device in GiB
|
||||
(catch-or* 0
|
||||
(let* ((info (stat path))
|
||||
(result (invoke* "blockdev" "--getsize64" path))
|
||||
(result* (string-trim-full result))
|
||||
(bytes (or (string->number result*) 0))
|
||||
(bytes* (if (and %bypass-block-dev-check
|
||||
(eq? (stat:type info) 'regular))
|
||||
(stat:size info)
|
||||
bytes)))
|
||||
(round (/ bytes* (* 1024 1024 1024))))))
|
||||
|
||||
(define (block-device-uuid path)
|
||||
;; returns uuid of block device
|
||||
(string-trim-full
|
||||
(invoke* "blkid" "-s" "UUID" "-o" "value" path)))
|
||||
|
||||
;;
|
||||
;; config
|
||||
;;
|
||||
|
||||
(define-record-type* <installer-config>
|
||||
installer-config make-installer-config
|
||||
installer-config?
|
||||
(dev config-dev)
|
||||
(filesystem config-filesystem)
|
||||
(crypt? config-crypt?)
|
||||
(crypt-passwd config-crypt-passwd)
|
||||
(swap? config-swap?)
|
||||
(swap-size config-swap-size)
|
||||
(hostname config-hostname))
|
||||
|
||||
;;
|
||||
;; partition
|
||||
;;
|
||||
|
||||
(define-record-type* <partition>
|
||||
partition make-partition
|
||||
partition?
|
||||
(dev partition-dev) ; block device (string)
|
||||
(label partition-label) ; symbol
|
||||
(index partition-index) ; integer
|
||||
(start partition-start) ; n MiB
|
||||
(end partition-end) ; n MiB
|
||||
(type partition-type) ; symbol
|
||||
(boot? partition-boot?
|
||||
(default #f))
|
||||
(swap? partition-swap?
|
||||
(default #f)))
|
||||
|
||||
(define (partition-name part)
|
||||
;; TODO: sata
|
||||
(string-append (partition-dev part) "p" (number->string (partition-index part))))
|
||||
|
||||
(define (partition-crypt? config part)
|
||||
(and (config-crypt? config)
|
||||
(eq? 'root (partition-label part))))
|
||||
|
||||
(define (partition-crypt-label part)
|
||||
(string-append "installer"
|
||||
(symbol->string (partition-label part))))
|
||||
|
||||
(define (find-partition partitions label)
|
||||
(cond ((null? partitions) #f)
|
||||
((eq? label (partition-label (car partitions))) (car partitions))
|
||||
(#t (find-partition (cdr partitions) label))))
|
||||
|
||||
(define (config->partitions config)
|
||||
(let* (; read needed config values
|
||||
(dev (config-dev config))
|
||||
(filesystem (config-filesystem config))
|
||||
(swap? (config-swap? config))
|
||||
(swap-size (config-swap-size config))
|
||||
; boot
|
||||
(boot (partition
|
||||
(dev dev)
|
||||
(label 'boot)
|
||||
(index 1)
|
||||
(start 1)
|
||||
(end 1024)
|
||||
(type 'fat32)
|
||||
(boot? #t)))
|
||||
; swap
|
||||
(swap (partition
|
||||
(dev dev)
|
||||
(label 'swap)
|
||||
(index 2)
|
||||
(start (partition-end boot))
|
||||
(end (+ (partition-end boot) (* swap-size 1024)))
|
||||
(type 'linux-swap)
|
||||
(swap? #t)))
|
||||
; root
|
||||
(root (partition
|
||||
(dev dev)
|
||||
(label 'root)
|
||||
(index (+ (partition-index swap) (if swap? 1 0)))
|
||||
(start (partition-end swap))
|
||||
(end #f)
|
||||
(type filesystem))))
|
||||
(if swap?
|
||||
(list boot swap root)
|
||||
(list boot root))))
|
||||
|
||||
;;
|
||||
;; step 0. get all user input
|
||||
;;
|
||||
|
||||
(define (prompt-block-device)
|
||||
(prompt*
|
||||
#:heading "Which block device to install GUIX on?\n"
|
||||
#:prompt "Disk: "
|
||||
#:err "Invalid Block Device"
|
||||
#:fn (lambda (dev)
|
||||
(cond ((not (is-valid-block-device? dev)) (none))
|
||||
((not (>= (block-device-size dev) %block-device-min)) (none))
|
||||
(#t (some dev))))
|
||||
#:confirm? #t
|
||||
#:helper filename-completion-function))
|
||||
|
||||
(define (prompt-filesystem)
|
||||
(let ((supported (list 'fat32 'btrfs 'ext4)))
|
||||
(prompt*
|
||||
#:heading "What filesystem do you want to use?\n"
|
||||
#:prompt "Filesystem: "
|
||||
#:err "Invalid or unsupported filesystem"
|
||||
#:fn (lambda (name)
|
||||
(wrap-option (string->symbol name)
|
||||
(lambda (type)
|
||||
(member type supported))))
|
||||
#:helper (map symbol->string supported))))
|
||||
|
||||
(define (prompt-crypt?)
|
||||
(prompt-bool
|
||||
#:heading "Do you want an encrypted system?\n"))
|
||||
|
||||
(define (prompt-crypt-passwd)
|
||||
(prompt-passwd
|
||||
#:heading "Enter crypt device password\n"
|
||||
#:fn (lambda (passwd)
|
||||
(wrap-option passwd (lambda (passwd)
|
||||
;; dont allow empty password
|
||||
(>= (string-length passwd) 1))))))
|
||||
|
||||
(define (prompt-crypt-reconfirm-passwd)
|
||||
(prompt-passwd
|
||||
#:heading "\nReconfirm crypt password\n"
|
||||
#:clear? #f
|
||||
#:confirm? #f))
|
||||
|
||||
(define (prompt-swap?)
|
||||
(prompt-bool
|
||||
#:heading "Do you want a swap partition?\n"))
|
||||
|
||||
(define (prompt-swap-size dev-size)
|
||||
(let* ((max* (round (/ (- dev-size 1) 2))) ; (GiB - 1) / 2
|
||||
(heading (format #f "How large should the swap parition be? [1-~a] GiB\n" max*)))
|
||||
(prompt-number
|
||||
#:heading heading
|
||||
#:fn (lambda (num)
|
||||
(cond ((> num max*) (none))
|
||||
((< num 1) (none))
|
||||
(#t (some num)))))))
|
||||
|
||||
(define (prompt-hostname)
|
||||
(prompt*
|
||||
#:heading "What will the hostname of this device be?\n"
|
||||
#:prompt "Hostname: "
|
||||
#:err "Invalid Hostname"
|
||||
#:fn (lambda (hostname)
|
||||
(wrap-option hostname (lambda (hostname)
|
||||
(string-match "[a-zA-Z]{1,63}" hostname))))
|
||||
#:confirm? #t))
|
||||
|
||||
(define (prompt-installer-config)
|
||||
(let inner ()
|
||||
(let* (; get all config values
|
||||
(dev (prompt-block-device))
|
||||
(filesystem (prompt-filesystem))
|
||||
(crypt? (prompt-crypt?))
|
||||
(crypt-passwd (if crypt?
|
||||
(prompt-crypt-passwd) #f))
|
||||
(swap? (prompt-swap?))
|
||||
(swap-size (if swap?
|
||||
(prompt-swap-size (block-device-size dev)) 0))
|
||||
(hostname (prompt-hostname))
|
||||
; confirm result
|
||||
(boolean->string (lambda (bool)
|
||||
(if bool "true" "false")))
|
||||
(heading
|
||||
(string-append
|
||||
(format #f "Disk: ~a\n" dev)
|
||||
(format #f "Filesystem: ~a\n" filesystem)
|
||||
(format #f "Crypt: ~a\n" (boolean->string crypt?))
|
||||
(if crypt?
|
||||
(format #f "Crypt passwd: ~a\n" "********") "")
|
||||
(format #f "Swap: ~a\n" (boolean->string swap?))
|
||||
(if swap?
|
||||
(format #f "Swap Size: ~d (GiB)\n" swap-size) "")
|
||||
(format #f "Hostname: ~a\n" hostname)
|
||||
"\nAre these options correct?\n"))
|
||||
(confirm?
|
||||
;; make sure this is what the user wants
|
||||
(cond ((not (prompt-bool #:heading heading)) #f)
|
||||
;; make sure the user acutally knows the crypt password
|
||||
((not (or (not crypt?)
|
||||
(string=? crypt-passwd
|
||||
(prompt-crypt-reconfirm-passwd)))) #f)
|
||||
;; approved
|
||||
(#t #t))))
|
||||
(if confirm?
|
||||
; config approved
|
||||
(installer-config
|
||||
(dev dev)
|
||||
(filesystem filesystem)
|
||||
(crypt? crypt?)
|
||||
(crypt-passwd crypt-passwd)
|
||||
(swap? swap?)
|
||||
(swap-size swap-size)
|
||||
(hostname hostname))
|
||||
; re-prompt values
|
||||
(inner)))))
|
||||
|
||||
;;
|
||||
;; step 1. partition
|
||||
;;
|
||||
|
||||
(define* (parted dev . args)
|
||||
(invoke (cons* "parted"
|
||||
dev
|
||||
"--script"
|
||||
args)))
|
||||
|
||||
(define (create-partition part)
|
||||
(let* (;; partition info
|
||||
(dev (partition-dev part))
|
||||
(label (partition-label part))
|
||||
(index (partition-index part))
|
||||
(type (partition-type part))
|
||||
;; start and end
|
||||
(start (partition-start part))
|
||||
(start* (string-append (number->string start)
|
||||
"MiB"))
|
||||
(end (partition-end part))
|
||||
(end* (if end
|
||||
(string-append (number->string end)
|
||||
"MiB")
|
||||
"100%")))
|
||||
;; create partition
|
||||
(parted dev
|
||||
"mkpart" label type start* end*)
|
||||
;; when boot?
|
||||
(when (partition-boot? part)
|
||||
(parted dev
|
||||
"set" index "boot" "on"))
|
||||
;; when swap?
|
||||
(when (partition-swap? part)
|
||||
(parted dev
|
||||
"set" index "swap" "on"))))
|
||||
|
||||
(define (create-partitions partitions)
|
||||
(let ((dev (partition-dev (car partitions))))
|
||||
(parted dev "mklabel" "gpt"))
|
||||
(for-each create-partition
|
||||
partitions))
|
||||
|
||||
;;
|
||||
;; step 2. format
|
||||
;;
|
||||
|
||||
(define (format-luks config part)
|
||||
(let* (;read needed config values
|
||||
(name (partition-name part))
|
||||
(label (partition-crypt-label part))
|
||||
(crypt-passwd (config-crypt-passwd config)))
|
||||
(format #t "formatting ~a with luks\n" name)
|
||||
;; format root partition with luksFormat
|
||||
(invoke `("cryptsetup" "-q" "luksFormat" ,name)
|
||||
#:stdin (string-append crypt-passwd "\n"
|
||||
crypt-passwd "\n"))
|
||||
;; open luks
|
||||
(invoke `("cryptsetup" "open" ,name ,label)
|
||||
#:stdin (string-append crypt-passwd "\n"))
|
||||
;; format luks mapper
|
||||
(format-path (partition-type part)
|
||||
(string-append "/dev/mapper/" label))))
|
||||
|
||||
(define (format-path type path)
|
||||
(format #t "formatting ~a with ~a\n" path type)
|
||||
(match type
|
||||
('fat32 (invoke* "mkfs.vfat" "-F" "32" path))
|
||||
('btrfs (invoke* "mkfs.btrfs" "--force" path))
|
||||
('ext4 (invoke* "mkfs.ext4" path))
|
||||
('linux-swap (invoke* "mkswap" path))
|
||||
(_ (throw 'unknown-fs (string-append "Unhandeled partition type: "
|
||||
(symbol->string type))))))
|
||||
|
||||
(define (format-partition config part)
|
||||
(let* (;; partition info
|
||||
(label (partition-label part))
|
||||
(name (partition-name part))
|
||||
(type (partition-type part)))
|
||||
(if (partition-crypt? config part)
|
||||
(format-luks config part)
|
||||
(format-path type name))))
|
||||
|
||||
(define (format-partitions config partitions)
|
||||
(for-each (lambda (part)
|
||||
(format-partition config part))
|
||||
partitions))
|
||||
|
||||
;;
|
||||
;; step 3. mount
|
||||
;;
|
||||
|
||||
(define (mount-path from to)
|
||||
(format #t "mounting ~a to ~a\n" from to)
|
||||
(invoke* "mkdir" "-p" to)
|
||||
(invoke* "mount" from to))
|
||||
|
||||
(define (mount-swap from)
|
||||
(format #t "swapping ~a\n" from)
|
||||
(invoke* "swapon" from))
|
||||
|
||||
(define (mount-partitions config partitions)
|
||||
(let* ((root (find-partition partitions 'root))
|
||||
(swap (find-partition partitions 'swap))
|
||||
(boot (find-partition partitions 'boot)))
|
||||
;; root
|
||||
(let ((path (if (partition-crypt? config root)
|
||||
(string-append "/dev/mapper/" (partition-crypt-label root))
|
||||
(partition-name root))))
|
||||
(mount-path path "/mnt"))
|
||||
;; swap
|
||||
(when swap
|
||||
(mount-swap (partition-name swap)))
|
||||
;; boot
|
||||
(mount-path (partition-name boot) "/mnt/boot")))
|
||||
|
||||
;;
|
||||
;; step 4. create specification
|
||||
;;
|
||||
|
||||
(define %base-scm-path
|
||||
(string-append %dotfiles-dir
|
||||
"/files/base.scm.m4"))
|
||||
|
||||
(define (get-specification config partitions)
|
||||
(let* (;; config values
|
||||
(host (config-hostname config))
|
||||
(fsys (symbol->string (config-filesystem config)))
|
||||
(swap? (config-swap? config))
|
||||
(crypt? (config-crypt? config))
|
||||
;; uuid helper
|
||||
(getuuid (lambda (label)
|
||||
(let ((part (find-partition partitions label)))
|
||||
(if part
|
||||
(block-device-uuid
|
||||
(partition-name part))
|
||||
#f))))
|
||||
;; uuids
|
||||
(root (getuuid 'root))
|
||||
(swap (getuuid 'swap))
|
||||
(boot (getuuid 'boot)))
|
||||
(invoke* "m4"
|
||||
; Required
|
||||
(string-append "--define=HOST=" host)
|
||||
(string-append "--define=ROOT=" root)
|
||||
(string-append "--define=BOOT=" boot)
|
||||
(string-append "--define=FSYS=" fsys)
|
||||
; Optional
|
||||
(if crypt?
|
||||
"--define=CRYPT")
|
||||
(if swap?
|
||||
(string-append "--define=SWAP=" swap))
|
||||
; Pass in file
|
||||
%base-scm-path)))
|
||||
|
||||
;;
|
||||
;; step 5. install system
|
||||
;;
|
||||
|
||||
(define %channels-path
|
||||
(string-append %dotfiles-dir
|
||||
"/channels.scm"))
|
||||
|
||||
(define %modules-path
|
||||
(string-append %dotfiles-dir
|
||||
"/modules"))
|
||||
|
||||
(define %substitute-urls
|
||||
(list "https://substitutes.nonguix.org"
|
||||
"https://substitutes.freya.cat"
|
||||
"https://bordeaux.guix.gnu.org"
|
||||
"https://ci.guix.gnu.org"))
|
||||
|
||||
(define (install-system config scm)
|
||||
(let* ((hostname (config-hostname config))
|
||||
(system-scm (string-append %dotfiles-dir
|
||||
"/systems/"
|
||||
hostname
|
||||
".scm")))
|
||||
;; write scm to system-scm
|
||||
(write-file system-scm scm)
|
||||
;; start cow store
|
||||
(system* "herd" "start" "cow-store" "/mnt")
|
||||
;; approve signing keys
|
||||
(for-each (lambda (key)
|
||||
(invoke '("guix" "archive" "--authorize")
|
||||
#:stdin (read-file key)))
|
||||
(map (lambda (name)
|
||||
(string-append %dotfiles-dir
|
||||
"/files/keys/"
|
||||
name))
|
||||
(list "nonguix.pub"
|
||||
"sakura.pub")))
|
||||
;; install base system
|
||||
(system* "guix-retry" ; fix TLS 'write_to_session_record_port' failures
|
||||
"guix" "time-machine" "-C" %channels-path "--"
|
||||
"system" "-L" %modules-path
|
||||
(string-append "--substitute-urls='"
|
||||
(string-join %substitute-urls " ")
|
||||
"'")
|
||||
"init" system-scm "/mnt")))
|
||||
|
||||
;;
|
||||
;; entry
|
||||
;;
|
||||
|
||||
(let* (; step 0 - prompt
|
||||
(config (prompt-installer-config))
|
||||
(partitions (config->partitions config))
|
||||
; step 1 - partition
|
||||
(_ (create-partitions partitions))
|
||||
; step 2 - format
|
||||
(_ (format-partitions config partitions))
|
||||
; step 3 - mount
|
||||
(_ (mount-partitions config partitions))
|
||||
;; step 4 - create specification
|
||||
(scm (get-specification config partitions))
|
||||
; step 5 - install
|
||||
(_ (install-system config scm)))
|
||||
#t)
|
||||
Loading…
Reference in a new issue