@@ -60,45 +60,53 @@ arpManagerT ::
60
60
-- in the ARP table.
61
61
arpManagerT AwaitLookup {.. } (Just lookupIPv4, arpResponseIn, Ack readyIn, _) =
62
62
(nextSt, (arpResponseOut, Just lookupIPv4, arpRequestOut))
63
- where
64
- (arpResponseOut, arpRequestOut, nextSt) = case arpResponseIn of
65
- Nothing
66
- -> ( Nothing
67
- , if _awaitTransmission then Df. Data (ArpLite broadcastMac lookupIPv4 True ) else Df. NoData
68
- , if readyIn && _awaitTransmission then AwaitArpReply maxBound else AwaitLookup False
69
- )
70
- Just ArpEntryNotFound
71
- -> ( Nothing
72
- , Df. Data (ArpLite broadcastMac lookupIPv4 True )
73
- , if readyIn then AwaitArpReply maxBound else AwaitLookup True
74
- )
75
- Just (ArpEntryFound _)
76
- -> ( arpResponseIn
77
- , Df. NoData
78
- , AwaitLookup False
79
- )
63
+ where
64
+ (arpResponseOut, arpRequestOut, nextSt) = case arpResponseIn of
65
+ Nothing ->
66
+ ( Nothing
67
+ , if _awaitTransmission
68
+ then Df. Data (ArpLite broadcastMac lookupIPv4 Request )
69
+ else Df. NoData
70
+ , if readyIn && _awaitTransmission
71
+ then AwaitArpReply maxBound
72
+ else AwaitLookup False
73
+ )
74
+ Just ArpEntryNotFound ->
75
+ ( Nothing
76
+ , Df. Data (ArpLite broadcastMac lookupIPv4 Request )
77
+ , if readyIn
78
+ then AwaitArpReply maxBound
79
+ else AwaitLookup True
80
+ )
81
+ Just (ArpEntryFound _) ->
82
+ ( arpResponseIn
83
+ , Df. NoData
84
+ , AwaitLookup False
85
+ )
80
86
81
87
-- We don't care about incoming backpressure, because we do not send ARP requests in this state.
82
88
-- We keep polling the ARP table until either a timeout occurs or the entry is found.
83
89
-- This requires the ARP table to handle read and write requests in parallel.
84
90
arpManagerT AwaitArpReply {.. } (Just lookupIPv4, arpResponseIn, _, secondPassed) =
85
91
(nextSt, (arpResponseOut, Just lookupIPv4, Df. NoData ))
86
- where
87
- newTimer = if secondPassed then satPred SatBound _secondsLeft else _secondsLeft
88
-
89
- (arpResponseOut, nextSt) =
90
- case (arpResponseIn, _secondsLeft == 0 ) of
91
- (Just (ArpEntryFound _), _)
92
- -> (arpResponseIn, AwaitLookup False )
93
- (Just ArpEntryNotFound , True )
94
- -> (arpResponseIn, AwaitLookup False )
95
- -- Note that we keep driving the same lookup request when the ARP table has not acknowledged
96
- -- our request yet, even if the time is up. If we don't, we violate protocol invariants.
97
- -- Therefore timer can be slightly inaccurate, depending on the latency of the ARP table.
98
- (_, _)
99
- -> (Nothing , AwaitArpReply newTimer)
100
-
101
- arpManagerT st (Nothing , _, _, _) = (st, (Nothing , Nothing , Df. NoData ))
92
+ where
93
+ newTimer =
94
+ if secondPassed
95
+ then satPred SatBound _secondsLeft
96
+ else _secondsLeft
97
+
98
+ (arpResponseOut, nextSt) =
99
+ case (arpResponseIn, _secondsLeft == 0 ) of
100
+ (Just (ArpEntryFound _), _) ->
101
+ (arpResponseIn, AwaitLookup False )
102
+ (Just ArpEntryNotFound , True ) ->
103
+ (arpResponseIn, AwaitLookup False )
104
+ -- Note that we keep driving the same lookup request when the ARP table has not acknowledged
105
+ -- our request yet, even if the time is up. If we don't, we violate protocol invariants.
106
+ -- Therefore timer can be slightly inaccurate, depending on the latency of the ARP table.
107
+ (_, _) ->
108
+ (Nothing , AwaitArpReply newTimer)
109
+ arpManagerT st (Nothing , _, _, _) = (st, (Nothing , Nothing , Df. NoData ))
102
110
103
111
{- |
104
112
Handles ARP lookup requests by client components. If a lookup IPv4 address is
@@ -109,7 +117,7 @@ was received within time, we signal an 'ArpEntryNotFound' to the lookup channel.
109
117
Client components should drop a packet upon receiving 'ArpEntryNotFound' in
110
118
order to avoid stalling the network stack any further.
111
119
112
- __NB__: the timer does not support clock frequencies slower than 2 Hz.
120
+ __NB__: the timer does not support clock frequencies slower than 2000 Hz.
113
121
-}
114
122
arpManagerC ::
115
123
forall
@@ -159,10 +167,10 @@ arpTransmitterC ourMacS ourIPv4S =
159
167
go (ourMac, ourIPv4, maybeArpLite) =
160
168
maybeArpLite >>= \ arpLite -> Df. Data (ourMac, ourIPv4, arpLite)
161
169
162
- toTargetMac (_, _, arpLite) = _targetMac arpLite
170
+ toTargetMac (_, _, arpLite) = _liteTha arpLite
163
171
164
172
constructArpPkt (ourMac, ourIPv4, ArpLite {.. }) =
165
- newArpPacket ourMac ourIPv4 _targetMac _targetIPv4 _isRequest
173
+ newArpPacket ourMac ourIPv4 _liteTha _liteTpa _liteOper
166
174
167
175
{- |
168
176
Parses the incoming packet stream into an @ArpPacket@, validates whether this
@@ -203,17 +211,8 @@ arpReceiverC myIP = circuit $ \stream -> do
203
211
-- before `depacketizetoDfC` should work, as depacketizeToDfC already
204
212
-- implements dropping of
205
213
arpDf <- depacketizeToDfC const -< stream
206
- arpDf' <- Df. filterS (validArp <$> myIP) -< arpDf
207
- (arpRequests, arpEntries) <- Df. partitionS (isRequest <$> myIP) -< arpDf'
208
- lites <- Df. map (\ p -> ArpLite (_sha p) (_spa p) False ) -< arpRequests
214
+ arpDf' <- Df. filterS (isValidArp <$> myIP) -< arpDf
215
+ (arpRequests, arpEntries) <- Df. partitionS (expectsReply <$> myIP) -< arpDf'
216
+ lites <- Df. map (\ p -> ArpLite (_sha p) (_spa p) Reply ) -< arpRequests
209
217
entries <- Df. map (\ p -> ArpEntry (_sha p) (_spa p)) -< arpEntries
210
218
idC -< (entries, lites)
211
- where
212
- validArp ip ArpPacket {.. } =
213
- _htype == 1
214
- && _ptype == 0x0800
215
- && _hlen == 6
216
- && _plen == 4
217
- && (_oper == 1 && (_tpa == ip || _tpa == _spa) || _oper == 2 )
218
-
219
- isRequest ip ArpPacket {.. } = _oper == 1 && _tpa == ip
0 commit comments