\

\ This file and its contents are supplied under the terms of the

\ Common Development and Distribution License ("CDDL"), version 1.0.

\ You may only use this file in accordance with the terms of version

\ 1.0 of the CDDL.

\

\ A full copy of the text of the CDDL should have accompanied this

\ source. A copy of the CDDL is also available via the Internet at

\ http://www.illumos.org/license/CDDL.

\ Copyright 2015 Toomas Soome <tsoome@me.com>

\ This module is implementing the beadm user command to support listing

\ and switching Boot Environments (BE) from command line and

\ support words to provide data for BE menu in loader menu system.

\ Note: this module needs an update to provide proper BE vocabulary.

only forth also support-functions also file-processing

also file-processing definitions also parser

also line-reading definitions also builtins definitions

variable page_count

variable page_remainder

0 page_count !

0 page_remainder !

\ from menu.4th

: +c! ( N C-ADDR/U K -- C-ADDR/U )

3 pick 3 pick ( n c-addr/u k -- n c-addr/u k n c-addr )

rot + c! ( n c-addr/u k n c-addr -- n c-addr/u )

rot drop ( n c-addr/u -- c-addr/u )

;

: get_value ( -- )

eat_space

line_pointer

skip_to_end_of_line

line_pointer over -

strdup value_buffer strset

['] exit to parsing_function

;

: get_name ( -- )

read_name

['] get_value to parsing_function

;

: get_name_value

line_buffer strget + to end_of_line

line_buffer .addr @ to line_pointer

['] get_name to parsing_function

begin

end_of_line? 0=

while

parsing_function execute

repeat

;

\ beadm support

: beadm_longest_title ( addr len -- width )

0 to end_of_file?

O_RDONLY fopen fd !

reset_line_reading

fd @ -1 = if EOPEN throw then

0 >r \ length into return stack

begin

end_of_file? 0=

while

free_buffers

read_line

get_name_value

value_buffer .len @ r@ > if r> drop value_buffer .len @ >r then

free_buffers

read_line

repeat

fd @ fclose

r> 1 + \ space between columns

;

\ Pretty print BE list

: beadm_list ( width addr len -- )

0 to end_of_file?

O_RDONLY fopen fd !

reset_line_reading

fd @ -1 = if EOPEN throw then

." BE" dup 2 - spaces ." bootfs" cr

begin

end_of_file? 0=

while

free_buffers

read_line

get_name_value

value_buffer strget type

dup value_buffer .len @ - spaces

free_buffers

read_line

get_name_value

value_buffer strget type cr

free_buffers

repeat

fd @ fclose

drop

;

: beadm_bootfs ( be_addr be_len menu_addr menu_len -- addr len flag )

0 to end_of_file?

O_RDONLY fopen fd !

reset_line_reading

fd @ -1 = if EOPEN throw then

2swap

begin

end_of_file? 0=

while

free_buffers

read_line

get_name_value

2dup value_buffer strget compare

0= if ( title == be )

2drop

free_buffers

read_line

get_name_value

value_buffer strget strdup -1

free_buffers

1 to end_of_file? \ mark end of file to skip the rest

else

read_line \ skip over next line

then

repeat

fd @ fclose

line_buffer strfree

read_buffer strfree

dup -1 > if ( dev_addr dev_len )

2drop

0 0 0

then

;

: current-dev ( -- addr len ) \ return current dev

s" currdev" getenv

2dup [char] / strchr nip

dup 0> if ( strchr '/' != NULL ) - else drop then

\ we have now zfs:pool or diskname:

;

\ chop trailing ':'

: colon- ( addr len -- addr len - 1 | addr len )

2dup 1 - + C@ [char] : = if ( string[len-1] == ':' ) 1 - then

;

\ add trailing ':'

: colon+ ( addr len -- addr len+1 )

2dup + \ addr len -- addr+len

[char] : swap c! \ save ':' at the end of the string

1+ \ addr len -- addr len+1

;

\ make menu.lst path

: menu.lst ( addr len -- addr' len' )

colon-

\ need to allocate space for len + 16

dup 16 + allocate if ENOMEM throw then

swap 2dup 2>R \ copy of new addr len to return stack

move 2R>

s" :/boot/menu.lst" strcat

;

\ list be's on device

: list-dev ( addr len -- )

menu.lst 2dup 2>R

beadm_longest_title

line_buffer strfree

read_buffer strfree

R@ swap 2R> \ addr width addr len

beadm_list free-memory

." Current boot device: " s" currdev" getenv type cr

line_buffer strfree

read_buffer strfree

;

\ activate be on device.

\ in case of zfs, we query device:/boot/menu.lst for bootfs and

\ use zfs:bootfs: for currdev

\ in case of ufs we have device name without ':', so we just

\ set currdev=device: and hope for best - there are no multiple BE's on ufs

: activate-dev ( dev.addr dev.len be.addr be.len -- )

2swap colon- \ remove : at the end of the dev name

2dup [char] : strchr nip

0= if ( no ':' in dev name, its ufs )

2swap 2drop

dup 1+ allocate if ENOMEM throw then

dup 2swap 0 -rot strcat

colon+

s" currdev" setenv \ setenv currdev = device

free-memory

else

dup 16 + allocate if ENOMEM throw then

swap 2dup 2>R \ copy of new addr len to return stack

move 2R> \ copy dev name and concat file name

s" :/boot/menu.lst" strcat 2dup \ leave copy to stack

beadm_bootfs if ( dev_addr dev_len addr len )

2swap \ addr len dev_addr dev_len

drop

free-memory

\ have dataset and need to get zfs:pool/ROOT/be:

dup 5 + allocate if ENOMEM throw then

0 s" zfs:" strcat

2swap strcat

colon+

2dup s" currdev" setenv

drop free-memory

else

2drop drop free \ free the file name

." Failed to process BE/dev" cr abort

then

then

\ need to do:

0 unload drop

free-module-options

\ unset kernel env?

start \ load config, kernel and modules

." Current boot device: " s" currdev" getenv type cr

;

\ beadm list [device]

\ beadm activate BE [device] BE

\

\ lists BE's from current or specified device /boot/menu.lst file

\ activates specified BE by unloading modules, setting currdev and

\ running start to load configuration.

: beadm ( -- ) ( throws: abort )

0= if ( interpreted ) get_arguments then

dup 0= if

." Usage:" cr

." beadm activate beName [device]" cr

." beadm list [device]" cr

." Use lsdev to get device names." cr

drop exit

then

\ First argument is 0 when we're interprated. See support.4th

\ for get_arguments reading the rest of the line and parsing it

\ stack: argN lenN ... arg1 len1 N

\ rotate arg1 len1, dont use argv[] as we want to get arg1 out of stack

-rot 2dup

s" list" compare-insensitive 0= if ( list )

2drop

argc 1 = if ( list currdev )

\ add dev to list of args and switch to case 2

current-dev rot 1 +

then

2 = if ( list device ) list-dev exit then

." too many arguments" cr abort

then

s" activate" compare-insensitive 0= if ( activate )

argc 1 = if ( missing be )

drop ." missing bName" cr abort

then

argc 2 = if ( activate be )

\ need to set arg list into proper order

1 + >R \ save argc+1 to return stack

\ if we have : in name, its device, inject

\ dummy be name, as it must be ufs device

2dup [char] : strchr nip

if ( its : in name )

s" ufs" R>

else

\ add device, swap with be and receive argc

current-dev 2swap R>

then

then

3 = if ( activate be device ) activate-dev exit then

." too many arguments" cr abort

then

." Unknown argument" cr abort

;

also forth definitions also builtins

\ make beadm available as user command.

builtin: beadm

\ count the pages of BE list

\ leave FALSE in stack in case of error

: be-pages ( -- flag )

1 local flag

0 0 2local currdev

0 0 2local title

end-locals

current-dev menu.lst 2dup 2>R

0 to end_of_file?

O_RDONLY fopen fd !

2R> drop free-memory

reset_line_reading

fd @ -1 = if FALSE else

s" currdev" getenv

over ( addr len addr )

4 s" zfs:" compare 0= if

5 - \ len -= 5

swap 4 + \ addr += 4

swap to currdev

then

0

begin

end_of_file? 0=

while

read_line

get_name_value

s" title" name_buffer strget compare

0= if 1+ then

flag if \ check for title

value_buffer strget strdup to title free_buffers

read_line \ get bootfs

get_name_value

value_buffer strget currdev compare 0= if

title s" zfs_be_active" setenv

0 to flag

then

title drop free-memory 0 0 to title

free_buffers

else

free_buffers

read_line \ get bootfs

then

repeat

fd @ fclose

line_buffer strfree

read_buffer strfree

5 /mod swap dup page_remainder ! \ save remainder

if 1+ then

dup page_count ! \ save count

s>d <# #s #> s" zfs_be_pages" setenv

TRUE

then

;

: be-set-page { | entry count n -- }

page_count @ 0= if

be-pages

page_count @ 0= if exit then

then

s" zfs_be_currpage" getenv dup -1 = if

drop s" 1"

then

0 s>d 2swap

>number ( ud caddr/u -- ud' caddr'/u' )

2drop

1 um/mod nip 5 *

page_count @ 5 *

page_remainder @ if

5 page_remainder @ - -

then

swap -

dup to entry

0 < if

entry 5 + to count

0 to entry

else

5 to count

then

current-dev menu.lst 2dup 2>R

0 to end_of_file?

O_RDONLY fopen fd !

2R> drop free-memory

reset_line_reading

fd @ -1 = if EOPEN throw then

0 to n

begin

end_of_file? 0=

while

n entry < if

read_line \ skip title

read_line \ skip bootfs

n 1+ to n

else

count 0 do

read_line \ read title line

get_name_value

value_buffer strget

52 i + \ ascii 4 + i

s" bootenvmenu_caption[4]" 20 +c! setenv

value_buffer strget

52 i + \ ascii 4 + i

s" bootenvansi_caption[4]" 20 +c! setenv

s" set_bootenv"

52 i + \ ascii 4 + i

s" bootenvmenu_command[4]" 20 +c! setenv

free_buffers

read_line \ read value line

get_name_value

52 i + \ ascii 4 + i

value_buffer strget swap drop

5 + allocate if ENOMEM throw then

s" zfs:" ( N addr addr1 len )

2 pick swap move ( N addr )

swap over ( addr N addr )

4 value_buffer

strget ( addr N addr 4 addr1 len )

strcat ( addr N addr 4+len )

s" :" strcat ( addr N addr 5+len )

rot ( addr addr 5+len N )

s" bootenv_root[4]" 13 +c! setenv

free-memory

free_buffers

loop

5 count do \ unset unused entries

52 i + \ ascii 4 + i

dup s" bootenvmenu_caption[4]" 20 +c! unsetenv

dup s" bootenvansi_caption[4]" 20 +c! unsetenv

dup s" bootenvmenu_command[4]" 20 +c! unsetenv

s" bootenv_root[4]" 13 +c! unsetenv

loop

1 to end_of_file? \ we are done

then

repeat

fd @ fclose

line_buffer strfree

read_buffer strfree

;