Translate Ethernet and ARP to incremental/actor style
This commit is contained in:
Tony Garnock-Jones
parent
4357424e78
commit
fb5b6e80b8
|
|
@ -1,22 +1,20 @@
|
|||
#lang racket/base
|
||||
#lang syndicate/actor
|
||||
;; ARP protocol, http://tools.ietf.org/html/rfc826
|
||||
;; Only does ARP-over-ethernet.
|
||||
|
||||
(provide (struct-out arp-query)
|
||||
(struct-out arp-assertion)
|
||||
(struct-out arp-interface)
|
||||
spawn-arp-driver)
|
||||
spawn-arp-driver)
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require syndicate/monolithic)
|
||||
(require syndicate/drivers/timer)
|
||||
(require syndicate/demand-matcher)
|
||||
(require/activate syndicate/drivers/timer)
|
||||
(require bitsyntax)
|
||||
|
||||
(require "dump-bytes.rkt")
|
||||
(require "configuration.rkt")
|
||||
(require "ethernet.rkt")
|
||||
(require/activate "ethernet.rkt")
|
||||
|
||||
(struct arp-query (protocol protocol-address interface link-address) #:prefab)
|
||||
(struct arp-assertion (protocol protocol-address interface-name) #:prefab)
|
||||
|
|
@ -31,51 +29,31 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (spawn-arp-driver)
|
||||
(spawn-demand-matcher (arp-interface (?!))
|
||||
(arp-interface-up (?!))
|
||||
spawn-arp-interface))
|
||||
(actor #:name 'arp-driver
|
||||
(react (during/actor (arp-interface $interface-name)
|
||||
#:name (list 'arp-interface interface-name)
|
||||
(assert (arp-interface-up interface-name))
|
||||
(on-start (define hwaddr (lookup-ethernet-hwaddr interface-name))
|
||||
(when (not hwaddr)
|
||||
(error 'arp "Failed to look up ARP interface ~v"
|
||||
interface-name))
|
||||
(react (run-arp-interface interface-name hwaddr)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(struct cache-key (protocol address) #:transparent)
|
||||
(struct cache-value (expiry interface address) #:transparent)
|
||||
|
||||
(struct state (cache queries assertions) #:transparent)
|
||||
(define (expire-cache c)
|
||||
(define now (current-inexact-milliseconds))
|
||||
(define (not-expired? v) (< now (cache-value-expiry v)))
|
||||
(for/hash [((k v) (in-hash c)) #:when (not-expired? v)]
|
||||
(values k v)))
|
||||
|
||||
(define (spawn-arp-interface interface-name)
|
||||
(log-info "spawn-arp-interface ~v" interface-name)
|
||||
(lookup-ethernet-hwaddr (assertion (arp-interface-up interface-name))
|
||||
interface-name
|
||||
(lambda (hwaddr) (spawn-arp-interface* interface-name hwaddr))))
|
||||
|
||||
(define (spawn-arp-interface* interface-name hwaddr)
|
||||
(log-info "spawn-arp-interface* ~v ~v" interface-name hwaddr)
|
||||
(define (run-arp-interface interface-name hwaddr)
|
||||
(log-info "ARP interface ~v ~v" interface-name hwaddr)
|
||||
(define interface (ethernet-interface interface-name hwaddr))
|
||||
|
||||
(define (expire-cache cache)
|
||||
(define now (current-inexact-milliseconds))
|
||||
(define (not-expired? v) (< now (cache-value-expiry v)))
|
||||
(for/hash [((k v) (in-hash cache)) #:when (not-expired? v)]
|
||||
(values k v)))
|
||||
|
||||
(define timer-key (list 'arp interface-name))
|
||||
|
||||
(define (set-wakeup-alarm)
|
||||
(message (set-timer timer-key wakeup-interval 'relative)))
|
||||
|
||||
(define (compute-gestalt cache)
|
||||
(scn/union (subscription (timer-expired timer-key ?))
|
||||
(subscription interface)
|
||||
(subscription (ethernet-packet-pattern interface-name #t ARP-ethertype))
|
||||
(assertion (arp-interface-up interface-name))
|
||||
(subscription (arp-assertion ? ? interface-name))
|
||||
(subscription (observe (arp-query ? ? interface ?)))
|
||||
(for/fold [(g trie-empty)] [((k v) (in-hash cache))]
|
||||
(assertion-set-union g (assertion (arp-query (cache-key-protocol k)
|
||||
(cache-key-address k)
|
||||
(cache-value-interface v)
|
||||
(cache-value-address v)))))))
|
||||
|
||||
(define (build-packet dest-mac ptype oper sender-ha sender-pa target-ha target-pa)
|
||||
(define hlen (bytes-length target-ha))
|
||||
(define plen (bytes-length target-pa))
|
||||
|
|
@ -96,140 +74,123 @@
|
|||
ARP-ethertype
|
||||
packet))
|
||||
|
||||
(define (analyze-incoming-packet source destination body s)
|
||||
(bit-string-case body
|
||||
([ (= 1 :: integer bytes 2)
|
||||
(ptype :: integer bytes 2)
|
||||
hlen
|
||||
plen
|
||||
(oper :: integer bytes 2)
|
||||
(sender-hardware-address0 :: binary bytes hlen)
|
||||
(sender-protocol-address0 :: binary bytes plen)
|
||||
(target-hardware-address0 :: binary bytes hlen)
|
||||
(target-protocol-address0 :: binary bytes plen)
|
||||
(:: binary) ;; The extra zeros exist because ethernet packets
|
||||
;; have a minimum size. This is, in part, why
|
||||
;; IPv4 headers have a total-length field, so
|
||||
;; that the zero padding can be removed.
|
||||
]
|
||||
(let ()
|
||||
(define sender-protocol-address (bit-string->bytes sender-protocol-address0))
|
||||
(define sender-hardware-address (bit-string->bytes sender-hardware-address0))
|
||||
(define target-protocol-address (bit-string->bytes target-protocol-address0))
|
||||
(define learned-key (cache-key ptype sender-protocol-address))
|
||||
(when (and (set-member? (state-queries s) learned-key) ;; it is relevant to our interests
|
||||
(not (equal? sender-hardware-address
|
||||
(cache-value-address (hash-ref (state-cache s)
|
||||
learned-key
|
||||
(lambda ()
|
||||
(cache-value #f #f #f)))))))
|
||||
(log-info "~a ARP Adding ~a = ~a to cache"
|
||||
interface-name
|
||||
(pretty-bytes sender-protocol-address)
|
||||
(pretty-bytes sender-hardware-address)))
|
||||
(define cache (hash-set (expire-cache (state-cache s))
|
||||
learned-key
|
||||
(cache-value (+ (current-inexact-milliseconds)
|
||||
cache-entry-lifetime-msec)
|
||||
interface
|
||||
sender-hardware-address)))
|
||||
(transition (struct-copy state s [cache cache])
|
||||
(list
|
||||
(case oper
|
||||
[(1) ;; request
|
||||
(if (set-member? (state-assertions s)
|
||||
(cache-key ptype target-protocol-address))
|
||||
(begin
|
||||
(log-info "~a ARP answering request for ~a/~a"
|
||||
interface-name
|
||||
ptype
|
||||
(pretty-bytes target-protocol-address))
|
||||
(message (build-packet sender-hardware-address
|
||||
ptype
|
||||
2 ;; reply
|
||||
hwaddr
|
||||
target-protocol-address
|
||||
sender-hardware-address
|
||||
sender-protocol-address)))
|
||||
'())]
|
||||
[(2) '()] ;; reply
|
||||
[else '()])
|
||||
(compute-gestalt cache)))))
|
||||
(else #f)))
|
||||
(define (some-asserted-pa ptype)
|
||||
(match (filter (lambda (k) (equal? (cache-key-protocol k) ptype)) (set->list (assertions)))
|
||||
['() #f]
|
||||
[(list* k _) (cache-key-address k)]))
|
||||
|
||||
(define queries-projection (observe (arp-query (?!) (?!) ? ?)))
|
||||
(define (gestalt->queries g)
|
||||
(for/set [(e (in-set (trie-project/set #:take 2 g queries-projection)))]
|
||||
(match-define (list ptype pa) e)
|
||||
(cache-key ptype pa)))
|
||||
(define (send-questions!)
|
||||
(for [(q (set-subtract (queries) (list->set (hash-keys (cache)))))]
|
||||
(define pa (some-asserted-pa (cache-key-protocol q)))
|
||||
(log-info "~a ARP Asking for ~a from ~a"
|
||||
interface-name
|
||||
(pretty-bytes (cache-key-address q))
|
||||
(and pa (pretty-bytes pa)))
|
||||
(when pa
|
||||
(send! (build-packet broadcast-ethernet-address
|
||||
(cache-key-protocol q)
|
||||
1 ;; request
|
||||
hwaddr
|
||||
pa
|
||||
zero-ethernet-address
|
||||
(cache-key-address q))))))
|
||||
|
||||
(define assertions-projection (arp-assertion (?!) (?!) ?))
|
||||
(define (gestalt->assertions g)
|
||||
(for/set [(e (in-set (trie-project/set #:take 2 g assertions-projection)))]
|
||||
(match-define (list ptype pa) e)
|
||||
(cache-key ptype pa)))
|
||||
(field [cache (hash)]
|
||||
[queries (set)]
|
||||
[assertions (set)])
|
||||
|
||||
(define (analyze-gestalt g s)
|
||||
(define new-assertions (gestalt->assertions g))
|
||||
(define added-assertions (set-subtract new-assertions (state-assertions s)))
|
||||
(define new-s (struct-copy state s [queries (gestalt->queries g)] [assertions new-assertions]))
|
||||
(if (trie-empty? (project-assertions g (arp-interface interface-name)))
|
||||
(quit)
|
||||
(transition new-s
|
||||
(list
|
||||
(for/list [(a (in-set added-assertions))]
|
||||
(log-info "~a ARP Announcing ~a as ~a"
|
||||
interface-name
|
||||
(pretty-bytes (cache-key-address a))
|
||||
(pretty-bytes hwaddr))
|
||||
(message (build-packet broadcast-ethernet-address
|
||||
(cache-key-protocol a)
|
||||
2 ;; reply -- gratuitous announcement
|
||||
hwaddr
|
||||
(cache-key-address a)
|
||||
hwaddr
|
||||
(cache-key-address a))))))))
|
||||
(on-start (define timer-key (list 'arp interface-name))
|
||||
(define (arm-timer!) (send! (set-timer timer-key wakeup-interval 'relative)))
|
||||
(arm-timer!)
|
||||
(react (on (message (timer-expired timer-key _))
|
||||
(cache (expire-cache (cache)))
|
||||
(send-questions!)
|
||||
(arm-timer!))))
|
||||
|
||||
(define (send-questions s)
|
||||
(define unanswered-queries
|
||||
(set-subtract (state-queries s) (list->set (hash-keys (state-cache s)))))
|
||||
(define (some-asserted-pa ptype)
|
||||
(match (filter (lambda (k) (equal? (cache-key-protocol k) ptype))
|
||||
(set->list (state-assertions s)))
|
||||
['() #f]
|
||||
[(list* k _) (cache-key-address k)]))
|
||||
(transition s
|
||||
(for/list [(q (in-set unanswered-queries))]
|
||||
(define pa (some-asserted-pa (cache-key-protocol q)))
|
||||
(log-info "~a ARP Asking for ~a from ~a"
|
||||
interface-name
|
||||
(pretty-bytes (cache-key-address q))
|
||||
(and pa (pretty-bytes pa)))
|
||||
(when pa
|
||||
(message (build-packet broadcast-ethernet-address
|
||||
(cache-key-protocol q)
|
||||
1 ;; request
|
||||
hwaddr
|
||||
pa
|
||||
zero-ethernet-address
|
||||
(cache-key-address q)))))))
|
||||
(on (message ($ p (ethernet-packet-pattern interface-name #t ARP-ethertype)))
|
||||
(match-define (ethernet-packet _ _ source destination _ body) p)
|
||||
(bit-string-case body
|
||||
([ (= 1 :: integer bytes 2)
|
||||
(ptype :: integer bytes 2)
|
||||
hlen
|
||||
plen
|
||||
(oper :: integer bytes 2)
|
||||
(sender-hardware-address0 :: binary bytes hlen)
|
||||
(sender-protocol-address0 :: binary bytes plen)
|
||||
(target-hardware-address0 :: binary bytes hlen)
|
||||
(target-protocol-address0 :: binary bytes plen)
|
||||
(:: binary) ;; The extra zeros exist because ethernet packets
|
||||
;; have a minimum size. This is, in part, why IPv4
|
||||
;; headers have a total-length field, so that the
|
||||
;; zero padding can be removed.
|
||||
]
|
||||
(let ()
|
||||
(define sender-protocol-address (bit-string->bytes sender-protocol-address0))
|
||||
(define sender-hardware-address (bit-string->bytes sender-hardware-address0))
|
||||
(define target-protocol-address (bit-string->bytes target-protocol-address0))
|
||||
(define learned-key (cache-key ptype sender-protocol-address))
|
||||
|
||||
(list (set-wakeup-alarm)
|
||||
(spawn (lambda (e s)
|
||||
;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
|
||||
(match e
|
||||
[(scn g)
|
||||
(sequence-transitions (analyze-gestalt g s)
|
||||
send-questions)]
|
||||
[(message (ethernet-packet _ _ source destination _ body))
|
||||
(analyze-incoming-packet source destination body s)]
|
||||
[(message (timer-expired _ _))
|
||||
(define new-s (struct-copy state s
|
||||
[cache (expire-cache (state-cache s))]))
|
||||
(sequence-transitions (transition new-s
|
||||
(list (set-wakeup-alarm)
|
||||
(compute-gestalt (state-cache new-s))))
|
||||
send-questions)]
|
||||
[_ #f]))
|
||||
(state (hash) (set) (set))
|
||||
(compute-gestalt (hash)))))
|
||||
(when (and (set-member? (queries) learned-key) ;; it is relevant to our interests
|
||||
(not (equal? sender-hardware-address
|
||||
(cache-value-address (hash-ref (cache)
|
||||
learned-key
|
||||
(lambda ()
|
||||
(cache-value #f #f #f)))))))
|
||||
(log-info "~a ARP Adding ~a = ~a to cache"
|
||||
interface-name
|
||||
(pretty-bytes sender-protocol-address)
|
||||
(pretty-bytes sender-hardware-address)))
|
||||
|
||||
(cache (hash-set (expire-cache (cache))
|
||||
learned-key
|
||||
(cache-value (+ (current-inexact-milliseconds)
|
||||
cache-entry-lifetime-msec)
|
||||
interface
|
||||
sender-hardware-address)))
|
||||
(case oper
|
||||
[(1) ;; request
|
||||
(when (set-member? (assertions) (cache-key ptype target-protocol-address))
|
||||
(log-info "~a ARP answering request for ~a/~a"
|
||||
interface-name
|
||||
ptype
|
||||
(pretty-bytes target-protocol-address))
|
||||
(send! (build-packet sender-hardware-address
|
||||
ptype
|
||||
2 ;; reply
|
||||
hwaddr
|
||||
target-protocol-address
|
||||
sender-hardware-address
|
||||
sender-protocol-address)))]
|
||||
[(2) (void)] ;; reply
|
||||
[else (void)])))
|
||||
(else #f)))
|
||||
|
||||
(during (arp-assertion $protocol $protocol-address interface-name)
|
||||
(define a (cache-key protocol protocol-address))
|
||||
(on-start (assertions (set-add (assertions) a))
|
||||
(log-info "~a ARP Announcing ~a as ~a"
|
||||
interface-name
|
||||
(pretty-bytes (cache-key-address a))
|
||||
(pretty-bytes hwaddr))
|
||||
(send! (build-packet broadcast-ethernet-address
|
||||
(cache-key-protocol a)
|
||||
2 ;; reply -- gratuitous announcement
|
||||
hwaddr
|
||||
(cache-key-address a)
|
||||
hwaddr
|
||||
(cache-key-address a))))
|
||||
(on-stop (assertions (set-remove (assertions) a))))
|
||||
|
||||
(during (observe (arp-query $protocol $protocol-address interface _))
|
||||
(define key (cache-key protocol protocol-address))
|
||||
(on-start (queries (set-add (queries) key))
|
||||
(send-questions!))
|
||||
(on-stop (queries (set-remove (queries) key)))
|
||||
(assert #:when (hash-has-key? (cache) key)
|
||||
(match (hash-ref (cache) key)
|
||||
[(cache-value _ ifname addr)
|
||||
(arp-query protocol protocol-address ifname addr)]))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(spawn-arp-driver)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket/base
|
||||
#lang syndicate/actor
|
||||
;; Ethernet driver
|
||||
|
||||
(provide (struct-out ethernet-packet)
|
||||
|
|
@ -9,14 +9,11 @@
|
|||
ethernet-packet-pattern
|
||||
lookup-ethernet-hwaddr)
|
||||
|
||||
(require/activate syndicate/drivers/timer)
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require racket/async-channel)
|
||||
|
||||
(require syndicate/monolithic)
|
||||
(require syndicate/demand-matcher)
|
||||
(require "on-claim.rkt")
|
||||
|
||||
(require packet-socket)
|
||||
(require bitsyntax)
|
||||
|
||||
|
|
@ -32,52 +29,44 @@
|
|||
(log-info "Device names: ~a" interface-names)
|
||||
|
||||
(define (spawn-ethernet-driver)
|
||||
(spawn-demand-matcher (observe (ethernet-packet (ethernet-interface (?!) ?) #t ? ? ? ?))
|
||||
(ethernet-interface (?!) ?)
|
||||
spawn-interface-tap))
|
||||
(actor #:name 'ethernet-driver
|
||||
(react (during/actor
|
||||
(observe (ethernet-packet (ethernet-interface $interface-name _) #t _ _ _ _))
|
||||
#:name (list 'ethernet-interface interface-name)
|
||||
|
||||
(define (spawn-interface-tap interface-name)
|
||||
(define h (raw-interface-open interface-name))
|
||||
(define interface (ethernet-interface interface-name (raw-interface-hwaddr h)))
|
||||
(cond
|
||||
[(not h)
|
||||
(log-error "ethernet: Couldn't open interface ~v" interface-name)
|
||||
'()]
|
||||
[else
|
||||
(log-info "Opened interface ~a, yielding handle ~v" interface-name h)
|
||||
(define control-ch (make-async-channel))
|
||||
(thread (lambda () (interface-packet-read-loop interface h control-ch)))
|
||||
(spawn (lambda (e h)
|
||||
(match e
|
||||
[(scn g)
|
||||
(if (trie-empty? g)
|
||||
(begin (async-channel-put control-ch 'quit)
|
||||
(quit))
|
||||
(begin (async-channel-put control-ch 'unblock)
|
||||
#f))]
|
||||
[(message (at-meta (? ethernet-packet? p)))
|
||||
;; (log-info "Interface ~a inbound packet ~a -> ~a (type 0x~a)"
|
||||
;; (ethernet-interface-name (ethernet-packet-interface p))
|
||||
;; (pretty-bytes (ethernet-packet-source p))
|
||||
;; (pretty-bytes (ethernet-packet-destination p))
|
||||
;; (number->string (ethernet-packet-ethertype p) 16))
|
||||
;; (log-info "~a" (dump-bytes->string (ethernet-packet-body p)))
|
||||
(transition h (message p))]
|
||||
[(message (? ethernet-packet? p))
|
||||
;; (log-info "Interface ~a OUTBOUND packet ~a -> ~a (type 0x~a)"
|
||||
;; (ethernet-interface-name (ethernet-packet-interface p))
|
||||
;; (pretty-bytes (ethernet-packet-source p))
|
||||
;; (pretty-bytes (ethernet-packet-destination p))
|
||||
;; (number->string (ethernet-packet-ethertype p) 16))
|
||||
;; (log-info "~a" (dump-bytes->string (ethernet-packet-body p)))
|
||||
(raw-interface-write h (encode-ethernet-packet p))
|
||||
#f]
|
||||
[_ #f]))
|
||||
h
|
||||
(scn/union (assertion interface)
|
||||
(subscription (ethernet-packet interface #f ? ? ? ?))
|
||||
(subscription (observe (ethernet-packet interface #t ? ? ? ?)))
|
||||
(subscription (ethernet-packet interface #t ? ? ? ?) #:meta-level 1)))]))
|
||||
(define h (raw-interface-open interface-name))
|
||||
(when (not h) (error 'ethernet "Couldn't open interface ~v" interface-name))
|
||||
(log-info "Opened interface ~a, yielding handle ~v" interface-name h)
|
||||
|
||||
(define interface (ethernet-interface interface-name (raw-interface-hwaddr h)))
|
||||
(assert interface)
|
||||
|
||||
(define control-ch (make-async-channel))
|
||||
(thread (lambda () (interface-packet-read-loop interface h control-ch)))
|
||||
|
||||
(on-start (flush!) ;; ensure all subscriptions are in place
|
||||
(async-channel-put control-ch 'unblock)
|
||||
(actor #:name (list 'ethernet-interface-quit-monitor interface-name)
|
||||
(react (on (retracted interface)
|
||||
(async-channel-put control-ch 'quit)))))
|
||||
|
||||
(on (message ($ p (ethernet-packet interface #t _ _ _ _)) #:meta-level 1)
|
||||
;; (log-info "Interface ~a inbound packet ~a -> ~a (type 0x~a)"
|
||||
;; (ethernet-interface-name (ethernet-packet-interface p))
|
||||
;; (pretty-bytes (ethernet-packet-source p))
|
||||
;; (pretty-bytes (ethernet-packet-destination p))
|
||||
;; (number->string (ethernet-packet-ethertype p) 16))
|
||||
;; (log-info "~a" (dump-bytes->string (ethernet-packet-body p)))
|
||||
(send! p))
|
||||
|
||||
(on (message ($ p (ethernet-packet interface #f _ _ _ _)))
|
||||
;; (log-info "Interface ~a OUTBOUND packet ~a -> ~a (type 0x~a)"
|
||||
;; (ethernet-interface-name (ethernet-packet-interface p))
|
||||
;; (pretty-bytes (ethernet-packet-source p))
|
||||
;; (pretty-bytes (ethernet-packet-destination p))
|
||||
;; (number->string (ethernet-packet-ethertype p) 16))
|
||||
;; (log-info "~a" (dump-bytes->string (ethernet-packet-body p)))
|
||||
(raw-interface-write h (encode-ethernet-packet p)))))))
|
||||
|
||||
(define (interface-packet-read-loop interface h control-ch)
|
||||
(define (blocked)
|
||||
|
|
@ -121,14 +110,16 @@
|
|||
(define (ethernet-packet-pattern interface-name from-wire? ethertype)
|
||||
(ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))
|
||||
|
||||
(define (lookup-ethernet-hwaddr base-interests interface-name k)
|
||||
(on-claim #:timeout-msec 5000
|
||||
#:on-timeout (lambda ()
|
||||
(log-info "Lookup of ethernet interface ~v failed" interface-name)
|
||||
'())
|
||||
(lambda (_g hwaddrss)
|
||||
(and (not (set-empty? hwaddrss))
|
||||
(let ((hwaddr (car (set-first hwaddrss))))
|
||||
(k hwaddr))))
|
||||
base-interests
|
||||
(ethernet-interface interface-name (?!))))
|
||||
(define (lookup-ethernet-hwaddr interface-name)
|
||||
(define timer-id (gensym 'lookup-ethernet-hwaddr))
|
||||
(react/suspend (k)
|
||||
(on-start (send! (set-timer timer-id 5000 'relative)))
|
||||
(stop-when (message (timer-expired timer-id _))
|
||||
(log-info "Lookup of ethernet interface ~v failed" interface-name)
|
||||
(k #f))
|
||||
(stop-when (asserted (ethernet-interface interface-name $hwaddr))
|
||||
(k hwaddr))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(spawn-ethernet-driver)
|
||||
|
|
|
|||
|
|
@ -1,19 +1,17 @@
|
|||
#lang syndicate/monolithic
|
||||
|
||||
(require/activate syndicate/drivers/timer)
|
||||
(require/activate "ethernet.rkt")
|
||||
(require/activate "arp.rkt")
|
||||
|
||||
(require syndicate/demand-matcher)
|
||||
(require syndicate/drivers/timer)
|
||||
(require "demo-config.rkt")
|
||||
(require "ethernet.rkt")
|
||||
(require "arp.rkt")
|
||||
(require "ip.rkt")
|
||||
(require "tcp.rkt")
|
||||
(require "udp.rkt")
|
||||
|
||||
;;(log-events-and-actions? #t)
|
||||
|
||||
(spawn-timer-driver)
|
||||
(spawn-ethernet-driver)
|
||||
(spawn-arp-driver)
|
||||
(spawn-ip-driver)
|
||||
(spawn-tcp-driver)
|
||||
(spawn-udp-driver)
|
||||
|
|
|
|||
Loading…
Reference in New Issue