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 ;