1\ 2\ This file and its contents are supplied under the terms of the 3\ Common Development and Distribution License ("CDDL"), version 1.0. 4\ You may only use this file in accordance with the terms of version 5\ 1.0 of the CDDL. 6\ 7\ A full copy of the text of the CDDL should have accompanied this 8\ source. A copy of the CDDL is also available via the Internet at 9\ http://www.illumos.org/license/CDDL. 10 11\ Copyright 2015 Toomas Soome <tsoome@me.com> 12 13\ This module is implementing the beadm user command to support listing 14\ and switching Boot Environments (BE) from command line and 15\ support words to provide data for BE menu in loader menu system. 16\ Note: this module needs an update to provide proper BE vocabulary. 17 18only forth also support-functions also file-processing 19also file-processing definitions also parser 20also line-reading definitions also builtins definitions 21 22variable page_count 23variable page_remainder 240 page_count ! 250 page_remainder ! 26 27\ from menu.4th 28: +c! ( N C-ADDR/U K -- C-ADDR/U ) 29 3 pick 3 pick ( n c-addr/u k -- n c-addr/u k n c-addr ) 30 rot + c! ( n c-addr/u k n c-addr -- n c-addr/u ) 31 rot drop ( n c-addr/u -- c-addr/u ) 32; 33 34: get_value ( -- ) 35 eat_space 36 line_pointer 37 skip_to_end_of_line 38 line_pointer over - 39 strdup value_buffer strset 40 ['] exit to parsing_function 41; 42 43: get_name ( -- ) 44 read_name 45 ['] get_value to parsing_function 46; 47 48: get_name_value 49 line_buffer strget + to end_of_line 50 line_buffer .addr @ to line_pointer 51 ['] get_name to parsing_function 52 begin 53 end_of_line? 0= 54 while 55 parsing_function execute 56 repeat 57; 58 59\ beadm support 60: beadm_longest_title ( addr len -- width ) 61 0 to end_of_file? 62 O_RDONLY fopen fd ! 63 reset_line_reading 64 fd @ -1 = if EOPEN throw then 65 0 >r \ length into return stack 66 begin 67 end_of_file? 0= 68 while 69 free_buffers 70 read_line 71 get_name_value 72 value_buffer .len @ r@ > if r> drop value_buffer .len @ >r then 73 free_buffers 74 read_line 75 repeat 76 fd @ fclose 77 r> 1 + \ space between columns 78; 79 80\ Pretty print BE list 81: beadm_list ( width addr len -- ) 82 0 to end_of_file? 83 O_RDONLY fopen fd ! 84 reset_line_reading 85 fd @ -1 = if EOPEN throw then 86 ." BE" dup 2 - spaces ." bootfs" cr 87 begin 88 end_of_file? 0= 89 while 90 free_buffers 91 read_line 92 get_name_value 93 value_buffer strget type 94 dup value_buffer .len @ - spaces 95 free_buffers 96 read_line 97 get_name_value 98 value_buffer strget type cr 99 free_buffers 100 repeat 101 fd @ fclose 102 drop 103; 104 105: beadm_bootfs ( be_addr be_len menu_addr menu_len -- addr len flag ) 106 0 to end_of_file? 107 O_RDONLY fopen fd ! 108 reset_line_reading 109 fd @ -1 = if EOPEN throw then 110 2swap 111 begin 112 end_of_file? 0= 113 while 114 free_buffers 115 read_line 116 get_name_value 117 2dup value_buffer strget compare 118 0= if ( title == be ) 119 2drop 120 free_buffers 121 read_line 122 get_name_value 123 value_buffer strget strdup -1 124 free_buffers 125 1 to end_of_file? \ mark end of file to skip the rest 126 else 127 read_line \ skip over next line 128 then 129 repeat 130 fd @ fclose 131 line_buffer strfree 132 read_buffer strfree 133 dup -1 > if ( dev_addr dev_len ) 134 2drop 135 0 0 0 136 then 137; 138 139: current-dev ( -- addr len ) \ return current dev 140 s" currdev" getenv 141 2dup [char] / strchr nip 142 dup 0> if ( strchr '/' != NULL ) - else drop then 143 \ we have now zfs:pool or diskname: 144; 145 146\ chop trailing ':' 147: colon- ( addr len -- addr len - 1 | addr len ) 148 2dup 1 - + C@ [char] : = if ( string[len-1] == ':' ) 1 - then 149; 150 151\ add trailing ':' 152: colon+ ( addr len -- addr len+1 ) 153 2dup + \ addr len -- addr+len 154 [char] : swap c! \ save ':' at the end of the string 155 1+ \ addr len -- addr len+1 156; 157 158\ make menu.lst path 159: menu.lst ( addr len -- addr' len' ) 160 colon- 161 \ need to allocate space for len + 16 162 dup 16 + allocate if ENOMEM throw then 163 swap 2dup 2>R \ copy of new addr len to return stack 164 move 2R> 165 s" :/boot/menu.lst" strcat 166; 167 168\ list be's on device 169: list-dev ( addr len -- ) 170 menu.lst 2dup 2>R 171 beadm_longest_title 172 line_buffer strfree 173 read_buffer strfree 174 R@ swap 2R> \ addr width addr len 175 beadm_list free-memory 176 ." Current boot device: " s" currdev" getenv type cr 177 line_buffer strfree 178 read_buffer strfree 179; 180 181\ activate be on device. 182\ in case of zfs, we query device:/boot/menu.lst for bootfs and 183\ use zfs:bootfs: for currdev 184\ in case of ufs we have device name without ':', so we just 185\ set currdev=device: and hope for best - there are no multiple BE's on ufs 186 187: activate-dev ( dev.addr dev.len be.addr be.len -- ) 188 2swap colon- \ remove : at the end of the dev name 189 2dup [char] : strchr nip 190 0= if ( no ':' in dev name, its ufs ) 191 2swap 2drop 192 dup 1+ allocate if ENOMEM throw then 193 dup 2swap 0 -rot strcat 194 colon+ 195 s" currdev" setenv \ setenv currdev = device 196 free-memory 197 else 198 dup 16 + allocate if ENOMEM throw then 199 swap 2dup 2>R \ copy of new addr len to return stack 200 move 2R> \ copy dev name and concat file name 201 s" :/boot/menu.lst" strcat 2dup \ leave copy to stack 202 beadm_bootfs if ( dev_addr dev_len addr len ) 203 2swap \ addr len dev_addr dev_len 204 drop 205 free-memory 206 \ have dataset and need to get zfs:pool/ROOT/be: 207 dup 5 + allocate if ENOMEM throw then 208 0 s" zfs:" strcat 209 2swap strcat 210 colon+ 211 2dup s" currdev" setenv 212 drop free-memory 213 else 214 2drop drop free \ free the file name 215 ." Failed to process BE/dev" cr abort 216 then 217 then 218 219 \ need to do: 220 0 unload drop 221 free-module-options 222 \ unset kernel env? 223 start \ load config, kernel and modules 224 ." Current boot device: " s" currdev" getenv type cr 225; 226 227\ beadm list [device] 228\ beadm activate BE [device] BE 229\ 230\ lists BE's from current or specified device /boot/menu.lst file 231\ activates specified BE by unloading modules, setting currdev and 232\ running start to load configuration. 233: beadm ( -- ) ( throws: abort ) 234 0= if ( interpreted ) get_arguments then 235 236 dup 0= if 237 ." Usage:" cr 238 ." beadm activate beName [device]" cr 239 ." beadm list [device]" cr 240 ." Use lsdev to get device names." cr 241 drop exit 242 then 243 \ First argument is 0 when we're interprated. See support.4th 244 \ for get_arguments reading the rest of the line and parsing it 245 \ stack: argN lenN ... arg1 len1 N 246 \ rotate arg1 len1, dont use argv[] as we want to get arg1 out of stack 247 -rot 2dup 248 249 s" list" compare-insensitive 0= if ( list ) 250 2drop 251 argc 1 = if ( list currdev ) 252 \ add dev to list of args and switch to case 2 253 current-dev rot 1 + 254 then 255 2 = if ( list device ) list-dev exit then 256 ." too many arguments" cr abort 257 then 258 s" activate" compare-insensitive 0= if ( activate ) 259 argc 1 = if ( missing be ) 260 drop ." missing bName" cr abort 261 then 262 argc 2 = if ( activate be ) 263 \ need to set arg list into proper order 264 1 + >R \ save argc+1 to return stack 265 \ if we have : in name, its device, inject 266 \ dummy be name, as it must be ufs device 267 2dup [char] : strchr nip 268 if ( its : in name ) 269 s" ufs" R> 270 else 271 \ add device, swap with be and receive argc 272 current-dev 2swap R> 273 then 274 then 275 3 = if ( activate be device ) activate-dev exit then 276 ." too many arguments" cr abort 277 then 278 ." Unknown argument" cr abort 279; 280 281also forth definitions also builtins 282 283\ make beadm available as user command. 284builtin: beadm 285 286\ count the pages of BE list 287\ leave FALSE in stack in case of error 288: be-pages ( -- flag ) 289 1 local flag 290 0 0 2local currdev 291 0 0 2local title 292 end-locals 293 294 current-dev menu.lst 2dup 2>R 295 0 to end_of_file? 296 O_RDONLY fopen fd ! 297 2R> drop free-memory 298 reset_line_reading 299 fd @ -1 = if FALSE else 300 s" currdev" getenv 301 over ( addr len addr ) 302 4 s" zfs:" compare 0= if 303 5 - \ len -= 5 304 swap 4 + \ addr += 4 305 swap to currdev 306 then 307 308 0 309 begin 310 end_of_file? 0= 311 while 312 read_line 313 get_name_value 314 s" title" name_buffer strget compare 315 0= if 1+ then 316 317 flag if \ check for title 318 value_buffer strget strdup to title free_buffers 319 read_line \ get bootfs 320 get_name_value 321 value_buffer strget currdev compare 0= if 322 title s" zfs_be_active" setenv 323 0 to flag 324 then 325 title drop free-memory 0 0 to title 326 free_buffers 327 else 328 free_buffers 329 read_line \ get bootfs 330 then 331 repeat 332 fd @ fclose 333 line_buffer strfree 334 read_buffer strfree 335 5 /mod swap dup page_remainder ! \ save remainder 336 if 1+ then 337 dup page_count ! \ save count 338 s>d <# #s #> s" zfs_be_pages" setenv 339 TRUE 340 then 341; 342 343: be-set-page { | entry count n -- } 344 page_count @ 0= if 345 be-pages 346 page_count @ 0= if exit then 347 then 348 349 s" zfs_be_currpage" getenv dup -1 = if 350 drop s" 1" 351 then 352 0 s>d 2swap 353 >number ( ud caddr/u -- ud' caddr'/u' ) 354 2drop 355 1 um/mod nip 5 * 356 page_count @ 5 * 357 page_remainder @ if 358 5 page_remainder @ - - 359 then 360 swap - 361 dup to entry 362 0 < if 363 entry 5 + to count 364 0 to entry 365 else 366 5 to count 367 then 368 current-dev menu.lst 2dup 2>R 369 0 to end_of_file? 370 O_RDONLY fopen fd ! 371 2R> drop free-memory 372 reset_line_reading 373 fd @ -1 = if EOPEN throw then 374 0 to n 375 begin 376 end_of_file? 0= 377 while 378 n entry < if 379 read_line \ skip title 380 read_line \ skip bootfs 381 n 1+ to n 382 else 383 count 0 do 384 read_line \ read title line 385 get_name_value 386 value_buffer strget 387 52 i + \ ascii 4 + i 388 s" bootenvmenu_caption[4]" 20 +c! setenv 389 value_buffer strget 390 52 i + \ ascii 4 + i 391 s" bootenvansi_caption[4]" 20 +c! setenv 392 s" set_bootenv" 393 52 i + \ ascii 4 + i 394 s" bootenvmenu_command[4]" 20 +c! setenv 395 free_buffers 396 read_line \ read value line 397 get_name_value 398 52 i + \ ascii 4 + i 399 value_buffer strget swap drop 400 5 + allocate if ENOMEM throw then 401 s" zfs:" ( N addr addr1 len ) 402 2 pick swap move ( N addr ) 403 swap over ( addr N addr ) 404 4 value_buffer 405 strget ( addr N addr 4 addr1 len ) 406 strcat ( addr N addr 4+len ) 407 s" :" strcat ( addr N addr 5+len ) 408 rot ( addr addr 5+len N ) 409 s" bootenv_root[4]" 13 +c! setenv 410 free-memory 411 free_buffers 412 loop 413 414 5 count do \ unset unused entries 415 52 i + \ ascii 4 + i 416 dup s" bootenvmenu_caption[4]" 20 +c! unsetenv 417 dup s" bootenvansi_caption[4]" 20 +c! unsetenv 418 dup s" bootenvmenu_command[4]" 20 +c! unsetenv 419 s" bootenv_root[4]" 13 +c! unsetenv 420 loop 421 422 1 to end_of_file? \ we are done 423 then 424 repeat 425 fd @ fclose 426 line_buffer strfree 427 read_buffer strfree 428; 429