syndicate-lang
/
minimart-netstack-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Time out TCP relay process if peers don't show up

This commit is contained in:
Tony Garnock-Jones 2014-06-21 11:55:05 -04:00
parent c4b14b3331
commit 7456e2efec
1 changed files with 27 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
tcp.rkt
View File

@ -109,28 +109,36 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Relay between kernel-level and user-level ;; Relay between kernel-level and user-level
(define relay-peer-wait-time-msec 5000)
(define ((spawn-relay local-user-addr) remote-addr local-tcp-addr) (define ((spawn-relay local-user-addr) remote-addr local-tcp-addr)
(define timer-name (list 'spawn-relay local-tcp-addr remote-addr))
(define local-peer-traffic (pub (tcp-channel remote-addr local-user-addr ?) #:level 1)) (define local-peer-traffic (pub (tcp-channel remote-addr local-user-addr ?) #:level 1))
(define remote-peer-traffic (sub (tcp-channel remote-addr local-tcp-addr ?) #:level 1)) (define remote-peer-traffic (sub (tcp-channel remote-addr local-tcp-addr ?) #:level 1))
(spawn (lambda (e state) (list
(match e (send (set-timer timer-name relay-peer-wait-time-msec 'relative))
[(routing-update g) (spawn (lambda (e state)
(define local-peer-absent? (gestalt-empty? (gestalt-filter g local-peer-traffic))) (match e
(define remote-peer-absent? (gestalt-empty? (gestalt-filter g remote-peer-traffic))) [(routing-update g)
(define new-state (+ (if local-peer-absent? 0 1) (if remote-peer-absent? 0 1))) (define local-peer-absent? (gestalt-empty? (gestalt-filter g local-peer-traffic)))
(transition new-state (when (< new-state state) (quit)))] (define remote-peer-absent? (gestalt-empty? (gestalt-filter g remote-peer-traffic)))
[(message (tcp-channel (== local-user-addr) (== remote-addr) bs) _ _) (define new-state (+ (if local-peer-absent? 0 1) (if remote-peer-absent? 0 1)))
(transition state (send (tcp-channel local-tcp-addr remote-addr bs)))] (transition new-state (when (< new-state state) (quit)))]
[(message (tcp-channel (== remote-addr) (== local-tcp-addr) bs) _ _) [(message (tcp-channel (== local-user-addr) (== remote-addr) bs) _ _)
(transition state (send (tcp-channel remote-addr local-user-addr bs)))] (transition state (send (tcp-channel local-tcp-addr remote-addr bs)))]
[_ #f])) [(message (tcp-channel (== remote-addr) (== local-tcp-addr) bs) _ _)
0 (transition state (send (tcp-channel remote-addr local-user-addr bs)))]
(gestalt-union local-peer-traffic [(message (timer-expired _ _) _ _)
remote-peer-traffic (error 'spawn-relay "TCP relay process timed out waiting for peer")]
(sub (tcp-channel remote-addr local-tcp-addr ?)) [_ #f]))
(sub (tcp-channel local-user-addr remote-addr ?)) 0
(pub (tcp-channel remote-addr local-user-addr ?)) (gestalt-union local-peer-traffic
(pub (tcp-channel local-tcp-addr remote-addr ?))))) remote-peer-traffic
(sub (tcp-channel remote-addr local-tcp-addr ?))
(sub (tcp-channel local-user-addr remote-addr ?))
(pub (tcp-channel remote-addr local-user-addr ?))
(pub (tcp-channel local-tcp-addr remote-addr ?))
(sub (timer-expired timer-name ?))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Codec & kernel-level driver ;; Codec & kernel-level driver