Initial work towards migration from minimart to prospect-monolithic
This commit is contained in:
parent
543073fd2e
commit
ca5bf47adf
148
arp.rkt
148
arp.rkt
|
@ -9,9 +9,9 @@
|
|||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require minimart)
|
||||
(require minimart/drivers/timer)
|
||||
(require minimart/demand-matcher)
|
||||
(require prospect-monolithic)
|
||||
(require prospect-monolithic/drivers/timer)
|
||||
(require prospect-monolithic/demand-matcher)
|
||||
(require bitsyntax)
|
||||
|
||||
(require "dump-bytes.rkt")
|
||||
|
@ -22,6 +22,8 @@
|
|||
(struct arp-assertion (protocol protocol-address interface-name) #:prefab)
|
||||
(struct arp-interface (interface-name) #:prefab)
|
||||
|
||||
(struct arp-interface-up (interface-name) #:prefab)
|
||||
|
||||
(define ARP-ethertype #x0806)
|
||||
(define cache-entry-lifetime-msec (* 14400 1000))
|
||||
(define wakeup-interval 5000)
|
||||
|
@ -30,7 +32,7 @@
|
|||
|
||||
(define (spawn-arp-driver)
|
||||
(spawn-demand-matcher (arp-interface (?!))
|
||||
#:supply-level 1
|
||||
(arp-interface-up (?!))
|
||||
spawn-arp-interface))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -42,13 +44,10 @@
|
|||
|
||||
(define (spawn-arp-interface interface-name)
|
||||
(log-info "spawn-arp-interface ~v" interface-name)
|
||||
(lookup-ethernet-hwaddr (gestalt-for-supply interface-name)
|
||||
(lookup-ethernet-hwaddr (assertion (arp-interface-up interface-name))
|
||||
interface-name
|
||||
(lambda (hwaddr) (spawn-arp-interface* interface-name hwaddr))))
|
||||
|
||||
(define (gestalt-for-supply interface-name)
|
||||
(sub (arp-interface interface-name) #:level 1))
|
||||
|
||||
(define (spawn-arp-interface* interface-name hwaddr)
|
||||
(log-info "spawn-arp-interface* ~v ~v" interface-name hwaddr)
|
||||
(define interface (ethernet-interface interface-name hwaddr))
|
||||
|
@ -62,21 +61,20 @@
|
|||
(define timer-key (list 'arp interface-name))
|
||||
|
||||
(define (set-wakeup-alarm)
|
||||
(send (set-timer timer-key wakeup-interval 'relative)))
|
||||
(message (set-timer timer-key wakeup-interval 'relative)))
|
||||
|
||||
(define (compute-gestalt cache)
|
||||
(gestalt-union (sub (timer-expired timer-key ?))
|
||||
(sub (ethernet-packet-pattern interface-name #t ARP-ethertype))
|
||||
(sub (ethernet-packet-pattern interface-name #t ARP-ethertype) #:level 1)
|
||||
(pub (ethernet-packet-pattern interface-name #f ARP-ethertype))
|
||||
(gestalt-for-supply interface-name)
|
||||
(sub (arp-assertion ? ? interface-name) #:level 1)
|
||||
(pub (arp-query ? ? interface ?) #:level 2)
|
||||
(for/fold [(g (gestalt-empty))] [((k v) (in-hash cache))]
|
||||
(gestalt-union g (pub (arp-query (cache-key-protocol k)
|
||||
(cache-key-address k)
|
||||
(cache-value-interface v)
|
||||
(cache-value-address v)))))))
|
||||
(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))
|
||||
|
@ -135,40 +133,39 @@
|
|||
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))
|
||||
(send (build-packet sender-hardware-address
|
||||
ptype
|
||||
2 ;; reply
|
||||
hwaddr
|
||||
target-protocol-address
|
||||
sender-hardware-address
|
||||
sender-protocol-address)))
|
||||
'())]
|
||||
[(2) '()] ;; reply
|
||||
[else '()])
|
||||
(routing-update (compute-gestalt cache))))))
|
||||
(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 queries-projection (project-subs #:level 1 (arp-query (?!) (?!) ? ?)))
|
||||
(define queries-projection (compile-projection (observe (arp-query (?!) (?!) ? ?))))
|
||||
(define (gestalt->queries g)
|
||||
(for/set [(e (in-set (gestalt-project/keys g queries-projection)))]
|
||||
(for/set [(e (in-set (trie-project/set g queries-projection)))]
|
||||
(match-define (list ptype pa) e)
|
||||
(cache-key ptype pa)))
|
||||
|
||||
(define assertions-projection (project-pubs (arp-assertion (?!) (?!) ?)))
|
||||
(define assertions-projection (compile-projection (arp-assertion (?!) (?!) ?)))
|
||||
(define (gestalt->assertions g)
|
||||
(for/set [(e (in-set (gestalt-project/keys g assertions-projection)))]
|
||||
(for/set [(e (in-set (trie-project/set g assertions-projection)))]
|
||||
(match-define (list ptype pa) e)
|
||||
(cache-key ptype pa)))
|
||||
|
||||
|
@ -176,22 +173,22 @@
|
|||
(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]))
|
||||
(transition new-s
|
||||
(list
|
||||
(when (gestalt-empty? (gestalt-filter g (gestalt-for-supply interface-name)))
|
||||
(quit))
|
||||
(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))
|
||||
(send (build-packet broadcast-ethernet-address
|
||||
(cache-key-protocol a)
|
||||
2 ;; reply -- gratuitous announcement
|
||||
hwaddr
|
||||
(cache-key-address a)
|
||||
hwaddr
|
||||
(cache-key-address a)))))))
|
||||
(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))))))))
|
||||
|
||||
(define (send-questions s)
|
||||
(define unanswered-queries
|
||||
|
@ -209,30 +206,29 @@
|
|||
(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)))))))
|
||||
(message (build-packet broadcast-ethernet-address
|
||||
(cache-key-protocol q)
|
||||
1 ;; request
|
||||
hwaddr
|
||||
pa
|
||||
zero-ethernet-address
|
||||
(cache-key-address q)))))))
|
||||
|
||||
(list (set-wakeup-alarm)
|
||||
(spawn (lambda (e s)
|
||||
;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
|
||||
(match e
|
||||
[(routing-update g)
|
||||
[(scn g)
|
||||
(sequence-transitions (analyze-gestalt g s)
|
||||
send-questions)]
|
||||
[(message (ethernet-packet _ _ source destination _ body) _ _)
|
||||
[(message (ethernet-packet _ _ source destination _ body))
|
||||
(analyze-incoming-packet source destination body s)]
|
||||
[(message (timer-expired _ _) _ _)
|
||||
[(message (timer-expired _ _))
|
||||
(define new-s (struct-copy state s
|
||||
[cache (expire-cache (state-cache s))]))
|
||||
(define new-g (compute-gestalt (state-cache new-s)))
|
||||
(sequence-transitions (transition new-s
|
||||
(list (set-wakeup-alarm)
|
||||
(routing-update new-g)))
|
||||
(compute-gestalt (state-cache new-s))))
|
||||
send-questions)]
|
||||
[_ #f]))
|
||||
(state (hash) (set) (set))
|
||||
|
|
|
@ -3,7 +3,9 @@
|
|||
(provide (struct-out ethernet-interface)
|
||||
(struct-out host-route)
|
||||
(struct-out gateway-route)
|
||||
(struct-out net-route))
|
||||
(struct-out net-route)
|
||||
|
||||
(struct-out route-up))
|
||||
|
||||
(struct ethernet-interface (name hwaddr) #:prefab)
|
||||
|
||||
|
@ -15,3 +17,5 @@
|
|||
(struct host-route (ip-addr netmask interface-name) #:prefab)
|
||||
(struct gateway-route (network-addr netmask gateway-addr interface-name) #:prefab)
|
||||
(struct net-route (network-addr netmask link) #:prefab)
|
||||
|
||||
(struct route-up (route) #:prefab) ;; assertion: the given Route is running
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
;; Demonstration stack configuration for various hosts.
|
||||
|
||||
(require racket/match)
|
||||
(require minimart)
|
||||
(require prospect-monolithic)
|
||||
(require (only-in mzlib/os gethostname))
|
||||
(require "configuration.rkt")
|
||||
|
||||
|
@ -13,14 +13,14 @@
|
|||
(void)
|
||||
(match (gethostname)
|
||||
["skip"
|
||||
(gestalt-union (pub (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "en0"))
|
||||
(pub (host-route (bytes 192 168 1 222) 24 "en0")))]
|
||||
(scn/union (assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "en0"))
|
||||
(assertion (host-route (bytes 192 168 1 222) 24 "en0")))]
|
||||
[(or "hop" "walk")
|
||||
(gestalt-union (pub (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "wlan0"))
|
||||
(pub (host-route (bytes 192 168 1 222) 24 "wlan0")))]
|
||||
(scn/union (assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "wlan0"))
|
||||
(assertion (host-route (bytes 192 168 1 222) 24 "wlan0")))]
|
||||
["stockholm.ccs.neu.edu"
|
||||
(gestalt-union (pub (host-route (bytes 129 10 115 94) 24 "eth0"))
|
||||
(pub (host-route (bytes 192 168 56 222) 24 "vboxnet0"))
|
||||
(pub (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0")))]
|
||||
(scn/union (assertion (host-route (bytes 129 10 115 94) 24 "eth0"))
|
||||
(assertion (host-route (bytes 192 168 56 222) 24 "vboxnet0"))
|
||||
(assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0")))]
|
||||
[else
|
||||
(error 'spawn-demo-config "No setup for hostname ~a" (gethostname))])))
|
||||
|
|
65
ethernet.rkt
65
ethernet.rkt
|
@ -6,8 +6,6 @@
|
|||
broadcast-ethernet-address
|
||||
interface-names
|
||||
spawn-ethernet-driver
|
||||
ethernet-hwaddr-projection
|
||||
gestalt->hwaddr
|
||||
ethernet-packet-pattern
|
||||
lookup-ethernet-hwaddr)
|
||||
|
||||
|
@ -15,8 +13,8 @@
|
|||
(require racket/match)
|
||||
(require racket/async-channel)
|
||||
|
||||
(require minimart)
|
||||
(require minimart/demand-matcher)
|
||||
(require prospect-monolithic)
|
||||
(require prospect-monolithic/demand-matcher)
|
||||
|
||||
(require packet-socket)
|
||||
(require bitsyntax)
|
||||
|
@ -33,8 +31,8 @@
|
|||
(log-info "Device names: ~a" interface-names)
|
||||
|
||||
(define (spawn-ethernet-driver)
|
||||
(spawn-demand-matcher (ethernet-packet (ethernet-interface (?!) ?) #t ? ? ? ?)
|
||||
#:demand-is-subscription? #t
|
||||
(spawn-demand-matcher (observe (ethernet-packet (ethernet-interface (?!) ?) #t ? ? ? ?))
|
||||
(ethernet-interface (?!) ?)
|
||||
spawn-interface-tap))
|
||||
|
||||
(define (spawn-interface-tap interface-name)
|
||||
|
@ -50,22 +48,21 @@
|
|||
(thread (lambda () (interface-packet-read-loop interface h control-ch)))
|
||||
(spawn (lambda (e h)
|
||||
(match e
|
||||
[(routing-update g)
|
||||
|
||||
(if (gestalt-empty? g)
|
||||
[(scn g)
|
||||
(if (trie-empty? g)
|
||||
(begin (async-channel-put control-ch 'quit)
|
||||
(transition #f (quit)))
|
||||
(quit))
|
||||
(begin (async-channel-put control-ch 'unblock)
|
||||
#f))]
|
||||
[(message (? ethernet-packet? p) 1 #f) ;; from metalevel 1
|
||||
[(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 (send p))]
|
||||
[(message (? ethernet-packet? p) 0 #f) ;; from metalevel 0
|
||||
(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))
|
||||
|
@ -76,10 +73,10 @@
|
|||
#f]
|
||||
[_ #f]))
|
||||
h
|
||||
(gestalt-union (pub (ethernet-packet interface #t ? ? ? ?))
|
||||
(pub (ethernet-packet interface #t ? ? ? ?) #:level 1)
|
||||
(sub (ethernet-packet interface #f ? ? ? ?))
|
||||
(sub (ethernet-packet interface #t ? ? ? ?) #:meta-level 1)))]))
|
||||
(scn/union (assertion interface)
|
||||
(subscription (ethernet-packet interface #f ? ? ? ?))
|
||||
(subscription (observe (ethernet-packet interface #t ? ? ? ?)))
|
||||
(subscription (ethernet-packet interface #t ? ? ? ?) #:meta-level 1)))]))
|
||||
|
||||
(define (interface-packet-read-loop interface h control-ch)
|
||||
(define (blocked)
|
||||
|
@ -120,29 +117,17 @@
|
|||
(ethertype :: integer bytes 2)
|
||||
(body :: binary))))
|
||||
|
||||
(define (ethernet-hwaddr-projection interface-name)
|
||||
(project-pubs (ethernet-packet (ethernet-interface interface-name (?!)) #t ? ? ? ?)))
|
||||
|
||||
(define (gestalt->hwaddr g interface-name)
|
||||
(define hwaddrs (gestalt-project/single g (ethernet-hwaddr-projection interface-name)))
|
||||
(case (set-count hwaddrs)
|
||||
[(0) #f]
|
||||
[(1) (set-first hwaddrs)]
|
||||
[else
|
||||
(log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v" interface-name hwaddrs)
|
||||
(set-first hwaddrs)]))
|
||||
|
||||
(define (ethernet-packet-pattern interface-name from-wire? ethertype)
|
||||
(ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))
|
||||
|
||||
(define (lookup-ethernet-hwaddr base-gestalt interface-name k)
|
||||
(on-gestalt #: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-gestalt
|
||||
(ethernet-hwaddr-projection interface-name)))
|
||||
(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 (?!))))
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang minimart
|
||||
#lang prospect-monolithic
|
||||
|
||||
(require minimart/demand-matcher)
|
||||
(require minimart/drivers/timer)
|
||||
(require prospect-monolithic/demand-matcher)
|
||||
(require prospect-monolithic/drivers/timer)
|
||||
(require "demo-config.rkt")
|
||||
(require "ethernet.rkt")
|
||||
(require "arp.rkt")
|
||||
|
|
210
ip.rkt
210
ip.rkt
|
@ -13,9 +13,9 @@
|
|||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require (only-in racket/string string-split))
|
||||
(require minimart)
|
||||
(require minimart/drivers/timer)
|
||||
(require minimart/demand-matcher)
|
||||
(require prospect-monolithic)
|
||||
(require prospect-monolithic/drivers/timer)
|
||||
(require prospect-monolithic/demand-matcher)
|
||||
(require bitsyntax)
|
||||
|
||||
(require "dump-bytes.rkt")
|
||||
|
@ -53,48 +53,38 @@
|
|||
|
||||
(define broadcast-ip-address (bytes 255 255 255 255))
|
||||
|
||||
(define local-ip-address-projector (project-pubs (host-route (?!) ? ?)))
|
||||
(define (gestalt->local-ip-addresses g) (gestalt-project/single g local-ip-address-projector))
|
||||
(define observe-local-ip-addresses-gestalt (sub (host-route ? ? ?) #:level 2))
|
||||
(define local-ip-address-projector (compile-projection (host-route (?!) ? ?)))
|
||||
(define (gestalt->local-ip-addresses g) (trie-project/set/single g local-ip-address-projector))
|
||||
(define observe-local-ip-addresses-gestalt (subscription (host-route ? ? ?)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (spawn-ip-driver)
|
||||
(list
|
||||
(spawn-demand-matcher (host-route (?!) (?!) (?!))
|
||||
#:supply-level 1
|
||||
(route-up (host-route (?!) (?!) (?!)))
|
||||
spawn-host-route)
|
||||
(spawn-demand-matcher (gateway-route (?!) (?!) (?!) (?!))
|
||||
#:supply-level 1
|
||||
(route-up (gateway-route (?!) (?!) (?!) (?!)))
|
||||
spawn-gateway-route)
|
||||
(spawn-demand-matcher (net-route (?!) (?!) (?!))
|
||||
#:supply-level 1
|
||||
(route-up (net-route (?!) (?!) (?!)))
|
||||
spawn-net-route)))
|
||||
|
||||
(define (host-route-supply ip-addr netmask interface-name)
|
||||
(sub (host-route ip-addr netmask interface-name) #:level 1))
|
||||
|
||||
(define (gateway-route-supply network-addr netmask gateway-addr interface-name)
|
||||
(sub (gateway-route network-addr netmask gateway-addr interface-name) #:level 1))
|
||||
|
||||
(define (net-route-supply network-addr netmask link)
|
||||
(sub (net-route network-addr netmask link) #:level 1))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Local IP route
|
||||
|
||||
(define (spawn-host-route my-address netmask interface-name)
|
||||
(list
|
||||
(let ((network-addr (apply-netmask my-address netmask)))
|
||||
(spawn-normal-ip-route (host-route-supply my-address netmask interface-name)
|
||||
(spawn-normal-ip-route (host-route my-address netmask interface-name)
|
||||
network-addr
|
||||
netmask
|
||||
interface-name))
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(routing-update g)
|
||||
(transition s (when (gestalt-empty? g) (quit)))]
|
||||
[(message (ip-packet _ peer-address _ _ _ body) _ _)
|
||||
[(scn (? trie-empty?)) (quit)]
|
||||
[(message (ip-packet _ peer-address _ _ _ body))
|
||||
(bit-string-case body
|
||||
([ type code (checksum :: integer bytes 2) (rest :: binary) ] ;; TODO: check cksum
|
||||
(case type
|
||||
|
@ -106,12 +96,12 @@
|
|||
code
|
||||
(0 :: integer bytes 2) ;; TODO
|
||||
(rest :: binary)))
|
||||
(transition s (send (ip-packet #f
|
||||
my-address
|
||||
peer-address
|
||||
PROTOCOL-ICMP
|
||||
#""
|
||||
(ip-checksum 2 reply-data0))))]
|
||||
(transition s (message (ip-packet #f
|
||||
my-address
|
||||
peer-address
|
||||
PROTOCOL-ICMP
|
||||
#""
|
||||
(ip-checksum 2 reply-data0))))]
|
||||
[else
|
||||
(log-info "ICMP ~a/~a (cksum ~a) to ~a from ~a:\n~a"
|
||||
type
|
||||
|
@ -124,10 +114,10 @@
|
|||
(else #f))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(gestalt-union (pub (ip-packet ? my-address ? PROTOCOL-ICMP ? ?))
|
||||
(sub (ip-packet ? ? my-address PROTOCOL-ICMP ? ?))
|
||||
(pub (arp-assertion IPv4-ethertype my-address interface-name))
|
||||
(host-route-supply my-address netmask interface-name)))))
|
||||
(scn/union (advertisement (ip-packet ? my-address ? PROTOCOL-ICMP ? ?))
|
||||
(subscription (ip-packet ? ? my-address PROTOCOL-ICMP ? ?))
|
||||
(assertion (arp-assertion IPv4-ethertype my-address interface-name))
|
||||
(subscription (host-route my-address netmask interface-name))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Gateway IP route
|
||||
|
@ -135,15 +125,16 @@
|
|||
(struct gateway-route-state (routes gateway-interface gateway-hwaddr) #:transparent)
|
||||
|
||||
(define (spawn-gateway-route network netmask gateway-addr interface-name)
|
||||
(define gestalt-for-supply (gateway-route-supply network netmask gateway-addr interface-name))
|
||||
(define the-route (gateway-route network netmask gateway-addr interface-name))
|
||||
|
||||
(define host-route-projector (project-subs (host-route (?!) ? ?)))
|
||||
(define gateway-route-projector (project-subs (gateway-route (?!) (?!) ? ?)))
|
||||
(define net-route-projector (project-subs (net-route (?!) (?!) ?)))
|
||||
(define gateway-arp-projector (project-pubs (arp-query IPv4-ethertype
|
||||
gateway-addr
|
||||
(?! (ethernet-interface interface-name ?))
|
||||
(?!))))
|
||||
(define host-route-projector (compile-projection (host-route (?!) ? ?)))
|
||||
(define gateway-route-projector (compile-projection (gateway-route (?!) (?!) ? ?)))
|
||||
(define net-route-projector (compile-projection (net-route (?!) (?!) ?)))
|
||||
(define gateway-arp-projector (compile-projection
|
||||
(arp-query IPv4-ethertype
|
||||
gateway-addr
|
||||
(?! (ethernet-interface interface-name ?))
|
||||
(?!))))
|
||||
|
||||
(define (covered-by-some-other-route? addr routes)
|
||||
(for/or ([r (in-set routes)])
|
||||
|
@ -153,25 +144,27 @@
|
|||
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(routing-update g)
|
||||
(define host-ips (gestalt-project/single g host-route-projector))
|
||||
(define gw-nets+netmasks (gestalt-project/keys g gateway-route-projector))
|
||||
(define net-nets+netmasks (gestalt-project/keys g net-route-projector))
|
||||
(define gw-ip+hwaddr (let ((vs (gestalt-project/keys g gateway-arp-projector)))
|
||||
[(scn g)
|
||||
(define host-ips (trie-project/set/single g host-route-projector))
|
||||
(define gw-nets+netmasks (trie-project/set g gateway-route-projector))
|
||||
(define net-nets+netmasks (trie-project/set g net-route-projector))
|
||||
(define gw-ip+hwaddr (let ((vs (trie-project/set g gateway-arp-projector)))
|
||||
(and vs (not (set-empty? vs)) (set-first vs))))
|
||||
(when (and gw-ip+hwaddr (not (gateway-route-state-gateway-hwaddr s)))
|
||||
(log-info "Discovered gateway ~a at ~a on interface ~a."
|
||||
(ip-address->hostname gateway-addr)
|
||||
(ethernet-interface-name (car gw-ip+hwaddr))
|
||||
(pretty-bytes (cadr gw-ip+hwaddr))))
|
||||
(transition (gateway-route-state
|
||||
(set-union (for/set ([ip host-ips]) (list ip 32))
|
||||
gw-nets+netmasks
|
||||
net-nets+netmasks)
|
||||
(and gw-ip+hwaddr (car gw-ip+hwaddr))
|
||||
(and gw-ip+hwaddr (cadr gw-ip+hwaddr)))
|
||||
(when (gestalt-empty? (gestalt-filter g gestalt-for-supply)) (quit)))]
|
||||
[(message (? ip-packet? p) _ _)
|
||||
(if (trie-empty? (project-assertions g (?! the-route)))
|
||||
(quit)
|
||||
(transition (gateway-route-state
|
||||
(set-union (for/set ([ip host-ips]) (list ip 32))
|
||||
gw-nets+netmasks
|
||||
net-nets+netmasks)
|
||||
(and gw-ip+hwaddr (car gw-ip+hwaddr))
|
||||
(and gw-ip+hwaddr (cadr gw-ip+hwaddr)))
|
||||
'()))]
|
||||
[(message (? ip-packet? p))
|
||||
(define gw-if (gateway-route-state-gateway-interface s))
|
||||
(when (not gw-if)
|
||||
(log-warning "Gateway hwaddr for ~a not known, packet dropped."
|
||||
|
@ -181,42 +174,39 @@
|
|||
(not (covered-by-some-other-route? (ip-packet-destination p)
|
||||
(gateway-route-state-routes s)))
|
||||
(transition s
|
||||
(send (ethernet-packet gw-if
|
||||
#f
|
||||
(ethernet-interface-hwaddr gw-if)
|
||||
(gateway-route-state-gateway-hwaddr s)
|
||||
IPv4-ethertype
|
||||
(format-ip-packet p)))))]
|
||||
(message (ethernet-packet gw-if
|
||||
#f
|
||||
(ethernet-interface-hwaddr gw-if)
|
||||
(gateway-route-state-gateway-hwaddr s)
|
||||
IPv4-ethertype
|
||||
(format-ip-packet p)))))]
|
||||
[_ #f]))
|
||||
(gateway-route-state (set) #f #f)
|
||||
(gestalt-union gestalt-for-supply
|
||||
|
||||
(sub (ip-packet ? ? ? ? ? ?))
|
||||
(pub (ip-packet ? ? ? ? ? ?))
|
||||
|
||||
observe-local-ip-addresses-gestalt
|
||||
(sub (net-route ? ? ?) #:level 2)
|
||||
(sub (gateway-route ? ? ? ?) #:level 2)
|
||||
(projection->gestalt gateway-arp-projector))))
|
||||
(scn/union (subscription the-route)
|
||||
(assertion (route-up the-route))
|
||||
(subscription (ip-packet ? ? ? ? ? ?))
|
||||
observe-local-ip-addresses-gestalt
|
||||
(subscription (net-route ? ? ?))
|
||||
(subscription (gateway-route ? ? ? ?))
|
||||
(subscription (projection->pattern gateway-arp-projector)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; General net route
|
||||
|
||||
(define (spawn-net-route network-addr netmask link)
|
||||
(spawn-normal-ip-route (net-route-supply network-addr netmask link) network-addr netmask link))
|
||||
(spawn-normal-ip-route (net-route network-addr netmask link) network-addr netmask link))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Normal IP route
|
||||
|
||||
(define (spawn-normal-ip-route gestalt-for-supply network netmask interface-name)
|
||||
(define (spawn-normal-ip-route the-route network netmask interface-name)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(routing-update g)
|
||||
(transition s (when (gestalt-empty? g) (quit)))]
|
||||
[(message (ethernet-packet _ _ _ _ _ body) _ _)
|
||||
[(scn (? trie-empty?)) (quit)]
|
||||
[(message (ethernet-packet _ _ _ _ _ body))
|
||||
(define p (parse-ip-packet interface-name body))
|
||||
(and p (transition s (send p)))]
|
||||
[(message (? ip-packet? p) _ _)
|
||||
(and p (transition s (message p)))]
|
||||
[(message (? ip-packet? p))
|
||||
(define destination (ip-packet-destination p))
|
||||
(and (not (equal? (ip-packet-source-interface p) interface-name))
|
||||
(ip-address-in-subnet? destination network netmask)
|
||||
|
@ -224,23 +214,21 @@
|
|||
s
|
||||
(lookup-arp destination
|
||||
(ethernet-interface interface-name ?)
|
||||
(gestalt-empty)
|
||||
(trie-empty)
|
||||
(lambda (interface destination-hwaddr)
|
||||
(send (ethernet-packet interface
|
||||
#f
|
||||
(ethernet-interface-hwaddr interface)
|
||||
destination-hwaddr
|
||||
IPv4-ethertype
|
||||
(format-ip-packet p)))))))]
|
||||
(message (ethernet-packet interface
|
||||
#f
|
||||
(ethernet-interface-hwaddr interface)
|
||||
destination-hwaddr
|
||||
IPv4-ethertype
|
||||
(format-ip-packet p)))))))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(gestalt-union gestalt-for-supply
|
||||
(sub (ethernet-packet-pattern interface-name #t IPv4-ethertype))
|
||||
(sub (ethernet-packet-pattern interface-name #t IPv4-ethertype) #:level 1)
|
||||
(pub (ethernet-packet-pattern interface-name #f IPv4-ethertype))
|
||||
(pub (arp-interface interface-name))
|
||||
(sub (ip-packet ? ? ? ? ? ?))
|
||||
(pub (ip-packet ? ? ? ? ? ?)))))
|
||||
(scn/union (subscription the-route)
|
||||
(assertion (route-up the-route))
|
||||
(subscription (ethernet-packet-pattern interface-name #t IPv4-ethertype))
|
||||
(assertion (arp-interface interface-name))
|
||||
(subscription (ip-packet ? ? ? ? ? ?)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
@ -313,25 +301,25 @@
|
|||
full-packet)
|
||||
|
||||
(define (lookup-arp ipaddr query-interface-pattern base-gestalt k)
|
||||
(on-gestalt (lambda (_g arp-results)
|
||||
(if (not arp-results)
|
||||
(error 'ip "Someone has published a wildcard arp result")
|
||||
(and (not (set-empty? arp-results))
|
||||
(match (set-first arp-results)
|
||||
[(list interface hwaddr)
|
||||
(log-info "ARP lookup yielded ~a on ~a for ~a"
|
||||
(pretty-bytes hwaddr)
|
||||
(ethernet-interface-name interface)
|
||||
(ip-address->hostname ipaddr))
|
||||
(when (> (set-count arp-results) 1)
|
||||
(log-warning "Ambiguous ARP result for ~a: ~v"
|
||||
(ip-address->hostname ipaddr)
|
||||
arp-results))
|
||||
(k interface hwaddr)]))))
|
||||
base-gestalt
|
||||
(project-pubs (arp-query IPv4-ethertype ipaddr (?! query-interface-pattern) (?!)))
|
||||
#:timeout-msec 5000
|
||||
#:on-timeout (lambda ()
|
||||
(log-warning "ARP lookup of ~a failed, packet dropped"
|
||||
(ip-address->hostname ipaddr))
|
||||
'())))
|
||||
(on-claim (lambda (_g arp-results)
|
||||
(if (not arp-results)
|
||||
(error 'ip "Someone has published a wildcard arp result")
|
||||
(and (not (set-empty? arp-results))
|
||||
(match (set-first arp-results)
|
||||
[(list interface hwaddr)
|
||||
(log-info "ARP lookup yielded ~a on ~a for ~a"
|
||||
(pretty-bytes hwaddr)
|
||||
(ethernet-interface-name interface)
|
||||
(ip-address->hostname ipaddr))
|
||||
(when (> (set-count arp-results) 1)
|
||||
(log-warning "Ambiguous ARP result for ~a: ~v"
|
||||
(ip-address->hostname ipaddr)
|
||||
arp-results))
|
||||
(k interface hwaddr)]))))
|
||||
base-gestalt
|
||||
(arp-query IPv4-ethertype ipaddr (?! query-interface-pattern) (?!))
|
||||
#:timeout-msec 5000
|
||||
#:on-timeout (lambda ()
|
||||
(log-warning "ARP lookup of ~a failed, packet dropped"
|
||||
(ip-address->hostname ipaddr))
|
||||
'())))
|
||||
|
|
141
main.rkt
141
main.rkt
|
@ -1,13 +1,13 @@
|
|||
#lang minimart
|
||||
#lang prospect-monolithic
|
||||
|
||||
(require minimart/demand-matcher)
|
||||
(require minimart/drivers/timer)
|
||||
(require prospect-monolithic/demand-matcher)
|
||||
(require prospect-monolithic/drivers/timer)
|
||||
(require "demo-config.rkt")
|
||||
(require "ethernet.rkt")
|
||||
(require "arp.rkt")
|
||||
(require "ip.rkt")
|
||||
(require "tcp.rkt")
|
||||
(require "udp.rkt")
|
||||
;; (require "tcp.rkt")
|
||||
;; (require "udp.rkt")
|
||||
|
||||
;;(log-events-and-actions? #t)
|
||||
|
||||
|
@ -15,94 +15,95 @@
|
|||
(spawn-ethernet-driver)
|
||||
(spawn-arp-driver)
|
||||
(spawn-ip-driver)
|
||||
(spawn-tcp-driver)
|
||||
(spawn-udp-driver)
|
||||
;; (spawn-tcp-driver)
|
||||
;; (spawn-udp-driver)
|
||||
(spawn-demo-config)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(let ()
|
||||
#;(let ()
|
||||
(local-require racket/set racket/string)
|
||||
|
||||
(define (spawn-session them us)
|
||||
(define user (gensym 'user))
|
||||
(define remote-detector (project-pubs #:meta-level 1 (?!)))
|
||||
(define peer-detector (project-pubs `(,(?!) says ,?)))
|
||||
(define remote-detector (compile-projection (at-meta (?!))))
|
||||
(define peer-detector (compile-projection (advertise `(,(?!) says ,?))))
|
||||
(define (send-to-remote fmt . vs)
|
||||
(send #:meta-level 1 (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))
|
||||
(message (at-meta (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
|
||||
(define (say who fmt . vs)
|
||||
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
||||
(list (send-to-remote "Welcome, ~a.\n" user)
|
||||
(spawn (lambda (e old-peers)
|
||||
(log-info "~a: ~v --> ~v" user e old-peers)
|
||||
(match e
|
||||
[(message (tcp-channel _ _ bs) 1 #f)
|
||||
(transition old-peers
|
||||
(send `(,user says ,(string-trim (bytes->string/utf-8 bs)))))]
|
||||
[(message `(,who says ,what) 0 #f)
|
||||
(transition old-peers (say who "says: ~a" what))]
|
||||
[(routing-update g)
|
||||
(define new-peers (gestalt-project/single g peer-detector))
|
||||
(transition
|
||||
new-peers
|
||||
(list (when (matcher-empty? (gestalt-project g remote-detector)) (quit))
|
||||
(for/list [(who (set-subtract new-peers old-peers))]
|
||||
(say who "arrived."))
|
||||
(for/list [(who (set-subtract old-peers new-peers))]
|
||||
(say who "departed."))))]
|
||||
[#f #f]))
|
||||
(set)
|
||||
(gestalt-union (sub `(,? says ,?))
|
||||
(sub `(,? says ,?) #:level 1)
|
||||
(pub `(,user says ,?))
|
||||
(sub (tcp-channel them us ?) #:meta-level 1)
|
||||
(sub (tcp-channel them us ?) #:meta-level 1 #:level 1)
|
||||
(pub (tcp-channel us them ?) #:meta-level 1)))))
|
||||
|
||||
(spawn-world
|
||||
(spawn-demand-matcher (tcp-channel (?! (tcp-address ? ?)) (?! (tcp-listener 6667)) ?)
|
||||
#:meta-level 1
|
||||
spawn-session))
|
||||
(spawn
|
||||
(lambda (e peers)
|
||||
(match e
|
||||
[(message (at-meta (tcp-channel _ _ bs)))
|
||||
(transition peers (message `(,user says ,(string-trim (bytes->string/utf-8 bs)))))]
|
||||
[(message `(,who says ,what))
|
||||
(transition peers (say who "says: ~a" what))]
|
||||
[(scn assertions)
|
||||
(if (trie-empty? (trie-project assertions remote-detector))
|
||||
(quit (send-to-remote "Goodbye!\n"))
|
||||
(let ((new-peers (trie-project/set/single assertions peer-detector)))
|
||||
(define arrived (set-subtract new-peers peers))
|
||||
(define departed (set-subtract peers new-peers))
|
||||
(transition new-peers
|
||||
(list (for/list [(who arrived)] (say who "arrived."))
|
||||
(for/list [(who departed)] (say who "departed."))))))]
|
||||
[#f #f]))
|
||||
(set)
|
||||
(scn/union
|
||||
(subscription `(,? says ,?)) ;; read actual chat messages
|
||||
(subscription (advertise `(,? says ,?))) ;; observe peer presence
|
||||
(advertisement `(,user says ,?)) ;; advertise our presence
|
||||
(subscription (tcp-channel them us ?) #:meta-level 1) ;; read from remote client
|
||||
(subscription (advertise (tcp-channel them us ?)) #:meta-level 1) ;; monitor remote client
|
||||
(advertisement (tcp-channel us them ?) #:meta-level 1) ;; we will write to remote client
|
||||
))))
|
||||
|
||||
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
#:meta-level 1
|
||||
spawn-session)
|
||||
)
|
||||
|
||||
(let ()
|
||||
#;(let ()
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (udp-packet src dst body) _ _)
|
||||
[(message (udp-packet src dst body))
|
||||
(log-info "Got packet from ~v: ~v" src body)
|
||||
(transition s (send (udp-packet dst
|
||||
src
|
||||
(string->bytes/utf-8 (format "You said: ~a" body)))))]
|
||||
(transition s (message
|
||||
(udp-packet dst
|
||||
src
|
||||
(string->bytes/utf-8 (format "You said: ~a" body)))))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(gestalt-union (sub (udp-packet ? (udp-listener 6667) ?)))))
|
||||
(scn (subscription (udp-packet ? (udp-listener 6667) ?)))))
|
||||
|
||||
(let ()
|
||||
#;(let ()
|
||||
(define (spawn-session them us)
|
||||
(list
|
||||
(send 'bump)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message `(counter ,counter) _ _)
|
||||
[(message `(counter ,counter))
|
||||
(define response
|
||||
(string->bytes/utf-8
|
||||
(format (string-append
|
||||
"HTTP/1.0 200 OK\r\n\r\n"
|
||||
"<h1>Hello world from minimart-netstack!</h1>\n"
|
||||
"<p>This is running on minimart's own\n"
|
||||
"<a href='https://github.com/tonyg/minimart-netstack/'>\n"
|
||||
"<h1>Hello world from prospect-monolithic-netstack!</h1>\n"
|
||||
"<p>This is running on prospect-monolithic's own\n"
|
||||
"<a href='https://github.com/tonyg/prospect-netstack/'>\n"
|
||||
"TCP/IP stack</a>.</p>\n"
|
||||
"<p>There have been ~a requests prior to this one.</p>")
|
||||
counter)))
|
||||
(transition s (list (send #:meta-level 1 (tcp-channel us them response))
|
||||
(transition s (list (message #:meta-level 1 (tcp-channel us them response))
|
||||
(quit)))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(gestalt-union (sub `(counter ,?))
|
||||
(sub (tcp-channel them us ?) #:meta-level 1)
|
||||
(sub (tcp-channel them us ?) #:meta-level 1 #:level 1)
|
||||
(pub (tcp-channel us them ?) #:meta-level 1)))))
|
||||
(scn/union (subscription `(counter ,?))
|
||||
(subscription (tcp-channel them us ?) #:meta-level 1)
|
||||
(subscription (advertise (tcp-channel them us ?)) #:meta-level 1)
|
||||
(advertisement (tcp-channel us them ?) #:meta-level 1)))))
|
||||
|
||||
(spawn-world
|
||||
(spawn (lambda (e counter)
|
||||
|
@ -111,30 +112,10 @@
|
|||
(transition (+ counter 1) (send `(counter ,counter)))]
|
||||
[_ #f]))
|
||||
0
|
||||
(gestalt-union (sub 'bump)
|
||||
(pub `(counter ,?))))
|
||||
(spawn-demand-matcher (tcp-channel (?! (tcp-address ? ?)) (?! (tcp-listener 80)) ?)
|
||||
(scn (subscription 'bump)))
|
||||
(spawn-demand-matcher (advertise (tcp-channel (?! (tcp-address ? ?)) (?! (tcp-listener 80)) ?))
|
||||
(observe (tcp-channel (?! (tcp-address ? ?)) (?! (tcp-listener 80)) ?))
|
||||
#:meta-level 1
|
||||
spawn-session))
|
||||
|
||||
)
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(local-require racket/pretty)
|
||||
(match e
|
||||
[(message m _ _)
|
||||
;; (pretty-write `(MAIN ,m))
|
||||
(void)]
|
||||
[(routing-update g)
|
||||
;; (printf "MAIN gestalt:\n")
|
||||
;; (pretty-print-gestalt g)
|
||||
(void)]
|
||||
[_ (void)])
|
||||
(flush-output)
|
||||
#f)
|
||||
(void)
|
||||
(gestalt-union
|
||||
(sub ? #:level 5)
|
||||
(pub ? #:level 5)
|
||||
;;(sub (tcp-channel ? ? ?) #:level 5)
|
||||
))
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require minimart)
|
||||
(require prospect-monolithic)
|
||||
(require "ip.rkt")
|
||||
|
||||
(struct port-allocation-request (type k) #:prefab)
|
||||
|
|
6
tcp.rkt
6
tcp.rkt
|
@ -8,9 +8,9 @@
|
|||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require minimart)
|
||||
(require minimart/drivers/timer)
|
||||
(require minimart/demand-matcher)
|
||||
(require prospect-monolithic)
|
||||
(require prospect-monolithic/drivers/timer)
|
||||
(require prospect-monolithic/demand-matcher)
|
||||
(require bitsyntax)
|
||||
|
||||
(require "dump-bytes.rkt")
|
||||
|
|
Loading…
Reference in New Issue