ip.fs 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. ( IP networking: headers and wrapup JCB 13:21 08/24/10)
  2. module[ ip"
  3. : ip-datalength ( -- u ) \ length of current IP packet in words
  4. ETH.IP.LENGTH packet@
  5. d# 20 - 2/
  6. ;
  7. : ip-isproto ( u -- f ) \ true if packet PROTO is u
  8. ETH.IP.TTLPROTO packet@ h# ff and =
  9. ;
  10. : ip-identification
  11. ip-id-counter d# 1 over +! @
  12. ;
  13. : @ethaddr ( eth-addr -- mac01 mac23 mac45 )
  14. ?dup
  15. if
  16. dup @ swap 2+ 2@
  17. else
  18. ethaddr-broadcast
  19. then
  20. ;
  21. : ip-header ( dst-ip src-ip eth-addr protocol -- )
  22. >r
  23. mac-pkt-begin
  24. @ethaddr mac-pkt-3,
  25. net-my-mac mac-pkt-3,
  26. h# 800 mac-pkt-,
  27. h# 4500
  28. h# 0000 \ length
  29. ip-identification
  30. mac-pkt-3,
  31. h# 4000 \ do not fragment
  32. h# 4000 r> or \ TTL, protocol
  33. d# 0 \ checksum
  34. mac-pkt-3,
  35. mac-pkt-2, \ src ip
  36. mac-pkt-2, \ dst ip
  37. ;
  38. : ip-wrapup ( bytelen -- )
  39. \ write IP length
  40. ETH.IP -
  41. ETH.IP.LENGTH packetout-off mac!
  42. \ write IP checksum
  43. ETH.IP packetout-off d# 10 mac-checksum
  44. ETH.IP.CHKSUM packetout-off mac!
  45. ;
  46. : ip-packet-srcip
  47. d# 2 ETH.IP.SRCIP mac-inoffset mac@n
  48. ;
  49. ( ICMP return and originate JCB 13:22 08/24/10)
  50. \ Someone pings us, generate a return packet
  51. : icmp-handler
  52. IP_PROTO_ICMP ip-isproto
  53. ETH.IP.ICMP.TYPECODE packet@ h# 800 =
  54. and if
  55. ip-packet-srcip
  56. 2dup arp-lookup
  57. ?dup if
  58. \ transmit ICMP reply
  59. \ dstip *ethaddr
  60. net-my-ip rot \ dstip srcip *ethaddr
  61. d# 1 ip-header
  62. \ Now the ICMP header
  63. d# 0 mac-pkt-,
  64. s" =====> ICMP seq " type
  65. ETH.IP.ICMP.SEQUENCE mac-inoffset mac@ u. cr
  66. ETH.IP.ICMP.IDENTIFIER mac-inoffset
  67. ip-datalength 2- ( offset n )
  68. tuck
  69. mac-checksum mac-pkt-,
  70. ETH.IP.ICMP.IDENTIFIER mac-pkt-src
  71. mac-pkt-complete
  72. ip-wrapup
  73. mac-send
  74. else
  75. 2drop
  76. then
  77. then
  78. ;
  79. : ping ( ip. -- ) \ originate
  80. 2dup arp-lookup
  81. ?dup if
  82. \ transmit ICMP request
  83. \ dstip *ethaddr
  84. net-my-ip rot \ dstip srcip *ethaddr
  85. d# 1 ip-header
  86. \ Now the ICMP header
  87. h# 800 mac-pkt-,
  88. \ id is h# 550b, seq is lo word of time
  89. h# 550b time@ drop
  90. 2dup +1c h# 800 +1c
  91. d# 28 begin swap d# 0 +1c swap 1- dup 0= until drop
  92. invert mac-pkt-, \ checksum
  93. mac-pkt-2,
  94. d# 28 mac-pkt-,0
  95. mac-pkt-complete
  96. ip-wrapup
  97. mac-send
  98. else
  99. 2drop
  100. then
  101. ;
  102. ]module