[OpenBIOS] r548 - ofw/inetv6
svn at openbios.org
svn at openbios.org
Thu Aug 16 00:59:54 CEST 2007
Author: lwalter
Date: 2007-08-16 00:59:54 +0200 (Thu, 16 Aug 2007)
New Revision: 548
Added:
ofw/inetv6/dhcpv6.fth
Modified:
ofw/inetv6/dns.fth
ofw/inetv6/dnsv6.fth
ofw/inetv6/ethernet.fth
ofw/inetv6/icmpinfo.fth
ofw/inetv6/loadpkg.fth
ofw/inetv6/neighdis.fth
ofw/inetv6/tcpv6.fth
Log:
Fix a couple of page fault bugs; Add IPv6 DNS support using tubes.laptop.org
Added: ofw/inetv6/dhcpv6.fth
===================================================================
--- ofw/inetv6/dhcpv6.fth (rev 0)
+++ ofw/inetv6/dhcpv6.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -0,0 +1,60 @@
+\ See license at end of file
+purpose: Dynamic Host Configuration Protocol for IPv6 (DHCPv6) (RFC 3315)
+
+[ifndef] include-ipv4
+d# 256 buffer: 'root-path
+d# 256 buffer: 'client-name
+d# 256 buffer: 'vendor-options
+headers
+' 'client-name " client-name" chosen-string
+' 'vendor-options " vendor-options" chosen-string
+' 'root-path " root-path" chosen-string
+: domain-name ( -- adr len ) 'domain-name cscount ;
+[then]
+
+\ tubes.laptop.org
+create default-name-server-ipv6 h# 20 c, 1 c, h# 48 c, h# 30 c, h# 24 c, h# 46 c, h# ff c, 0 c, 0 l, 0 w, 0 c, 1 c,
+
+: init-dhcpv6 ( -- )
+[ifndef] include-ipv4
+ 0 'domain-name c!
+ 0 'root-path c!
+ 0 'client-name c!
+ 0 'vendor-options c!
+\ 0 file-name-buf c!
+[then]
+ default-name-server-ipv6 name-server-ipv6 copy-ipv6-addr
+;
+
+also forth definitions
+stand-init: DHCPv6 init
+ init-dhcpv6
+;
+previous definitions
+
+: do-dhcp ( -- )
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Modified: ofw/inetv6/dns.fth
===================================================================
--- ofw/inetv6/dns.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/dns.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -244,6 +244,7 @@
[ifdef] include-ipv6
: resolve-aaaa ( hostname$ -- )
+ his-ipv6-addr unknown-ipv6-addr? not if 2drop exit then
bootnet-debug if ( hostname$ )
." Using DNS AAAA to find the IPv6 address of " ( hostname$ )
2dup type cr ( hostname$ )
Modified: ofw/inetv6/dnsv6.fth
===================================================================
--- ofw/inetv6/dnsv6.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/dnsv6.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -3,38 +3,276 @@
headerless
+[ifndef] include-ipv4
+\ struct ( dns header )
+\ /w field >id \ 0 - Number to match questions with answers
+\ /w field >dns-flags \ 2 - q/a:8000 opcode:780 aa:40 tc:20 rd:10 ra:8 rc:f
+\ /w field >qdcount \ 4 - number of following questions
+\ /w field >anscount \ 6 - number of following answer RRs
+\ /w field >nscount \ 8 - number of following name server RRs
+\ /w field >arccount \ a - number of following additional RRs
+\ constant /dns-header
+
+\ DNS question format: QNAME-variable_length, QTYPE(/w), QCLASS(/w)
+\ QTYPE value for "A" (host name) is 1
+\ QTYPE value for "AAAA" (IPv6 hostname) is h# 1c
+\ QCLASS value for "IN" (Internet) is 1
+
+\ d# 1022 value fw-port# \ It's been assigned by IANA.
+h# 800a constant fw-port# \ It's unassigned as of 8/13/2007.
+
+d# 2000 constant dns-timeout
+
+2 value #retries-a
+2 value #retries-aaaa
+
+0 value qtype
+1 constant qclass
+
+\ Encode/decode various DNS data types
+: +dnsw ( w -- ) wbsplit +xb +xb ;
+: -dnsw ( -- w ) -xb -xb swap bwjoin ;
+: -dnsl ( -- l ) -dnsw -dnsw swap wljoin ;
+
+\ A label is a dot-less component of a dotted name. In DNS packets,
+\ a label is represented as a length byte followed by the bytes of the string.
+: +dns-label ( adr len -- ) dup +xb bounds ?do i c@ +xb loop ;
+
+\ A name is a full domain name consisting of one or more labels sepearate
+\ by dots. In DNS packets, the dots are not included.
+: +dns-name ( adr len -- )
+ begin dup while
+ [char] . left-parse-string
+ +dns-label
+ repeat
+ 2drop
+ 0 +xb
+;
+: -dnsbytes ( len -- adr len )
+ dup x$ over >r ( len len adr rem-len r: adr )
+ rot /string to x$ ( len r: adr )
+ r> swap ( adr len )
+;
+
+: +np ( adr len byte -- ) >r 2dup + r> swap c! 1+ ;
+
+defer -dns-tail \ Forward reference for mutual recursion
+
+0 instance value dns-header \ Pointer to beginning of DNS header
+
+\ Handle a compressed name tail, which is represented by a 2-byte
+\ offset from the beginning of the DNS header to the beginning of a
+\ previous uncompressed copy of the name tail.
+: do-ptr ( adr len ptr-offset -- adr len' )
+ h# c0 invert and -xb swap bwjoin dns-header + d# 255 ( adr len )
+ x$ 2>r to x$
+ -dns-tail
+ 2r> to x$
+;
+
+\ Handle the next name component, which is either:
+\ a) The end of the name, represented by a 0 byte
+\ b) A label, represented by a length byte (0-31) followed by the string
+\ c) A pointer, represented by pair of bytes "11oooooo oooooooo", where
+\ oooooo oooooooo is a 14-bit offset (see do-ptr)
+: -component ( adr len -- adr len' end? )
+ -xb ?dup 0= if true exit then
+ dup h# c0 and case
+ h# c0 of do-ptr true endof
+ h# 00 of -dnsbytes bounds ?do i c@ +np loop false endof
+ \ the 80 and 40 cases are reserved
+ ( default ) ." Unknown DNS label code" cr true swap
+ endcase
+;
+
+\ Copy the tail of a DNS name from the DNS packet to the buffer adr,len
+: (-dns-tail) ( adr len -- adr len' )
+ -component if exit then
+ begin [char] . +np -component until
+;
+' (-dns-tail) to -dns-tail
+
+\ Extract a domain name from the DNS packet into a local buffer
+d# 256 buffer: dns-name-buf
+: -dns-name ( -- adr len ) dns-name-buf 0 -dns-tail ;
+
+\ Add the host name to the packet and tack on the domain name
+\ if it's not already there
+: +dns-host ( adr len -- )
+ [char] . split-string ( head$ tail$ )
+ dup if \ Already fully-qualified ( head$ tail$ )
+ nip + +dns-name ( )
+ else \ No domain name ( head$ tail$ )
+ 2drop +dns-label ( )
+ domain-name +dns-name ( )
+ then ( )
+;
+
+d# 512 constant /dns-query
+d# 53 constant dns-port#
+0 instance value dns-xid
+
+\ Send a DNS question asking for the IP address for the indicated host
+: send-dns-query ( hostname$ -- )
+ /dns-query allocate-udp >r
+ r@ start-encode
+ next-xid lwsplit drop to dns-xid \ DNS transaction IDs are 16 bits
+ \ Flags=100 means standard query, recursion desired (100)
+ \ ID flags #questions #answers #namesrvrs #additional
+ dns-xid +dnsw h# 100 +dnsw 1 +dnsw 0 +dnsw 0 +dnsw 0 +dnsw
+ +dns-host
+ qtype +dnsw qclass +dnsw
+ x$ fw-port# dns-port# send-udp-packet
+ r> /dns-query free-udp
+;
+defer handle-dns-call ' noop is handle-dns-call
+
+: unexpected-xid ( -- )
+ bootnet-debug if
+ ." (Discarding DNS reply with mismatched transaction ID)" cr
+ then
+;
+
+\ Receive a DNS reply, filtering out stuff that's not for us
+: receive-dns-reply ( xid his-port# my-port# -- error? )
+ begin
+ begin
+ \ Filter out other destination ports
+ dup receive-udp-packet if ( xid his mine ) \ Timeout
+ ." Timeout waiting for DNS reply" cr
+ 3drop true exit
+ then ( xid his mine adr len actual-port# )
+ \ Filter out other source ports
+ 4 pick <> while ( xid his mine adr len )
+ 2drop ( xid his mine )
+ repeat ( xid his mine adr len )
+
+ over to dns-header ( xid his mine )
+ start-decode ( xid his mine )
+
+ \ Filter out other transaction IDs
+ 2 pick -dnsw <> if ( xid his mine )
+ unexpected-xid false ( xid his mine flag )
+ else ( xid his mine )
+ \ Filter out DNS calls
+ -dnsw h# 8000 and 0= if ( xid his mine )
+ handle-dns-call false ( xid his mine false )
+ else ( xid his mine )
+ true ( xid his mine true )
+ then ( xid his mine done? )
+ then ( xid his mine done? )
+ until ( xid his mine )
+ 3drop false ( false )
+;
+
+\ Decode/extract a DNS question section from the DNS packet
+: -dns-question ( -- name$ type class ) -dns-name -dnsw -dnsw ;
+
+\ Discard TTL
+: -data ( -- ) -dnsw -dnsbytes 2drop ;
+: parse-answer ( -- false | 'ip true )
+ -dns-name 2drop
+
+ -dnsw -dnsw wljoin ( class.type )
+ -dnsl drop ( class.type ) \ Discard TTL
+ qtype qclass wljoin = if ( )
+ -dnsw drop \ Discard RDLENGTH (it better be 4!)
+ x$ drop true ( 'ip true )
+ else ( )
+ -dnsw ( datalen )
+ -dnsbytes 2drop false ( false )
+ then
+;
+
+\ Decode the reply to a DNS "get IP address for host name" query.
+: get-host-addr ( -- 'ip )
+ \ Decoder is pointing at the QDCOUNT field
+
+ -dnsw -dnsw ( #questions #answers )
+ -dnsw drop -dnsw drop \ Discard NSCOUNT and ARCOUNT
+
+ \ Discard echoed questions
+ swap 0 ?do -dns-question 2drop 2drop loop ( #answers )
+
+ 0 ?do parse-answer if unloop exit then loop ( )
+ 4 throw
+;
+
+headers
+\ Return in the buffer 'ip the IP address address for named host.
+\ The host name can be either a simple name (e.g. "pi") or a
+\ fully-qualified domain name (e.g. "pi.firmworks.com").
+: try-resolve ( hostname$ -- 'ip )
+ dns-timeout set-timeout ( hostname$ )
+ send-dns-query ( )
+ dns-xid dns-port# fw-port# receive-dns-reply ( error? )
+ 1 and throw ( )
+ get-host-addr ( answer-ip )
+;
+[then]
+
+headerless
+
/ipv6 buffer: ipv6-buf
[ifndef] include-ipv4
: $>ip ( hostname$ -- 'ip ) .ipv4-not-supported ;
: resolvev4 ( hostname$ -- ) .ipv4-not-supported ;
+: (set-dest-ip) ( buf -- ) .ipv4-not-supported ;
: set-dest-ip ( buf -- ) .ipv4-not-supported ;
: ?bad-ip ( flag -- ) abort" Bad host name or address" ;
[then]
: resolvev6 ( hostname$ -- )
+ bootnet-debug if ( hostname$ )
+ ." Using IPv6 DNS to find the IPv6 address of " ( hostname$ )
+ 2dup type cr ( hostname$ )
+ then
+
true to use-ipv6?
- unknown-ipv6-addr his-ipv6-addr copy-ipv6-addr
- abort" IPv6 DNS not supported yet"
+ h# 1c to qtype
+ name-server-ipv6 set-dest-ipv6
+ 2dup ['] try-resolve catch ?dup if ( hostname$ x x err )
+ nip nip ( hostname$ err )
+ 1 <> if ( hostname$ )
+ bootnet-debug if
+ indent ." Unknown IPv6 hostname: " 2dup type cr
+ then
+ true abort" Unknown IPv6 hostname"
+ then
+ else
+ bootnet-debug if
+ indent ." Got IPv6 address " dup .ipv6 cr
+ then
+ set-dest-ipv6
+ 2drop exit
+ then
+
+ bootnet-debug if indent ." No answer to IPv6 DNS request" cr then
+ true abort" IPv6 DNS: No answer"
;
headers
-\ XXX Try (resolve) or (resolve6) first. If fail, try the other one.
-: (resolve) ( hostname$ -- )
+: resolve ( hostname$ -- )
2dup ['] resolvev6 catch if
2drop
+ unknown-ipv6-addr his-ipv6-addr copy-ipv6-addr
+ then
+ use-ipv6-ok? not if \ IPv6 DNS fail, try DNS
false to use-ipv6?
resolvev4
else
2drop
then
- use-ipv6-ok? dup to use-ipv6? if \ Make sure all the addresses are set properly
+ use-ipv6-ok? dup to use-ipv6? if \ Make sure all the addresses are set properly
his-ipv6-addr (set-dest-ipv6)
bootnet-debug if ." Use IPv6 protocol" cr then
else
+[ifdef] include-ipv4
his-ip-addr (set-dest-ip)
bootnet-debug if ." Use IP protocol" cr then
+[then]
then
;
@@ -42,7 +280,7 @@
dup 0= ?bad-ip
2dup ['] $>ip catch if 2drop else false to use-ipv6? set-dest-ip 2drop exit then
2dup ipv6-buf ['] $ipv6# catch if
- 3drop (resolve)
+ 3drop resolve
else
2drop
true to use-ipv6? ipv6-buf set-dest-ipv6
Modified: ofw/inetv6/ethernet.fth
===================================================================
--- ofw/inetv6/ethernet.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/ethernet.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -53,6 +53,12 @@
create broadcast-en-addr h# ff c, h# ff c, h# ff c, h# ff c, h# ff c, h# ff c,
: unknown-en-addr? ( 'en -- flag ) dup l@ 0= swap w@ 0= and ;
+: known-en-addr? ( 'en -- flag )
+ >r
+ r@ unknown-en-addr?
+ r@ broadcast-en-addr en= or
+ r@ c@ h# 33 = r> 1+ c@ h# 33 = and or not
+;
decimal
@@ -119,7 +125,9 @@
th 86dd constant IPV6_TYPE
hex
-: ip-type? ( type -- ip-type? ) dup IP_TYPE = swap IPV6_TYPE = or ;
+: ip-type? ( type -- ip-type? )
+ use-ipv6? if IPV6_TYPE else IP_TYPE then =
+;
: eth-type=? ( type -- flag )
eth-type ip-type? if ip-type? else eth-type = then
Modified: ofw/inetv6/icmpinfo.fth
===================================================================
--- ofw/inetv6/icmpinfo.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/icmpinfo.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -9,7 +9,10 @@
\ ****************** Neighbor Discovery and Autoconfiguration ******************
: handle-router-sol ( adr len -- ) 2drop ; \ Router solicitation
-: handle-router-ad ( adr len -- ) 2drop ; \ Router advertisement
+: handle-router-ad ( adr len -- ) \ Router advertisement
+ bootnet-debug if ." Router advertisement" cr then
+ 2drop
+;
: send-router-sol ( -- )
8 allocate-icmpv6 set-struct \ Option: source link-layer addr
@@ -53,7 +56,7 @@
( 'ip ) icmp-data copy-ipv6-addr
h# 201 icmp-data /ipv6 + xw! \ Option type 2 (target mac addr)
\ Length (in 8 octels)
- my-en-addr icmp-data /ipv6 + 2 + copy-ipv6-addr
+ my-en-addr icmp-data /ipv6 + 2 + copy-en-addr
hop-limit >r h# ff to hop-limit \ Save and change hop-limit
the-struct d# 24 2dup send-icmpv6-packet
@@ -61,6 +64,7 @@
r> to hop-limit \ Restore hop-limit
;
+/e buffer: his-en-addr-save
/ipv6 buffer: his-ipv6-addr-save
/ipv6 buffer: my-ipv6-addr-save
: handle-neigh-sol ( adr len -- ) \ Neighbor solicitation
@@ -74,21 +78,29 @@
2drop exit
then
- \ XXX Send Neighbor Advertisement
+ \ Send Neighbor Advertisement
drop ( adr )
- his-ipv6-addr his-ipv6-addr-save copy-ipv6-addr \ Save his-ipv6-addr
+ his-ipv6-addr his-ipv6-addr-save copy-ipv6-addr \ Save his-*-addr
my-ipv6-addr my-ipv6-addr-save copy-ipv6-addr
+ his-en-addr his-en-addr-save copy-en-addr
ipv6-dest-addr c@ dup h# ff = swap h# fe = or if
my-ipv6-addr-link-local else my-ipv6-addr-global
then
my-ipv6-addr copy-ipv6-addr
- ipv6-source-addr his-ipv6-addr copy-ipv6-addr \ Use the solicitor's IPv6 addr as dst
+ ipv6-source-addr his-ipv6-addr copy-ipv6-addr \ Use solicitor's IPv6 addr as dst
+ dup /icmp-header + /ipv6 + 2 + his-en-addr copy-en-addr \ Use solicitor's mac addr as dst
/icmp-header + true send-neigh-ad
- his-ipv6-addr-save his-ipv6-addr copy-ipv6-addr \ Restore his-ipv6-addr
+ his-ipv6-addr-save his-ipv6-addr copy-ipv6-addr \ Restore his-*-addr
my-ipv6-addr-save my-ipv6-addr copy-ipv6-addr
+ his-en-addr-save his-en-addr copy-en-addr
;
-: handle-neigh-ad ( adr len -- ) 2drop ; \ Neighbor advertisement
+: handle-neigh-ad ( adr len -- ) \ Neighbor advertisement
+ bootnet-debug if
+ ." Neighbor advertisement from MAC: " over d# 26 + .enaddr cr
+ then
+ 2drop
+;
: handle-inv-neigh-sol ( adr len -- ) 2drop ; \ Inverse neighbor discovery solicitation
: handle-inv-neigh-ad ( adr len -- ) 2drop ; \ Inverse neighbor discovery advertisement
Modified: ofw/inetv6/loadpkg.fth
===================================================================
--- ofw/inetv6/loadpkg.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/loadpkg.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -43,7 +43,7 @@
[then]
[ifdef] include-ipv6
\ fload ${BP}/ofw/inetv6/bootpv6.fth \ Bootp Protocol
-\ fload ${BP}/ofw/inetv6/dhcpv6.fth \ Dynamic Host Config. Protocol
+fload ${BP}/ofw/inetv6/dhcpv6.fth \ Dynamic Host Config. Protocol
fload ${BP}/ofw/inetv6/tftp.fth \ Trivial File Transfer Protocol
fload ${BP}/ofw/inetv6/netloadv6.fth \ Network boot loading package
fload ${BP}/ofw/inetv6/neighdis.fth \ Neighbor discovery
Modified: ofw/inetv6/neighdis.fth
===================================================================
--- ofw/inetv6/neighdis.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/neighdis.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -57,7 +57,7 @@
else ( ip-type 'ip-adr )
his-ip-addr copy-ip-addr ( ip-type )
his-ip-addr my-ip-addr ip-prefix=? if
- his-en-addr broadcast-en-addr en= if do-arp then ( ip-type )
+ his-en-addr known-en-addr? not if unlock-link-addr do-arp then ( ip-type )
else
router-en-addr his-en-addr copy-en-addr
then
@@ -130,14 +130,14 @@
repeat 2drop
;
: process-rd? ( adr len -- router-ad? )
- over c@ d# 134 <> if drop false exit then \ Router advertisement?
+ over c@ d# 134 <> if 2drop false exit then \ Router advertisement?
over 4 + c@ to router-hop-limit
- over 5 + c@ to router-flags \ XXX What to do with stateful config?
+ over 5 + c@ to router-flags \ XXX What to do with stateful config?
over 6 + be-w@ to router-lifetime
over 8 + be-l@ to router-reachable-time
over d# 12 + be-l@ to router-retrans-time
- d# 16 /string ( opt-adr,len )
- process-rd-options ( )
+ d# 16 /string ( opt-adr,len )
+ process-rd-options ( )
true
;
: auto-cfg-global? ( -- flag )
@@ -222,10 +222,10 @@
[then]
true to use-ipv6?
set-mc-hash if close false exit then
+ ['] (resolve-en-addrv6) to resolve-en-addr
configure-ipv6
s-all-ipv6
setup-ip-attr
- ['] (resolve-en-addrv6) to resolve-en-addr
true
;
Modified: ofw/inetv6/tcpv6.fth
===================================================================
--- ofw/inetv6/tcpv6.fth 2007-08-15 20:20:01 UTC (rev 547)
+++ ofw/inetv6/tcpv6.fth 2007-08-15 22:59:54 UTC (rev 548)
@@ -2008,7 +2008,6 @@
;
: free-buffersv6 ( -- )
- free-buffers
wbufv6-start /wbufv6 free-mem
xmit_bufv6 /xmit-max " free-ipv6" $call-parent
;
@@ -2430,9 +2429,6 @@
: open ( -- )
alloc-buffersv6
-[ifdef] open
- open
-[else]
parse-args
alloc-buffers
@@ -2451,7 +2447,6 @@
true to alive?
true
-[then]
;
[ifndef] include-ipv4
@@ -2494,10 +2489,9 @@
\ to make its way through the sequence of termination states.
: disconnectv6 ( -- )
usrclosed
- flush-writes
flush-writesv6
alive? if tcp_outputv6 then
- use-ipv6? if drainv6 else drain then
+ drainv6
alive? if tcp_close then
;
@@ -2505,16 +2499,14 @@
\ external
: set-nodelay ( -- ) nodelay set-flag ;
: abort-on-reconnect ( -- ) true to abort-on-reconnect? ;
+: disconnect ( -- ) ;
[then]
: close ( -- )
- disconnectv6
-[ifdef] close
- close
-[else]
+ use-ipv6? if disconnectv6 else disconnect then
['] delack-tick 0 alarm
['] protocol-tick 0 alarm
-[then]
+ free-buffers
free-buffersv6
;
More information about the OpenBIOS
mailing list