commit 98d333692645263b5866bed254681b59dc39d196
parent cb6ebbdc60edd8f6f17aa89fb5d3d8400bf1d787
Author: Daniel Barlow <dan@telent.net>
Date: Sun, 3 Dec 2023 22:51:39 +0000
rewrite run-liminix-vm as a fennel program
the effect of shell quoting/word splitting rules was reaching
completely unreasonable, insofar as I was unable to reason about it
Diffstat:
5 files changed, 138 insertions(+), 91 deletions(-)
diff --git a/modules/outputs/vmroot.nix b/modules/outputs/vmroot.nix
@@ -54,7 +54,7 @@ in
then "${pkgs.stdenv.cc.targetPrefix}objcopy -O binary -R .comment -S ${kernel} $out"
else "cp ${kernel} $out");
phram_address = lib.toHexString (config.hardware.ram.startAddress + 256 * 1024 * 1024);
- in pkgs.runCommandCC "vmroot" {} ''
+ in pkgs.runCommand "vmroot" {} ''
mkdir $out
cd $out
ln -s ${rootfs} rootfs
@@ -64,7 +64,7 @@ in
echo ${cmdline} > commandline
cat > run.sh << EOF
#!${pkgs.runtimeShell}
- CMDLINE=${cmdline} PHRAM_ADDRESS=0x${phram_address} ${pkgs.pkgsBuildBuild.run-liminix-vm}/bin/run-liminix-vm --arch ${pkgs.stdenv.hostPlatform.qemuArch} \$* ${makeBootableImage} ${config.system.outputs.rootfs}
+ ${pkgs.pkgsBuildBuild.run-liminix-vm}/bin/run-liminix-vm --command-line ${builtins.toJSON cmdline} --arch ${pkgs.stdenv.hostPlatform.qemuArch} --phram-address 0x${phram_address} \$* ${makeBootableImage} ${config.system.outputs.rootfs}
EOF
chmod +x run.sh
'';
diff --git a/pkgs/run-liminix-vm/default.nix b/pkgs/run-liminix-vm/default.nix
@@ -1,19 +1,23 @@
{
qemu
, socat
-, writeShellScriptBin
-, symlinkJoin
+, writeShellScript
+, writeFennel
+, runCommand
, lib
+, lua
+, pkgsBuildBuild
}: let
- run-liminix-vm = writeShellScriptBin "run-liminix-vm" ''
- export PATH="${lib.makeBinPath [qemu]}:$PATH"
- ${builtins.readFile ./run-liminix-vm.sh}
- '';
- connect = writeShellScriptBin "connect-vm" ''
+ run-liminix-vm = pkgsBuildBuild.writeFennel "run-liminix-vm" {
+ packages = [ qemu lua.pkgs.luaposix lua.pkgs.fennel ];
+ } ./run-liminix-vm.fnl;
+ connect = writeShellScript "connect-vm" ''
export PATH="${lib.makeBinPath [socat]}:$PATH"
socat -,raw,echo=0,icanon=0,isig=0,icrnl=0,escape=0x0f unix-connect:$1
'';
-in symlinkJoin {
- name = "run-liminix-vm";
- paths = [ run-liminix-vm connect ];
-}
+in runCommand "vm" {} ''
+ mkdir -p $out/bin
+ cd $out/bin
+ ln -s ${connect} ./connect-vm
+ ln -s ${run-liminix-vm} ./run-liminix-vm
+''
diff --git a/pkgs/run-liminix-vm/run-liminix-vm.fnl b/pkgs/run-liminix-vm/run-liminix-vm.fnl
@@ -0,0 +1,120 @@
+(local { : fork : execp : unlink } (require :posix.unistd))
+(local { : wait } (require :posix.sys.wait))
+(local { : mkstemp : setenv } (require :posix.stdlib))
+(local { : fdopen } (require :posix.stdio))
+
+(fn pad-file [name kb chr]
+ (let [(fd out) (mkstemp "run-vm-XXXXXXX")
+ pad-string (string.rep (or chr "\0") 1024)]
+ (with-open [f (fdopen fd :w)]
+ (for [i 1 kb] (f:write pad-string))
+ (f:seek :set 0)
+ (with-open [input (assert (io.open name :rb))]
+ (f:write (input:read "*a")))
+ (f:seek :end 0))
+ out))
+
+(fn spawn [command args]
+ (match (fork)
+ (nil msg) (error (.. "couldn't fork: " msg))
+ 0 (execp command args)
+ pid (wait pid)))
+
+(fn appendm [t2 t1]
+ (table.move t1 1 (# t1) (+ 1 (# t2)) t2)
+ t2)
+
+(fn merge [table1 table2]
+ (collect [k v (pairs table2) &into table1]
+ k v))
+
+(fn assoc [tbl k v]
+ (tset tbl k v)
+ tbl)
+
+(fn parse-args [args]
+ (match args
+ ["--background" dir & rest] (assoc (parse-args rest) :background dir)
+ ["--u-boot" bin & rest]
+ (assoc (parse-args rest) :u-boot (pad-file bin (* 4 1024) "\xff"))
+ ["--arch" arch & rest] (assoc (parse-args rest) :arch arch)
+ ["--phram-address" addr & rest] (assoc (parse-args rest) :phram-address addr)
+ ["--lan" spec & rest] (assoc (parse-args rest) :lan spec)
+ ["--command-line" cmd & rest] (assoc (parse-args rest) :command-line cmd)
+ [kernel rootfsimg]
+ { :kernel kernel :rootfs (pad-file rootfsimg (* 16 1024)) }
+ ))
+
+(local options
+ (assert
+ (merge { :arch "mips" } (parse-args arg))
+ (.. "Usage: " (. arg 0) " blah bah")))
+
+(fn background [dir]
+ (let [pid (.. dir "/pid")
+ sock (.. dir "/console")
+ monitor (.. dir "/monitor")]
+ ["--daemonize"
+ "--pidfile" pid
+ "-serial" (.. "unix:" sock ",server,nowait")
+ "-monitor" (.. "unix:" monitor ",server,nowait")]))
+
+(fn access-net []
+ [
+ "-netdev" "socket,id=access,mcast=230.0.0.1:1234,localaddr=127.0.0.1"
+ "-device" "virtio-net,disable-legacy=on,disable-modern=off,netdev=access,mac=ba:ad:1d:ea:21:02"
+ ])
+
+(fn local-net [override]
+ [
+ "-netdev" (.. (or override "socket,mcast=230.0.0.1:1235,localaddr=127.0.0.1")
+ ",id=lan")
+ "-device" "virtio-net,disable-legacy=on,disable-modern=off,netdev=lan,mac=ba:ad:1d:ea:21:01"
+ ])
+
+
+(fn bootable [cmdline uboot]
+ (if uboot
+ (let [pflash (os.tmpname)
+ ffs (string.rep "\xff" 1024)]
+ (with-open [f (assert (io.open pflash :wb))]
+ (for [i 1 (* 4 1024)] (f:write ffs))
+ (f:seek :set 0)
+ (with-open [uboot-bin (assert (io.open uboot :rb))]
+ (f:write (uboot-bin:read "*a")))
+ (f:seek :end 0))
+ ["-drive" (.. "if=pflash,format=raw,file=\"" pflash "\"")])
+ (let [cmdline (.. cmdline " liminix mtdparts=phram0:16M(rootfs) phram.phram=phram0," options.phram-address ",16Mi,65536 root=/dev/mtdblock0")]
+ ["-kernel" options.kernel "-append" cmdline])))
+
+(local bin {
+ :mips ["qemu-system-mips" "-M" "malta"]
+ :aarch64 ["qemu-system-aarch64" "-M" "virt"
+ "-semihosting" "-cpu" "cortex-a72"]
+ :arm ["qemu-system-arm" "-M" "virt,highmem=off"
+ "-cpu" "cortex-a15"]
+ })
+
+(local exec-args
+ (-> []
+ (appendm (. bin options.arch))
+ (appendm ["-m" "272"
+ "-echr" "16"
+ "-device"
+ (.. "loader,file=" options.rootfs ",addr=" options.phram-address)
+
+ ])
+ (appendm
+ (if options.background
+ (background options.background)
+ ["-serial" "mon:stdio"]))
+ (appendm (bootable (or options.command-line "") options.u-boot))
+ (appendm (access-net))
+ (appendm (local-net options.lan))
+ (appendm ["-display" "none"])))
+
+(match exec-args
+ [cmd & params] (print (spawn cmd params)))
+
+(if options.rootfs (unlink options.rootfs))
+(if options.u-boot (unlink options.u-boot))
diff --git a/pkgs/run-liminix-vm/run-liminix-vm.sh b/pkgs/run-liminix-vm/run-liminix-vm.sh
@@ -1,78 +0,0 @@
-#!/usr/bin/env bash
-
-cleanup(){
- test -n "$rootfs" && test -f $rootfs && rm $rootfs
-}
-trap 'exit 1' INT HUP QUIT TERM ALRM USR1
-trap 'cleanup' EXIT
-
-usage(){
- echo "usage: $(basename $0) [--background /path/to/state_directory] kernel rootimg [initramfs]"
- echo -e "\nWithout --background, use C-p c (not C-a c) to switch to the monitor"
- exit 1
-}
-
-arch="mips"
-if test "$1" = "--arch" ; then
- arch=$2
- shift;shift
-fi
-
-if test "$1" = "--background" ; then
- statedir=$2
- if test -z "$statedir" || ! test -d $statedir ; then
- usage
- fi
- pid="${statedir}/pid"
- socket="${statedir}/console"
- monitor="${statedir}/monitor"
- echo "running in background, socket is $socket, pid $pid"
- flags="--daemonize --pidfile $pid -serial unix:$socket,server,nowait -monitor unix:$monitor,server,nowait"
- shift;shift
-else
- flags="-serial mon:stdio"
-fi
-
-test -n "$2" || usage
-
-lan=${LAN-"socket,mcast=230.0.0.1:1235,localaddr=127.0.0.1"}
-
-rootfs=$(mktemp run-liminix-vm-fs-XXXXXX)
-dd if=/dev/zero of=$rootfs bs=1M count=16 conv=sync
-dd if=$2 of=$rootfs bs=65536 conv=sync,nocreat,notrunc
-
-if test -n "$3"; then
- initramfs="-initrd $3"
-fi
-
-case "$arch" in
- mips)
- QEMU="qemu-system-mips -M malta"
- ;;
- aarch64)
- QEMU="qemu-system-aarch64 -M virt -semihosting -cpu cortex-a72"
- ;;
- arm)
- # https://bugs.launchpad.net/qemu/+bug/1790975
- QEMU="qemu-system-arm -M virt,highmem=off -cpu cortex-a15"
- ;;
- *)
- echo "unrecognised arch $arch"
- exit 1;
- ;;
-esac
-
-phram="mtdparts=phram0:16M(rootfs) phram.phram=phram0,${PHRAM_ADDRESS},16Mi,65536 root=/dev/mtdblock0";
-
-set -x
-$QEMU \
- -m 272 \
- -echr 16 \
- -append "$CMDLINE liminix $phram" \
- -device loader,file=$rootfs,addr=$PHRAM_ADDRESS \
- ${initramfs} \
- -netdev socket,id=access,mcast=230.0.0.1:1234,localaddr=127.0.0.1 \
- -device virtio-net,disable-legacy=on,disable-modern=off,netdev=access,mac=ba:ad:1d:ea:21:02 \
- -netdev ${lan},id=lan \
- -device virtio-net,disable-legacy=on,disable-modern=off,netdev=lan,mac=ba:ad:1d:ea:21:01 \
- -kernel $1 -display none $flags ${QEMU_OPTIONS}
diff --git a/pkgs/write-fennel/default.nix b/pkgs/write-fennel/default.nix
@@ -27,6 +27,7 @@ name :
echo "#!${lua}/bin/lua ${luaFlags}"
echo "package.path = ${lib.strings.escapeShellArg (builtins.concatStringsSep "" luapath)} .. package.path"
echo "package.cpath = ${lib.strings.escapeShellArg (builtins.concatStringsSep "" luacpath)} .. package.cpath"
+ echo "require('posix.stdlib').setenv('PATH',${lib.escapeShellArg (lib.makeBinPath packages)} .. \":\" .. os.getenv('PATH'))"
fennel ${if correlate then "--correlate" else ""} --compile ${source}
) > ${name}.lua
'';
