[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