Date: Wed, 25 Dec 2002 00:36:44 +0200 From: Vadim Vygonets <vadik-hackers@freebsd.vygo.net> To: freebsd-hackers@freebsd.org Subject: Forth code Message-ID: <20021224223643.GA703@cs.huji.ac.il>
next in thread | raw e-mail | index | archive | help
--AqsLC8rIMeq19msA
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
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.
--AqsLC8rIMeq19msA
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="perhost.4th"
.( 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
--AqsLC8rIMeq19msA
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="passwd.4th"
\ /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: <system@cs.huji.ac.il> 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
--AqsLC8rIMeq19msA--
To Unsubscribe: send mail to majordomo@FreeBSD.org
with "unsubscribe freebsd-hackers" in the body of the message
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20021224223643.GA703>