dhcp.fs 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176
  1. ( DHCP: Dynamic Host Configuration Protocol JCB 13:13 08/24/10)
  2. module[ dhcp"
  3. \ Since DHCP alarm is only used when there is no lease, it is
  4. \ safe to use the ip-subnetmask for the same purpose.
  5. ip-subnetmask constant dhcp-alarm
  6. : dhcp-xid
  7. ip-router 2@
  8. ;
  9. : dhcp-xid!
  10. ip-router 2!
  11. ;
  12. : dhcp-option \ ( ... n code -- )
  13. mac-pkt-c,
  14. dup mac-pkt-c,
  15. 0do
  16. mac-pkt-c,
  17. loop
  18. ;
  19. : dhcp-common \ ( messagetype -- )
  20. d# 67 d# 68
  21. d# 0 invert dup
  22. d# 0 dup
  23. d# 0 \ broadcast ethaddr
  24. ( dst-port src-port dst-ip src-ip *ethaddr -- )
  25. udp-header
  26. h# 0101 h# 0600 mac-pkt-2,
  27. dhcp-xid mac-pkt-2,
  28. d# 10 mac-pkt-,0
  29. net-my-mac mac-pkt-3,
  30. d# 101 mac-pkt-,0 \ d# 5 + d# 96 zeroes
  31. h# 6382 h# 5363
  32. mac-pkt-2,
  33. \ DHCP option 53: DHCP Discover
  34. \ messagetype
  35. d# 1 d# 53 \ messagetype 1 53
  36. dhcp-option
  37. \ DHCP option 50: 192.168.1.100 requested
  38. \ DHCP option 55: Parameter Request List:
  39. \ Request Subnet Mask (1), Router (3),
  40. \ Domain Name Server (6)
  41. d# 1 d# 3 d# 6 d# 3 d# 55 dhcp-option
  42. ;
  43. : dhcp-wrapup
  44. \ Finish options
  45. h# ff mac-pkt-c,
  46. \ mac-wrptr @ d# 1 and
  47. d# 1 if \ XXX
  48. h# ff mac-pkt-c,
  49. then
  50. udp-wrapup
  51. mac-send
  52. ;
  53. \ memory layout is little-endian
  54. : macc@++ ( c-addr -- c-addr+1 c )
  55. dup 1+ swap macc@ ;
  56. : dhcp-field \ ( match -- ptr/0 )
  57. OFFSET_DHCP_OPTIONS d# 4 + mac-inoffset
  58. \ match ptr
  59. begin
  60. macc@++ \ match ptr code
  61. dup h# ff <>
  62. while \ match ptr code
  63. d# 2 pick =
  64. if
  65. nip \ ptr
  66. exit
  67. then \ match ptr
  68. macc@++ + \ match ptr'
  69. repeat
  70. \ fail - return false
  71. 2drop false
  72. ;
  73. : dhcp-yiaddr
  74. d# 2 OFFSET_DHCP_YIADDR mac-inoffset mac@n
  75. ;
  76. : dhcp-field4
  77. dhcp-field d# 1 +
  78. macc@++ swap macc@++ swap macc@++ swap macc@
  79. ( a b c d )
  80. swap d# 8 lshift or -rot
  81. swap d# 8 lshift or
  82. swap
  83. ;
  84. build-debug? [IF]
  85. : .pad ( ip. c-addr u -- ) d# 14 typepad ip-pretty cr ;
  86. : dhcp-status
  87. ip-addr 2@ s" IP" .pad
  88. ip-router 2@ s" router" .pad
  89. ip-subnetmask 2@ s" subnetmask" .pad
  90. ;
  91. [ELSE]
  92. : dhcp-status ;
  93. [THEN]
  94. : lease-setalarm
  95. d# 0 >r
  96. begin
  97. 2dup d# 63. d>
  98. while
  99. d2/ r> 1+ >r
  100. repeat
  101. r>
  102. hex4 space hex8 cr
  103. ;
  104. : dhcp-wait-offer
  105. h# 11 ip-isproto
  106. OFFSET_UDP_SOURCEPORT packet@ d# 67 = and
  107. OFFSET_UDP_DESTPORT packet@ d# 68 = and
  108. d# 2 OFFSET_DHCP_XID mac-inoffset mac@n dhcp-xid d= and
  109. if
  110. snap
  111. d# 53 dhcp-field ?dup
  112. snap
  113. if
  114. d# 1 + macc@
  115. snap
  116. dup d# 2 =
  117. if
  118. \ [char] % emit
  119. d# 3 dhcp-common
  120. \ option 50: request IP
  121. h# 3204
  122. dhcp-yiaddr
  123. mac-pkt-3,
  124. \ Option 54: server
  125. h# 3604
  126. d# 54 dhcp-field4
  127. mac-pkt-3,
  128. dhcp-wrapup
  129. then
  130. d# 5 =
  131. if
  132. \ clrwdt
  133. \ [char] & emit
  134. dhcp-yiaddr ip-addr 2!
  135. d# 1 dhcp-field4 ip-subnetmask 2!
  136. \ For the router and DNS server, send out ARP requests right now. This
  137. \ reduces start-up time.
  138. d# 3 dhcp-field4 2dup ip-router 2! arp-lookup drop
  139. d# 6 dhcp-field4 2dup ip-dns 2! arp-lookup drop
  140. \ Option 51: lease time
  141. s" expires in " type
  142. d# 51 dhcp-field4 swap d. cr
  143. then
  144. then
  145. snap
  146. then
  147. ;
  148. : dhcp-discover d# 1 dhcp-common dhcp-wrapup ;
  149. ]module