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

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
        '';

pkgs/run-liminix-vm/default.nix

@@ -1,19 +1,23 @@
 {
   qemu
 , socat
-, writeShellScriptBin
+, writeShellScript
-, symlinkJoin
+, writeFennel
+, runCommand
 , lib
+, lua
+, pkgsBuildBuild
 }: let
-  run-liminix-vm = writeShellScriptBin "run-liminix-vm" ''
+  run-liminix-vm = pkgsBuildBuild.writeFennel "run-liminix-vm" {
-     export PATH="${lib.makeBinPath [qemu]}:$PATH"
+    packages = [ qemu lua.pkgs.luaposix lua.pkgs.fennel ];
-     ${builtins.readFile ./run-liminix-vm.sh}
+  } ./run-liminix-vm.fnl;
-  '';
+  connect = writeShellScript "connect-vm" ''
-  connect = writeShellScriptBin "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 {
+in runCommand "vm" {} ''
-  name = "run-liminix-vm";
+  mkdir -p $out/bin
-  paths = [ run-liminix-vm connect ];
+  cd  $out/bin
-}
+  ln -s ${connect} ./connect-vm
+  ln -s ${run-liminix-vm} ./run-liminix-vm
+''

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))

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}

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
     '';