Here is some boot loader forth code for your amusement. It's written for pxeboot, and is only usable if dhcp.host-name is set.
perhost.4th implements per-host forth files (loader.HOST.rc) and configuration files (loader.HOST.conf). I'm not really sure the code is correct. It works, but some questions remain: - Are there reasons not to redefine "start"? - Am I doing exception handling correctly? - Should I call "any_conf_read?" like I do now, twice? - Why is there "also" after "only forth" in the last line? passwd.4th implements a simple per-host password file. I didn't have the nerve to implement MD5 crypt(3) in forth, though, so the passwords are cleartext (as check-password accepts them). Vadik. -- Never let your schooling interfere with your education.
.( perhost.4th version 0: ) vocabulary perhost-functions only forth also support-functions also perhost-functions definitions string perhost-hostname : include_command s" include " ; : prefix s" /boot/loader." ; : rc_suffix s" .rc" ; : conf_suffix s" .conf" ; : s@ ( string -- addr len ) dup .addr @ swap .len @ ; : s! ( addr len string -- ) tuck .len ! .addr ! ; :noname s" dhcp.host-name" getenv dup -1 = if drop 0 0 else strdup then perhost-hostname s! ; execute perhost-hostname s@ type cr : perhost_rc_name ( -- addr len ) include_command nip prefix nip rc_suffix nip perhost-hostname .len @ + + + allocate if out_of_memory throw then 0 include_command strcat prefix strcat perhost-hostname s@ strcat rc_suffix strcat ; : load_perhost_rc perhost_rc_name over -rot ['] evaluate catch if 2drop then free if free_error throw then ; : perhost_conf_name ( -- addr len ) prefix nip conf_suffix nip perhost-hostname .len @ + + allocate if out_of_memory throw then 0 prefix strcat perhost-hostname s@ strcat conf_suffix strcat ; : load_perhost_conf perhost_conf_name over -rot set_current_file_name ['] load_conf catch process_conf_errors free if free_error throw then ; load_perhost_rc only forth definitions also support-functions also perhost-functions : start ( -- ) s" /boot/defaults/loader.conf" initialize include_conf_files any_conf_read? if false to any_conf_read? load_perhost_conf any_conf_read? if load_kernel load_modules then then ; only forth also
\ /boot/passwd.4th \ FORTH word load-password-file for FreeBSD's pxeboot(8). \ Copyright (c) 2002 \ The Hebrew University of Jerusalem. All rights reserved. \ By Vadim Vygonets for the Hebrew University of Jerusalem, \ School of Engineering and Computer Science, System Group. \ Date: 2002-12-22 \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ *** DOCUMENTATION *** \ \ \ \ \ WTF? \ \ This file provides the FORTH word load-password-file which \ reads the file /boot/loader.passwd and sets the variable \ password according to the DHCP host name. Normally, if this \ variable is set, if the FORTH word 'autoboot' returns (e.g., if \ the user interrupts the boot process by pressing a key at the \ countdown that the boot loader presents before running the \ loaded kernel), the boot loader asks for the password before \ dropping into the prompt. \ \ It's usable in an environment where several machines are \ network booted over PXE into FreeBSD using the same NFS root \ partition, and of these machines some need different boot \ loader passwords, and some need no password. (One normally \ needs no boot loader password in a protected environment, but I \ wouldn't dare to put a machine without a boot loader password \ in a publicly accessible lab.) \ \ The passwords are per machine. There may be a default password \ set in /boot/loader.conf(5), in which case it's still possible \ to leave some machines without password protection by setting \ empty passwords for them. \ \ \ \ \ THE FORMAT OF /boot/loader.passwd \ \ Each line can be either an empty line (no whitespace allowed), \ a comment line starting with a '#' character (no whitespace \ before '#' allowed), or a password entry. A password entry is \ a line of the format: \ hostname:password \ where: \ - 'hostname' is a valid hostname consisting of letters, \ digits, hyphens and dots (no further validity checks are \ performed). It should be the hostname as given by the \ DHCP server and presented by the loader(8) as environment \ variable "dhcp.host-name". \ - ':' is a colon character. \ - 'password' is a cleartext (sorry) password consisting of \ zero or more characters from 0x20 to 0x7E (printable \ ASCII). An empty password means no password for this \ host. \ No whitespace is allowed anywhere on such line except in \ password. If more than one password entry exists for the same \ hostname, the latest of them wins. \ \ \ \ \ USAGE: \ \ This file should be loaded from /boot/loader.rc using 'include'. \ \ /boot/support.4th must be loaded before this file. However, a \ default password may be set in loader.conf(8), which means that \ it's better to run load-password-file after loader.conf has \ been read (i.e., after the word 'start' in /boot/loader.rc). \ We use the following loader.rc: \ \ include /boot/loader.4th \ include /boot/passwd.4th \ start \ load-password-file \ check-password \ \ Note that the word check-password tries to autoboot, and only \ if autoboot fails it asks for the password. \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ .( passwd.4th version 0 ) \ Private definitions vocabulary passwd-functions only forth also support-functions also passwd-functions definitions : passwd_file_name s" /boot/loader.passwd" ; \ String support functions \ String load and store : s@ ( string -- addr len ) dup .addr @ swap .len @ ; : s! ( addr len string -- ) tuck .len ! .addr ! ; \ Char tolower : tolower ( char -- char' ) dup [char] A >= over [char] Z <= and if 32 + then ; \ In-place string tolower : strtolower ( addr len -- ) 0 ?do dup c@ tolower over c! char+ loop drop ; 0 [if] \ I forgot about "compare" when I wrote this. \ String comparition for equality : strequ ( addr len addr' len' -- equal? ) rot over <> if ( len != len' ) drop 2drop 0 exit then \ addr addr' len' >r 1 -rot r> \ 1 addr addr' len' 0 ?do over c@ over c@ <> if rot drop 0 -rot \ 0 addr addr' leave then char+ swap char+ \ Doesn't matter which one is which. loop 2drop ; [then] \ Our hostname variable string hostname :noname s" dhcp.host-name" getenv dup -1 = if drop 0 0 else strdup 2dup strtolower then hostname s! ; execute \ Parser data temporary storage string hostname_buffer string password_buffer \ Password file parser: \ <line> ::= <hostname>':'<password> | \ [<comment>] \ <hostname> ::= {letter|digit|'-'|'.'}+ \ <password> ::= {<passwd-charset>} \ <passwd-charset> ::= ASCII 32 to 126 \ <comment> ::= '#'{<anything>} : colon? line_pointer c@ [char] : = ; : hyphen? line_pointer c@ [char] - = ; : valid_in_hostname? letter? digit? hyphen? dot? or or or ; : printable? line_pointer c@ dup bl >= swap [char] ~ <= and ; : parse_whatever ( 'function -- addr len ) line_pointer swap begin dup execute while skip_character end_of_line? if drop line_pointer over - strdup exit then repeat drop line_pointer over - strdup ; : parse_hostname ( -- addr len ) ['] valid_in_hostname? parse_whatever ; : read_hostname parse_hostname 2dup strtolower hostname_buffer s! ; : parse_passwd ( -- addr len ) ['] printable? parse_whatever ; : read_passwd parse_passwd password_buffer s! ; : p_passwd read_passwd end_of_line? 0= if syntax_error throw then ['] comment to parsing_function ; : colon_sign colon? 0= if syntax_error throw then skip_character ['] p_passwd to parsing_function ; : p_hostname read_hostname ['] colon_sign to parsing_function ; : start_passwd_entry comment? if ['] comment to parsing_function exit then valid_in_hostname? if ['] p_hostname to parsing_function exit then syntax_error throw ; : get_passwd_entry \ line_buffer .addr @ line_buffer .len @ + to end_of_line \ line_buffer .addr @ to line_pointer line_buffer s@ over to line_pointer + to end_of_line ['] start_passwd_entry to parsing_function begin end_of_line? 0= while parsing_function execute repeat parsing_function ['] start_passwd_entry <> parsing_function ['] p_passwd <> parsing_function ['] comment <> and and if syntax_error throw then ; \ Process line : process_passwd_entry hostname s@ hostname_buffer s@ compare 0= if password .addr @ ?dup if free if free_error throw then then password_buffer s@ dup if strdup then password s! then ; : free_passwd_buffers line_buffer .addr @ dup if free then hostname_buffer .addr @ dup if free then password_buffer .addr @ dup if free then or or if free_error throw then ; : reset_passwd_buffers 0 0 hostname_buffer s! 0 0 password_buffer s! ; \ File processing : process_passwd_file begin end_of_file? 0= while reset_passwd_buffers read_line get_passwd_entry ['] process_passwd_entry catch ['] free_passwd_buffers catch swap throw throw repeat ; : process_passwd_file ( addr len -- ) 0 to end_of_file? 0 to read_buffer_ptr create_null_terminated_string over swap fopen swap free-memory dup -1 = if open_error throw then fd ! ['] process_passwd_file catch fd @ fclose throw ; : process_passwd_errors ?dup 0= if exit then -rot 2drop bell emit cr bell emit cr ." *** Error " dup . ." while reading password file " print_current_file cr dup syntax_error = if ." *** Syntax error" cr then \ dup set_error = if ." *** Bad definition" cr then dup read_error = if ." *** Error reading file" cr then dup open_error = if ." *** Unable to open file" cr then dup free_error = if ." *** Fatal error freeing memory" cr then dup out_of_memory = if ." *** Out of memory" cr then drop ( exception code ) \ XXX -- Maybe I should make the text below configurable? ." >>> Please contact the system group:" cr ." >>> e-mail: <[EMAIL PROTECTED]> phone: 85690" cr ." *** Press any key to reboot: " key cr ." --- " \ 0 reboot ; only forth definitions also support-functions also passwd-functions : load-password-file passwd_file_name set_current_file_name ['] process_passwd_file catch process_passwd_errors ; \ Return to strict forth vocabulary only forth also .( loaded.) cr