| git.druid.rocks | index | druid520 | kaboom | mk/ | disk.pl |
mk/disk.pl
#!/usr/bin/perl
# mk/disk.pl: builds a ready-to-boot kfs disk image, lays out the
# plan9-flavored directory tree kaboom uses, and bakes every compiled
# binary under out/user/ into /bin -- the host-side half of "compile
# everything, then get it onto a disk" (mk/b.sh compiles the kernel,
# mk/bu.sh compiles userspace AND runs this script afterward, since
# nothing running ON kaboom can write to its own boot disk before it
# exists). runs on its own too (`perl mk/disk.pl`) whenever only the
# disk needs rebuilding, not the userspace binaries themselves.
#
# fully modular by design: this globs out/user/*.elf rather than
# naming programs, so dropping a new .nsc file in src/user/ and
# running mk/bu.sh puts it on the disk with zero changes anywhere
# else -- no kernel wiring, no edit to this file. the one exception
# is "sh" itself, which kmain.nsc's boot sequence execs by name as
# init; everything else is genuinely just data to this script.
#
# this is a from-scratch, host-side reimplementation of kfs's
# on-disk format -- not a port of any part of kfs.nsc, just written
# to match its byte layout exactly (superblock fields, one-inode-per-
# block, direct + single- + double-indirect block pointers, the dirent format's
# single-low-byte inode number and ~0 empty-slot sentinel). kept in
# sync BY HAND with src/fs/kfs.nsc; if that format ever changes, this
# must change with it -- there is no shared source of truth between
# them, the same way a bootloader and the kernel it loads usually
# don't share one either.
#
# directory layout (plan9-flavored, not a plan9 clone): kaboom has no
# user accounts, so /usr and /cfg/usr are single flat directories,
# not per-user subdirectories -- the equivalent of one person's own
# /root+/home and its .config, since there's no second person to
# separate them from.
# /bin system binaries (everything out/user/*.elf produces)
# /usr general-purpose personal files (no users -> one flat dir)
# /cfg/sys system configuration (/etc's job)
# /cfg/usr personal configuration (no users -> one flat dir)
# /lib libraries, for whenever kaboom has shared ones to store
# /doc plaintext system documents, $NAME.doc -- empty for now,
# the previous placeholder docs were removed (see the
# comment right before this directory's own content below)
# /proc kernel-mounted process info: /proc/version, /proc/self,
# and /proc/ps, backed by exec.nsc's real, if shallow (two
# deep: sh, plus whatever single command it's currently
# running) process table. a real per-pid subdirectory tree
# (/proc/1/status etc) still isn't here -- that needs
# virtual DIRECTORIES, not just virtual files (see
# virtfs.nsc's own note). the files this script creates
# here are build-time PLACEHOLDERS ONLY: virtfs.nsc's
# virtfs_read intercepts opens under this directory in
# fd_open and generates real content live instead, so
# what's actually on disk for these never gets read back
# -- see virtfs.nsc's own comment for the full mechanism
# and file list.
# /int "interaction": /sys+/dev+custom, same live-generated
# mechanism as /proc (kbd/mem/kfs live status)
# /dat general-purpose system data (/var+/opt+ordinary /usr)
#
# usage: perl mk/disk.pl [out/disk.img] -- resolves out/ relative to
# the repo root regardless of the caller's own cwd, same as every
# other mk/ script here.
use strict;
use warnings;
use File::Basename qw(dirname basename);
use Cwd qw(abs_path);
chdir(dirname(dirname(abs_path(__FILE__)))) or die "cd: $!";
my $out = $ARGV[0] // 'out/disk.img';
my $userdir = 'out/user';
# kfs's own block 0 (the superblock) lives at real disk lba 1025, not
# 0 -- lba 0-1024 hold the bios bootloader ("dynamite", 1 sector, see
# src/boot/dynamite.s) and the raw kernel blob it loads (1024 sectors
# reserved), both embedded near the bottom of this file. must match
# kfs.nsc's own KFS_LBA_BASE exactly (see kfs_read_block/
# kfs_write_block there) or kfs_mount looks for its superblock at the
# wrong real sector and fails outright.
my $KFS_LBA_BASE = 1025;
my $BLOCK = 512;
my $MAGIC;
{
no warnings 'portable'; # this literal is > 0xffffffff by design (see kfs.nsc's own identical fix in nscc for the same warning)
$MAGIC = 0x73666d6f6f62616b; # "kaboomfs", little-endian, matches kfs.nsc
}
my @bins = sort map { basename($_, '.elf') } glob("$userdir/*.elf");
@bins or die "mk/disk.pl: no *.elf under $userdir -- run mk/bu.sh first\n";
# 10 fixed directories (see the layout comment above) + one inode per
# binary + root itself, plus real slack (the "+3" is leftover headroom
# from when /doc had 3 build-time files; harmless to keep, no need to
# shrink it) for whatever gets created later (mkdir, ed saves, ...)
# without needing to reformat.
my $inode_count = 10 + scalar(@bins) + 3 + 1 + 32;
my @blocks; # index = lba, value = 512-byte string (always exactly $BLOCK bytes)
sub put_block { my ($lba, $data) = @_; $blocks[$lba + $KFS_LBA_BASE] = pack('a512', $data); }
sub zero_block { return "\0" x $BLOCK; }
my $inode_table_lba = 1;
my $root_dir_lba = $inode_table_lba + $inode_count;
my $data_start_lba = $root_dir_lba + 1;
my $root_inode = 0;
my $next_free_block = $data_start_lba;
my $next_free_inode = 1; # inode 0 is root
# superblock (block 0): magic, total_blocks, inode_table_lba,
# inode_count, root_dir_lba, data_start_lba, root_inode -- 7 u64
# fields at offsets 0,8,...,48, same as kfs_mkfs writes them. this is
# only the last 5 -- magic and total_blocks are prepended separately
# at the very end, once the real block count (after every file's
# data) is known.
my $superblock_tail = pack('Q<5', $inode_table_lba, $inode_count, $root_dir_lba, $data_start_lba, $root_inode);
# every inode-table block starts zeroed (type=0 = KFS_TYPE_FREE).
for (my $i = 0; $i < $inode_count; $i++) {
put_block($inode_table_lba + $i, zero_block());
}
# an inode is one whole 512-byte block: type, perm, size, 56 direct block
# ptrs, 1 single-indirect ptr, 4 double-indirect ptrs (61 total 8-byte
# slots after the 24-byte header -- same total slot count and inode size
# as before double indirection, just 4 of the direct slots repurposed as
# double-indirect pointers to reach kfs.nsc's ~8mb ceiling). matches
# kfs_write_file/kfs_block_tier's own format exactly -- see kfs.nsc's
# kfs_block_tier for the exact tier arithmetic this mirrors: direct 0-55
# (offsets 24..471), single-indirect (offset 472) covers blocks 56-119,
# double-indirect (offsets 480/488/496/504) covers blocks 120-16503 (4
# pointers * 64 * 64 blocks each). pointer blocks are allocated after
# the file's data blocks here rather than interleaved with them the way
# kfs_write_file does at runtime -- lba ORDER is irrelevant to readers,
# only the pointer structure itself has to agree.
sub write_inode {
my ($n, $type, $perm, $size, @block_ptrs) = @_;
my $total = scalar(@block_ptrs);
die "mk/disk.pl: $n needs $total blocks, over the 16504-block (8450048-byte) cap this script bakes files in at\n"
if $total > 16504;
my $ndirect = $total < 56 ? $total : 56;
my @direct = splice(@block_ptrs, 0, $ndirect);
my $sind_ptr = 0;
if (@block_ptrs) {
my $n_sind = scalar(@block_ptrs) < 64 ? scalar(@block_ptrs) : 64;
my @sind = splice(@block_ptrs, 0, $n_sind);
$sind_ptr = $next_free_block++;
put_block($sind_ptr, pack('Q<*', @sind) . ("\0" x (8 * (64 - scalar(@sind)))));
}
my @dptrs = (0, 0, 0, 0);
for my $dp (0 .. 3) {
last unless @block_ptrs;
my @l1_ptrs;
for my $l1i (0 .. 63) {
last unless @block_ptrs;
my $n_l2 = scalar(@block_ptrs) < 64 ? scalar(@block_ptrs) : 64;
my @l2 = splice(@block_ptrs, 0, $n_l2);
my $l2_lba = $next_free_block++;
put_block($l2_lba, pack('Q<*', @l2) . ("\0" x (8 * (64 - scalar(@l2)))));
push @l1_ptrs, $l2_lba;
}
my $l1_lba = $next_free_block++;
put_block($l1_lba, pack('Q<*', @l1_ptrs) . ("\0" x (8 * (64 - scalar(@l1_ptrs)))));
$dptrs[$dp] = $l1_lba;
}
die "mk/disk.pl: $n still has " . scalar(@block_ptrs) . " unplaced blocks after 4 double-indirect pointers\n"
if @block_ptrs;
my $inode = pack('Q<3', $type, $perm, $size)
. pack('Q<*', @direct) . ("\0" x (8 * (56 - scalar(@direct))))
. pack('Q<', $sind_ptr)
. pack('Q<4', @dptrs);
put_block($inode_table_lba + $n, $inode);
}
# one in-memory CHAIN of 512-byte dirent blocks per directory (a
# directory can span more than one block -- see the matching note
# above kfs_dir_next_block in kfs.nsc for the on-disk format this
# mirrors: slots 0-14 of each block are real dirents, slot 15's full
# 8-byte word is either ~0 (no next block) or the next block's lba),
# built up as entries are added and only actually written to $out at
# the very end (the flush loop near the bottom of this file).
my %dirs; # first_lba => [ { lba, block => 512-byte string, used => [15 x 0/1] }, ... ]
sub new_dir_block_str {
# NOT "(EXPR) x 16" inline: `x` treats a parenthesized left side as
# a list to repeat (even in a context that only ever wanted a
# scalar), which silently flattened this into extra hash elements
# instead of one 512-byte string -- bind the empty-slot string to
# a plain scalar first so `x` sees an unparenthesized left side and
# does a scalar repeat instead.
my $empty_slot = "\xff" x 8 . "\0" x 24;
return $empty_slot x 16; # slot 15's ~0 IS "no next block yet", already
}
sub new_dir_chain {
my ($lba) = @_;
return [ { lba => $lba, block => new_dir_block_str(), used => [(0) x 15] } ];
}
sub dir_add_entry {
my ($dir_lba, $name, $inode_num) = @_;
my $chain = $dirs{$dir_lba} or die "mk/disk.pl: dir_add_entry: unknown dir lba $dir_lba\n";
die "mk/disk.pl: name too long: $name\n" if length($name) > 23;
my $blk;
for my $b (@$chain) {
if (grep { !$_ } @{$b->{used}}) { $blk = $b; last; }
}
if (!$blk) {
# every block in the chain is genuinely full -- allocate one
# more and link it onto the end, same as kfs_dir_add_in does
# at runtime.
my $new_lba = $next_free_block++;
$blk = { lba => $new_lba, block => new_dir_block_str(), used => [(0) x 15] };
substr($chain->[-1]{block}, 480, 8) = pack('Q<', $new_lba);
push @$chain, $blk;
}
my $slot = -1;
for my $i (0 .. 14) {
if (!$blk->{used}[$i]) { $slot = $i; last; }
}
$blk->{used}[$slot] = 1;
my $off = $slot * 32;
# byte 0 = inode_num as a signed low byte (kfs_dir_add's own
# format -- see the NOTE above kfs_dir_find for why this is
# correct-but-fragile: only the low byte round-trips), bytes 1-7
# zeroed, bytes 8-31 the name, null-padded.
substr($blk->{block}, $off, 1) = pack('c', $inode_num);
substr($blk->{block}, $off + 1, 7) = "\0" x 7;
substr($blk->{block}, $off + 8, length($name) + 1) = $name . "\0";
}
sub write_data_blocks {
my ($data) = @_;
my $len = length($data);
my $nblocks = int(($len + $BLOCK - 1) / $BLOCK);
$nblocks = 1 if $nblocks == 0;
my @block_ptrs;
for my $b (0 .. $nblocks - 1) {
my $lba = $next_free_block++;
push @block_ptrs, $lba;
put_block($lba, pack('a512', substr($data, $b * $BLOCK, $BLOCK)));
}
return ($len, @block_ptrs);
}
sub make_dir {
my ($parent_lba, $name) = @_;
my $inode_num = $next_free_inode++;
my $lba = $next_free_block++;
$dirs{$lba} = new_dir_chain($lba);
write_inode($inode_num, 2, 7, 0, $lba); # type=dir, perm=rwx
dir_add_entry($parent_lba, $name, $inode_num);
return $lba;
}
sub make_file {
my ($parent_lba, $name, $data, $perm) = @_;
my $inode_num = $next_free_inode++;
my ($len, @block_ptrs) = write_data_blocks($data);
write_inode($inode_num, 1, $perm, $len, @block_ptrs); # type=file
dir_add_entry($parent_lba, $name, $inode_num);
return $inode_num;
}
# root directory inode + its own (as-yet-empty) dirent block chain.
write_inode($root_inode, 2, 7, 0, $root_dir_lba);
$dirs{$root_dir_lba} = new_dir_chain($root_dir_lba);
# the directory tree (see the layout comment up top).
my $bin_lba = make_dir($root_dir_lba, 'bin');
make_dir($root_dir_lba, 'usr');
my $cfg_lba = make_dir($root_dir_lba, 'cfg');
make_dir($cfg_lba, 'sys');
make_dir($cfg_lba, 'usr');
make_dir($root_dir_lba, 'lib');
my $doc_lba = make_dir($root_dir_lba, 'doc');
my $proc_lba = make_dir($root_dir_lba, 'proc');
my $int_lba = make_dir($root_dir_lba, 'int');
make_dir($root_dir_lba, 'dat');
# build-time placeholders only -- see the /proc layout comment above.
# content/size here is irrelevant, virtfs_read always wins at open time.
my $virt_placeholder = "(generated live by the kernel at read time)\n";
make_file($proc_lba, 'version', $virt_placeholder, 7);
make_file($proc_lba, 'self', $virt_placeholder, 7);
make_file($proc_lba, 'ps', $virt_placeholder, 7);
make_file($int_lba, 'mem', $virt_placeholder, 7);
make_file($int_lba, 'kbd', $virt_placeholder, 7);
make_file($int_lba, 'kfs', $virt_placeholder, 7);
make_file($int_lba, 'cpu', $virt_placeholder, 7);
make_file($int_lba, 'vmm', $virt_placeholder, 7);
# INTRO.doc/FS.doc/BIN.doc used to be built here -- removed for now
# (they'd gone stale against the real kernel more than once already;
# see git history if the old text is ever wanted back), real
# replacements to follow. /doc itself stays -- an empty, real
# directory, not a placeholder -- so anything written to it (cd doc;
# ed whatever.doc) works exactly as before.
# every compiled binary, auto-discovered -- see the file header for
# why this is a glob, not a list.
for my $p (@bins) {
my $f = "$userdir/$p.elf";
open(my $fh, '<:raw', $f) or die "open $f: $!";
local $/;
my $data = <$fh>;
close $fh;
my $len = length($data);
# 64 blocks, not 60: 4c (a real forth interpreter, not a small
# coreutil) needed the extra headroom even after real trimming --
# a generic bump, not a per-binary special case, since kfs itself
# already handles bigger files elsewhere (see elf.nsc's own note
# on double indirection).
die "mk/disk.pl: $p is $len bytes, over the 32768-byte cap this script bakes binaries in at\n"
if $len > 64 * $BLOCK;
# perm=rwx (7) -- needs the real x bit now that kfs.nsc actually
# enforces it (sys_exec refuses to run anything without it). this
# used to be 6, under the mistaken assumption "6 means rw" -- true
# in REAL unix octal (r=4,w=2), but not in kaboom's own, different
# scheme (r=1,w=2,x=4 -- see kfs.nsc's own top comment), where 6 is
# actually "wx", not "rw" at all. harmless before enforcement
# existed; would have made every binary on this disk unexecutable
# the moment it did, sh included, if left as-is.
my $inode_num = make_file($bin_lba, $p, $data, 7);
printf "mk/disk.pl: /bin/%-8s inode=%-3d bytes=%d\n", $p, $inode_num, $len;
}
# no /dynamite or /kaboom inspection files on disk -- they were real
# kfs files here for a while (pure duplicates of the raw bios-boot
# sector and kernel blob embedded below via embed_raw_region), useful
# during dynamite's own development to prove the two copies stayed
# byte-identical, but not needed now that both boot paths are proven
# and reviewed. the boot mechanism itself never read through kfs for
# these either way -- it always loaded the raw LBA regions directly,
# unaffected by this. a future, more capable bootloader revisiting
# this (dynamite reading /kaboom through kfs directly, eliminating the
# duplicate storage for real) is a real, separately-scoped project,
# not this.
for my $chain (values %dirs) {
for my $blk (@$chain) {
put_block($blk->{lba}, $blk->{block});
}
}
# total_blocks: the disk's real physical size, padded well past
# everything actually allocated so far -- NOT the same number.
# kfs_mount's allocator scan (kfs_scan_allocators) starts handing out
# fresh blocks starting at whatever's already in use, and a disk
# image sized to exactly that usage has no physical room for even
# the very first block a real mkdir/ed save would need: ata_write
# rejects a write to an lba the underlying disk image doesn't
# contain, since format=raw disks are just the file's own bytes --
# found for real the moment ed successfully reported "saved!" while
# writing to an lba one past the image's actual end, and the
# supposedly-written data silently never landed anywhere. pad to a
# comfortable multiple of actual usage, floored at a sane minimum,
# so ordinary interactive use (a handful of mkdirs, a few ed saves)
# never needs a reformat.
my $min_blocks = 4096; # 2mib
my $total_blocks = $next_free_block * 4;
$total_blocks = $min_blocks if $total_blocks < $min_blocks;
put_block(0, pack('Q<', $MAGIC) . pack('Q<', $total_blocks) . $superblock_tail);
# dynamite (bios bootloader) at lba 0, the raw kernel blob at lba
# 1..1024 -- the reserved region ahead of $KFS_LBA_BASE. read as raw
# bytes, split into 512-byte sectors, and written straight into
# @blocks (already indexed by REAL lba, see put_block) rather than
# through put_block, whose +$KFS_LBA_BASE shift is for kfs-relative
# block numbers only -- these are REAL lba 0 and REAL lba 1. both
# files come from mk/bl.sh (out/, not $out -- $out here is the image
# path itself).
sub embed_raw_region {
my ($file, $start_lba, $max_sectors) = @_;
open my $fh, '<:raw', $file or die "mk/disk.pl: cannot open $file: $! -- run mk/bl.sh first\n";
local $/;
my $data = <$fh>;
close $fh;
my $len = length($data);
my $sectors = int(($len + $BLOCK - 1) / $BLOCK);
die "mk/disk.pl: $file is $sectors sectors, exceeds the $max_sectors-sector reserved region at lba $start_lba\n"
if $sectors > $max_sectors;
$data .= "\0" x ($sectors * $BLOCK - $len);
for my $i (0 .. $sectors - 1) {
$blocks[$start_lba + $i] = substr($data, $i * $BLOCK, $BLOCK);
}
}
embed_raw_region('out/dynamite.bin', 0, 1);
embed_raw_region('out/kaboom.bin', 1, $KFS_LBA_BASE - 1);
# extend with real zero blocks, not just a sparse hole -- +$KFS_LBA_BASE
# for dynamite's sector + the kernel blob's reserved region ahead of
# kfs's own block 0 (put_block already shifted every block it wrote by
# the same amount; this is just the final image's own total size).
$#blocks = $total_blocks - 1 + $KFS_LBA_BASE;
open(my $out_fh, '>:raw', $out) or die "open $out: $!";
for my $lba (0 .. $#blocks) {
print $out_fh ($blocks[$lba] // zero_block());
}
close $out_fh;
printf "mk/disk.pl: wrote %s (%d blocks, %d bytes)\n", $out, scalar(@blocks), -s $out;