( IP networking: headers and wrapup JCB 13:21 08/24/10) module[ ip" : ip-datalength ( -- u ) \ length of current IP packet in words ETH.IP.LENGTH packet@ d# 20 - 2/ ; : ip-isproto ( u -- f ) \ true if packet PROTO is u ETH.IP.TTLPROTO packet@ h# ff and = ; : ip-identification ip-id-counter d# 1 over +! @ ; : @ethaddr ( eth-addr -- mac01 mac23 mac45 ) ?dup if dup @ swap 2+ 2@ else ethaddr-broadcast then ; : ip-header ( dst-ip src-ip eth-addr protocol -- ) >r mac-pkt-begin @ethaddr mac-pkt-3, net-my-mac mac-pkt-3, h# 800 mac-pkt-, h# 4500 h# 0000 \ length ip-identification mac-pkt-3, h# 4000 \ do not fragment h# 4000 r> or \ TTL, protocol d# 0 \ checksum mac-pkt-3, mac-pkt-2, \ src ip mac-pkt-2, \ dst ip ; : ip-wrapup ( bytelen -- ) \ write IP length ETH.IP - ETH.IP.LENGTH packetout-off mac! \ write IP checksum ETH.IP packetout-off d# 10 mac-checksum ETH.IP.CHKSUM packetout-off mac! ; : ip-packet-srcip d# 2 ETH.IP.SRCIP mac-inoffset mac@n ; ( ICMP return and originate JCB 13:22 08/24/10) \ Someone pings us, generate a return packet : icmp-handler IP_PROTO_ICMP ip-isproto ETH.IP.ICMP.TYPECODE packet@ h# 800 = and if ip-packet-srcip 2dup arp-lookup ?dup if \ transmit ICMP reply \ dstip *ethaddr net-my-ip rot \ dstip srcip *ethaddr d# 1 ip-header \ Now the ICMP header d# 0 mac-pkt-, s" =====> ICMP seq " type ETH.IP.ICMP.SEQUENCE mac-inoffset mac@ u. cr ETH.IP.ICMP.IDENTIFIER mac-inoffset ip-datalength 2- ( offset n ) tuck mac-checksum mac-pkt-, ETH.IP.ICMP.IDENTIFIER mac-pkt-src mac-pkt-complete ip-wrapup mac-send else 2drop then then ; : ping ( ip. -- ) \ originate 2dup arp-lookup ?dup if \ transmit ICMP request \ dstip *ethaddr net-my-ip rot \ dstip srcip *ethaddr d# 1 ip-header \ Now the ICMP header h# 800 mac-pkt-, \ id is h# 550b, seq is lo word of time h# 550b time@ drop 2dup +1c h# 800 +1c d# 28 begin swap d# 0 +1c swap 1- dup 0= until drop invert mac-pkt-, \ checksum mac-pkt-2, d# 28 mac-pkt-,0 mac-pkt-complete ip-wrapup mac-send else 2drop then ; ]module