From a76977af62010a392c16010c367185e61e856ffe Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Wed, 30 Oct 2019 20:04:56 +0100 Subject: mv to docs --- docs/j1demo/firmware/dhcp.fs | 176 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 176 insertions(+) create mode 100644 docs/j1demo/firmware/dhcp.fs (limited to 'docs/j1demo/firmware/dhcp.fs') diff --git a/docs/j1demo/firmware/dhcp.fs b/docs/j1demo/firmware/dhcp.fs new file mode 100644 index 0000000..971e567 --- /dev/null +++ b/docs/j1demo/firmware/dhcp.fs @@ -0,0 +1,176 @@ +( DHCP: Dynamic Host Configuration Protocol JCB 13:13 08/24/10) +module[ dhcp" + +\ Since DHCP alarm is only used when there is no lease, it is +\ safe to use the ip-subnetmask for the same purpose. + +ip-subnetmask constant dhcp-alarm + +: dhcp-xid + ip-router 2@ +; + +: dhcp-xid! + ip-router 2! +; + +: dhcp-option \ ( ... n code -- ) + mac-pkt-c, + dup mac-pkt-c, + 0do + mac-pkt-c, + loop +; + +: dhcp-common \ ( messagetype -- ) + d# 67 d# 68 + d# 0 invert dup + d# 0 dup + d# 0 \ broadcast ethaddr + ( dst-port src-port dst-ip src-ip *ethaddr -- ) + udp-header + h# 0101 h# 0600 mac-pkt-2, + dhcp-xid mac-pkt-2, + d# 10 mac-pkt-,0 + net-my-mac mac-pkt-3, + d# 101 mac-pkt-,0 \ d# 5 + d# 96 zeroes + + h# 6382 h# 5363 + mac-pkt-2, + + \ DHCP option 53: DHCP Discover + \ messagetype + d# 1 d# 53 \ messagetype 1 53 + dhcp-option + + \ DHCP option 50: 192.168.1.100 requested + + \ DHCP option 55: Parameter Request List: + \ Request Subnet Mask (1), Router (3), + \ Domain Name Server (6) + d# 1 d# 3 d# 6 d# 3 d# 55 dhcp-option +; + +: dhcp-wrapup + \ Finish options + h# ff mac-pkt-c, + \ mac-wrptr @ d# 1 and + d# 1 if \ XXX + h# ff mac-pkt-c, + then + + udp-wrapup + mac-send +; + +\ memory layout is little-endian + +: macc@++ ( c-addr -- c-addr+1 c ) + dup 1+ swap macc@ ; + +: dhcp-field \ ( match -- ptr/0 ) + OFFSET_DHCP_OPTIONS d# 4 + mac-inoffset + \ match ptr + begin + macc@++ \ match ptr code + dup h# ff <> + while \ match ptr code + d# 2 pick = + if + nip \ ptr + exit + then \ match ptr + macc@++ + \ match ptr' + repeat + \ fail - return false + 2drop false +; + +: dhcp-yiaddr + d# 2 OFFSET_DHCP_YIADDR mac-inoffset mac@n +; + +: dhcp-field4 + dhcp-field d# 1 + + macc@++ swap macc@++ swap macc@++ swap macc@ + ( a b c d ) + swap d# 8 lshift or -rot + swap d# 8 lshift or + swap +; + +build-debug? [IF] +: .pad ( ip. c-addr u -- ) d# 14 typepad ip-pretty cr ; + +: dhcp-status + ip-addr 2@ s" IP" .pad + ip-router 2@ s" router" .pad + ip-subnetmask 2@ s" subnetmask" .pad +; +[ELSE] +: dhcp-status ; +[THEN] + +: lease-setalarm + d# 0 >r + begin + 2dup d# 63. d> + while + d2/ r> 1+ >r + repeat + r> + hex4 space hex8 cr +; + +: dhcp-wait-offer + h# 11 ip-isproto + OFFSET_UDP_SOURCEPORT packet@ d# 67 = and + OFFSET_UDP_DESTPORT packet@ d# 68 = and + d# 2 OFFSET_DHCP_XID mac-inoffset mac@n dhcp-xid d= and + if + snap + d# 53 dhcp-field ?dup + snap + if + d# 1 + macc@ + snap + dup d# 2 = + if + \ [char] % emit + d# 3 dhcp-common + + \ option 50: request IP + h# 3204 + dhcp-yiaddr + mac-pkt-3, + + \ Option 54: server + h# 3604 + d# 54 dhcp-field4 + mac-pkt-3, + + dhcp-wrapup + then + d# 5 = + if + \ clrwdt + \ [char] & emit + + dhcp-yiaddr ip-addr 2! + d# 1 dhcp-field4 ip-subnetmask 2! + \ For the router and DNS server, send out ARP requests right now. This + \ reduces start-up time. + d# 3 dhcp-field4 2dup ip-router 2! arp-lookup drop + d# 6 dhcp-field4 2dup ip-dns 2! arp-lookup drop + \ Option 51: lease time + s" expires in " type + d# 51 dhcp-field4 swap d. cr + then + then + snap + then +; + +: dhcp-discover d# 1 dhcp-common dhcp-wrapup ; + +]module -- cgit v1.2.3