run-liminix-vm.fnl (4959B)
1 (local { : fork : execp : unlink } (require :posix.unistd)) 2 (local { : wait } (require :posix.sys.wait)) 3 (local { : mkstemp : setenv } (require :posix.stdlib)) 4 (local { : fdopen } (require :posix.stdio)) 5 6 (fn pad-file [name kb chr] 7 (let [(fd out) (mkstemp "run-vm-XXXXXX") 8 pad-string (string.rep (or chr "\0") 1024)] 9 (with-open [f (fdopen fd :w)] 10 (for [i 1 kb] (f:write pad-string)) 11 (f:seek :set 0) 12 (with-open [input (assert (io.open name :rb))] 13 (f:write (input:read "*a"))) 14 (f:seek :end 0)) 15 out)) 16 17 (fn spawn [command args] 18 (match (fork) 19 (nil msg) (error (.. "couldn't fork: " msg)) 20 0 (execp command args) 21 pid (wait pid))) 22 23 (fn appendm [t2 t1] 24 (table.move t1 1 (# t1) (+ 1 (# t2)) t2) 25 t2) 26 27 (fn merge [table1 table2] 28 (collect [k v (pairs table2) &into table1] 29 k v)) 30 31 (fn assoc [tbl k v] 32 (tset tbl k v) 33 tbl) 34 35 (fn parse-args [args] 36 (match args 37 ["--background" dir & rest] (assoc (parse-args rest) :background dir) 38 ["--u-boot" bin & rest] 39 (assoc (parse-args rest) :u-boot bin) 40 ["--disk-image" image & rest ] (assoc (parse-args rest) 41 :disk-image (pad-file image 1024)) 42 ["--arch" arch & rest] (assoc (parse-args rest) :arch arch) 43 ["--phram-address" addr & rest] (assoc (parse-args rest) :phram-address addr) 44 ["--lan" spec & rest] (assoc (parse-args rest) :lan spec) 45 ["--wan" spec & rest] (assoc (parse-args rest) :wan spec) 46 ["--command-line" cmd & rest] (assoc (parse-args rest) :command-line cmd) 47 ["--flag" flag & rest] (let [o (parse-args rest)] 48 (assoc o :flags (doto o.flags (table.insert 1 flag)))) 49 [kernel rootfsimg] 50 { :flags [] :kernel kernel :rootfs (pad-file rootfsimg (* 16 1024)) } 51 )) 52 53 (fn pad-u-boot [options] 54 (if options.u-boot 55 (let [size (. 56 { 57 :mips (* 4 1024) 58 :aarch64 (* 64 1024) 59 :arm (* 64 1024) 60 } 61 options.arch)] 62 (assoc options 63 :u-boot 64 (pad-file options.u-boot size "\xff"))) 65 options)) 66 67 (local options 68 (assert 69 (pad-u-boot 70 (merge { :arch "mips" } (parse-args arg))) 71 (.. "Usage: " (. arg 0) " blah bah"))) 72 73 (fn background [dir] 74 (let [pid (.. dir "/pid") 75 sock (.. dir "/console") 76 monitor (.. dir "/monitor")] 77 ["--daemonize" 78 "--pidfile" pid 79 "-serial" (.. "unix:" sock ",server,nowait") 80 "-monitor" (.. "unix:" monitor ",server,nowait")])) 81 82 (fn access-net [override] 83 [ 84 "-netdev" (.. (or override 85 "socket,mcast=230.0.0.1:1234,localaddr=127.0.0.1") 86 ",id=access") 87 "-device" "virtio-net,disable-legacy=on,disable-modern=off,netdev=access,mac=ba:ad:1d:ea:21:02" 88 ]) 89 90 (fn local-net [override] 91 [ 92 "-netdev" (.. (or override "socket,mcast=230.0.0.1:1235,localaddr=127.0.0.1") 93 ",id=lan") 94 "-device" "virtio-net,disable-legacy=on,disable-modern=off,netdev=lan,mac=ba:ad:1d:ea:21:01" 95 ]) 96 97 98 (fn bootable [cmdline uboot disk] 99 (if uboot 100 ["-drive" (.. "if=pflash,format=raw,file=" uboot ) 101 "-drive" (.. "if=none,format=raw,id=hd0,file=" disk) 102 "-device" "virtio-blk-pci,drive=hd0" 103 ] 104 (let [cmdline (.. "root=/dev/mtdblock0" " " cmdline " mem=256M liminix mtdparts=phram0:16M(rootfs) phram.phram=phram0," options.phram-address ",16Mi,65536")] 105 ["-kernel" options.kernel "-append" cmdline]))) 106 107 (local bin { 108 :mips ["qemu-system-mips" "-M" "malta"] 109 :aarch64 ["qemu-system-aarch64" "-M" "virt" 110 "-cpu" "cortex-a72"] 111 :arm ["qemu-system-arm" "-M" "virt,highmem=off" 112 "-cpu" "cortex-a15"] 113 }) 114 115 (local exec-args 116 (-> [] 117 (appendm (. bin options.arch)) 118 (appendm ["-echr" "16"]) 119 (appendm options.flags) 120 (appendm (if options.phram-address 121 [ 122 "-m" "272" 123 "-device" 124 (.. "loader,file=" options.rootfs ",addr=" options.phram-address) 125 ] 126 ["-m" "256"])) 127 (appendm 128 (if options.background 129 (background options.background) 130 ["-serial" "mon:stdio"])) 131 (appendm (bootable (or options.command-line "") 132 options.u-boot options.disk-image)) 133 (appendm (access-net options.wan)) 134 (appendm (local-net options.lan)) 135 (appendm ["-display" "none"]))) 136 137 (each [n a (ipairs exec-args)] 138 (print (.. (if (> n 1) " " "") (string.format "%q" a)))) 139 140 (match exec-args 141 [cmd & params] (print (spawn cmd params))) 142 143 (if options.rootfs (unlink options.rootfs)) 144 (if options.u-boot (unlink options.u-boot)) 145 (if options.disk-image (unlink options.disk-image))