diff options
-rw-r--r-- | sys/boot/forth/loader.4th | 24 | ||||
-rw-r--r-- | sys/boot/forth/loader.conf.5 | 3 | ||||
-rw-r--r-- | sys/boot/forth/support.4th | 88 |
3 files changed, 101 insertions, 14 deletions
diff --git a/sys/boot/forth/loader.4th b/sys/boot/forth/loader.4th index 9f40cb2..132633a 100644 --- a/sys/boot/forth/loader.4th +++ b/sys/boot/forth/loader.4th @@ -38,6 +38,30 @@ only forth definitions also support-functions 0 autoboot ; +\ ***** check-password +\ +\ If a password was defined, execute autoboot and ask for +\ password if autoboot returns. + +: check-password + password .addr @ if + 0 autoboot + false >r + begin + bell emit bell emit + ." Password: " + password .len @ read-password + dup password .len @ = if + 2dup password .addr @ password .len @ + compare 0= if r> drop true >r then + then + drop free drop + r@ + until + r> drop + then +; + \ ***** start \ \ Initializes support.4th global variables, sets loader_conf_files, diff --git a/sys/boot/forth/loader.conf.5 b/sys/boot/forth/loader.conf.5 index 8a76f82..fa7834e 100644 --- a/sys/boot/forth/loader.conf.5 +++ b/sys/boot/forth/loader.conf.5 @@ -103,6 +103,9 @@ Name of the kernel to be loaded. If no kernel name is set, no additional modules will be loaded. .It Ar kernel_options Flags to be passed to the kernel. +.It Ar password +Provides a password to be asked by check-password before execution is +allowed to continue. .It Ar verbose_loading If set to .Dq YES , diff --git a/sys/boot/forth/support.4th b/sys/boot/forth/support.4th index 5f594ef..dbad5be 100644 --- a/sys/boot/forth/support.4th +++ b/sys/boot/forth/support.4th @@ -55,6 +55,7 @@ \ Exported global variables; \ \ string conf_files configuration files to be loaded +\ string password password \ cell modules_options pointer to first module information \ value verbose? indicates if user wants a verbose loading \ value any_conf_read? indicates if a conf file was succesfully read @@ -112,6 +113,7 @@ structure: module \ Global variables string conf_files +string password create module_options sizeof module.next allot create last_module_option sizeof module.next allot 0 value verbose? @@ -136,6 +138,10 @@ create last_module_option sizeof module.next allot then ; immediate +\ How come ficl doesn't have again? + +: again false postpone literal postpone until ; immediate + \ Private definitions vocabulary support-functions @@ -143,8 +149,11 @@ only forth also support-functions definitions \ Some control characters constants +7 constant bell +8 constant backspace 9 constant tab 10 constant lf +13 constant <cr> \ Read buffer size @@ -505,6 +514,10 @@ variable fd s" exec" assignment_type? ; +: password? + s" password" assignment_type? +; + : module_load? load_module_suffix suffix_type? ; @@ -703,16 +716,29 @@ variable fd : execute_command value_buffer .addr @ value_buffer .len @ over c@ [char] " = if - 2 chars - swap char+ swap + 2 - swap char+ swap then ['] evaluate catch if exec_error throw then ; +: set_password + password .addr @ ?dup if free if free_error throw then then + value_buffer .addr @ c@ [char] " = if + value_buffer .addr @ char+ value_buffer .len @ 2 - strdup + value_buffer .addr @ free if free_error throw then + else + value_buffer .addr @ value_buffer .len @ + then + password .len ! password .addr ! + 0 value_buffer .addr ! +; + : process_assignment name_buffer .len @ 0= if exit then loader_conf_files? if set_conf_files exit then verbose_flag? if set_verbose exit then execute? if execute_command exit then + password? if set_password exit then module_load? if set_module_flag exit then module_loadname? if set_module_loadname exit then module_type? if set_module_type exit then @@ -723,6 +749,12 @@ variable fd set_environment_variable ; +\ free_buffer ( -- ) +\ +\ Free some pointers if needed. The code then tests for errors +\ in freeing, and throws an exception if needed. If a pointer is +\ not allocated, it's value (0) is used as flag. + : free_buffers line_buffer .addr @ dup if free then name_buffer .addr @ dup if free then @@ -778,6 +810,7 @@ variable fd : initialize_support 0 read_buffer .addr ! 0 conf_files .addr ! + 0 password .addr ! 0 module_options ! 0 last_module_option ! 0 to verbose? @@ -851,31 +884,31 @@ variable current_conf_files current_conf_files @ conf_files .addr @ <> ; -: skip_leading_spaces { addr len ptr -- addr len ptr' } +: skip_leading_spaces { addr len pos -- addr len pos' } begin - ptr len = if addr len ptr exit then - addr ptr + c@ bl = + pos len = if addr len pos exit then + addr pos + c@ bl = while - ptr char+ to ptr + pos char+ to pos repeat - addr len ptr + addr len pos ; -: get_file_name { addr len ptr -- addr len ptr' addr' len' || 0 } - ptr len = if +: get_file_name { addr len pos -- addr len pos' addr' len' || 0 } + pos len = if addr free abort" Fatal error freeing memory" 0 exit then - ptr >r + pos >r begin - addr ptr + c@ bl <> + addr pos + c@ bl <> while - ptr char+ to ptr - ptr len = if - addr len ptr addr r@ + ptr r> - exit + pos char+ to pos + pos len = if + addr len pos addr r@ + pos r> - exit then repeat - addr len ptr addr r@ + ptr r> - + addr len pos addr r@ + pos r> - ; : get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 ) @@ -1065,6 +1098,33 @@ variable current_conf_files if s" echo Unable to load kernel: ${kernel_name}" evaluate abort then ; +: read-password { size | buf len -- } + size allocate if out_of_memory throw then + to buf + 0 to len + begin + key + dup backspace = if + drop + len if + backspace emit bl emit backspace emit + len 1 - to len + else + bell emit + then + else + dup <cr> = if cr drop buf len exit then + [char] * emit + len size < if + buf len chars + c! + else + drop + then + len 1+ to len + then + again +; + \ Go back to straight forth vocabulary only forth also definitions |