--- This version implemens Click Router. This has two inputs and two outputs --- Run With: approuter [0,1,0,1] -- to test for four packets --- 0 means ethernet packet from device 1 --- 1 means ethernet packet from device 2 ----------Basic types type Packet = [Int] --A packet (RFC792), a list of integer, addressing unit is byte type Puerto = Int --A port is an integer type Event = (Packet,Puerto) --An event is an output pair packet and port, this is the --abstraction of communication between elements ----------Routing table types type Ippatt = [Int] -- ip address pattern type Ethpatt = [Int] -- ethernet address type Mask = Int -- mask in CIDR form type Gw = [Int] -- gateway address type OutPort = Int -- Output port in router type Patt_route = ( Ippatt, Mask, Gw, OutPort ) -- one pattern in routing table ---------- Address Resolution Protocol table types type Patt_mapTable =( Ippatt, Ethpatt ) -- Ip address and ethernet address corresponding ----------- Constant positions in ethernet packet, first 0 ttl_C = 22 -- TTL field can_C = 38 -- Color annotation (Click annotation) iptg_anC = 39 -- ip target annotation (Click annotation) llb_anC = 43 -- link level broadcast flag (Click annotation) outEth = 44 -- ETHERNET OUTPUT annotation (Local implementation annotation) ----------- Constants positions in IP packet, first field is at 0 ttlip_C = ttl_C - 14 -- TTL field canip_C = can_C - 14 -- Color annotation (Click annotation) begIpTarg_C = 16 -- Ip target field llbIp_C = llb_anC – 14 -- Link level broadcast flag (Click annotation) iptg_ann = iptg_anC- 14 -- Ip target annotation (Click annotation) outEth_ann = outEth - 14 -- Ethernet output annotation -- (Local implementation annotation) fix_ip_ann = 31 -- Fix ip annotation (Click annotation) ----------------- Create new packet to Ethernet Device 1 newPacket :: Packet newPacket = [1,1,1,1,1,1,9,9,9,9,9,9,8,0,4,5,7,7,0,0,2,2,255,80,0,0,154,250,159,2, 148,208,179,3,7,7,7,7,-7,0,0,0,0,0,-1,0] newPacket2 :: Packet newPacket2 = [1,1,1,1,1,1,9,9,9,9,9,9,8,0,4,5,7,7,0,0,2,2,250,80,0,0,148,208,179,3, 154,250,159,2,7,7,7,7,-7,0,0,0,0,0,-1,0] --============================== OPERATORS ================================= ----------------- Aplicate a function at position n in a packet appf3 (p:ps) f n | n ==0 = (f p):ps | n > 0 = p: appf3 ps f (n-1) --============================= CLICK ELEMENTS ============================== ----------------- Create a packet list from newPacket and newPacket2, infiniteSource :: [Int] -> [Event] infiniteSource (x:xs) | x==0 = if xs==[] then (newPacket ,0):[] else (newPacket ,0) : infiniteSource xs | x==1 = if xs==[] then (newPacket2,1):[] else (newPacket2,1) : infiniteSource xs ---- Classify input packet to: Ip, ARP Request and ARP Response packets according to RFC792 --- classifier :: Event -> Event classifier (pk,pto) = doClassifier pk doClassifier pk | (lb == 8) && (hb == 0) = (pk,2) -- ip packet | (lb == 8) && (hb == 6) && (alb == 0) &&(ahb == 1) = (pk,0) -- arp request | (lb == 8) && (hb == 6) && (alb == 0) &&(ahb == 2) = (pk,1) -- arp response where lb = pk !! 12 hb = pk !! 13 alb = pk !! 19 ahb = pk !! 20 recess pk = (pk,-1) ---------------- Paint put color annotation (input device) at position 38 in ethernet packet paint :: Event -> Int -> Event paint (pk,pto) n = ((doPaint pk n),0) doPaint pk n = appf3 pk (\_->n) can_C -------------- Strip n, cut n bytes from header, receive an ethernet packet and delivery ip packet strip :: Event->Int->Event strip (pk,pto) n = ((doStrip pk n),0) doStrip pk n = drop n pk ----------------- Verify that is a valid ip packet, not broadcast, not universal checkIPHeader:: Event->Event checkIPHeader (pk,pto)= if (doCheckIPHeader pk) then (pk ,0) else (pk ,-2) doCheckIPHeader :: Packet -> Bool doCheckIPHeader pk | ( pk!! 12 == 255) || ( pk!! 13 == 255) || ( pk!! 14 == 255) || ( pk!! 15 == 255) = False | ( pk!! 12 == 0 ) && ( pk!! 13 == 0 ) && ( pk!! 14 == 0 ) && ( pk!! 15 == 0) = False | otherwise = True ----------------- Copy target ip to target ip annotation position getIPAddress :: Event -> Event getIPAddress (pk,pto) = (dogetIPAddress pk,0) dogetIPAddress :: Packet -> Packet dogetIPAddress pk = out where fir = appf3 pk (\_->(pk !! 16) ) 25 sec = appf3 fir (\_->(pk !! 17) ) 26 thi = appf3 sec (\_->(pk !! 18) ) 27 out = appf3 thi (\_->(pk !! 19) ) 28 ----------------- Routing table in format type Patt_route = ( Ippatt, Mask, Gw, OutPort ) -- Write first more specific routes (mask greater) rtable = [ ([154,250,159,1],32,[127,0,0,1],0), ([154,250,159,0],24,[70,71,72,73],1), ([148,208,179,1],32,[127,0,0,1],0), ([148,208,179,0],24,[80,81,82,83],2), ([0,0,0,0],0,[90,91,92,93],2) ] ----------------- Element that implements routing table, needs event and routing table lookupIPRoute :: Event -> Event lookupIPRoute (pk, _) = doLookupIPRoute pk rtable doLookupIPRoute :: Packet -> [Patt_route]-> Event doLookupIPRoute pk (r:rs) | eth /= (-3) = (packet,eth) | otherwise = doLookupIPRoute pk rs where (packet,eth) = processPatt r pk 0 processPatt :: Patt_route -> Packet -> Int -> (Packet,Puerto) processPatt (ippat, mask, gw, eth ) pk n | mask == 0 = copy_ipt_toann pk eth gw | mask > 0 = if (ippat !! n) == (pk !! (begIpTarg_C+n)) then processPatt (ippat, (mask-8),gw,eth) pk (n+1) else (pk,-3) copy_ipt_toann :: Packet -> Int -> Gw -> (Packet ,Puerto) copy_ipt_toann pk eth gw | (eth>=0) && ((gw !! 0)/=(-1)) = (out,eth) | otherwise = (pk, eth) where fir = appf3 pk (\_->(gw !! 0) ) iptg_ann sec = appf3 fir (\_->(gw !! 1) ) (iptg_ann + 1) thi = appf3 sec (\_->(gw !! 2) ) (iptg_ann + 2) fou = appf3 thi (\_->(gw !! 3) ) (iptg_ann + 3) out = appf3 fou (\_-> eth ) outEth_ann ----------------- Drop packets marked with link level broadcast flag, fromDevice puts this flag dropBroadcasts :: Event->Event dropBroadcasts (pk,_) = (doDropBroadcasts pk ,0) doDropBroadcasts :: Packet -> Packet doDropBroadcasts pk | (pk !! llbIp_C ) == 0 = pk | otherwise = [-4] -------------- Detect if a packet go out by same ethernet card from imput, -- output error by second port if paintTee :: Event ->Int -> Event paintTee (pk, pto) arg | arg /= (pk !! canip_C) = (pk,0) | otherwise = (pk,1) ---------------- Create an ICMP packet notifying about error, receive type and error code RFC950 icmpError :: Event -> Ippatt -> Int -> Int-> Event icmpError (pk, pto) ipsrc typ code = (out,0) where pktyped = appf3 pk (\_->typ ) 20 pkcoded = appf3 pktyped (\_->code) 21 a = appf3 pkcoded (\_->(pk !! 12)) begIpTarg_C b = appf3 a (\_->(pk !! 13)) (begIpTarg_C + 1) c = appf3 b (\_->(pk !! 14)) (begIpTarg_C + 2) d = appf3 c (\_->(pk !! 15)) (begIpTarg_C + 3) e = appf3 d (\_->(ipsrc !! 0)) 12 f = appf3 e (\_->(ipsrc !! 1)) 13 g = appf3 f (\_->(ipsrc !! 2)) 14 h = appf3 g (\_->(ipsrc !! 3)) 15 i = appf3 h (\_->0) canip_C out = appf3 i (\_->1) fix_ip_ann ----------------- Run router options, don’t implemented in this case ipgwOptions ::Event-> Event ipgwOptions x = x ------------------ Put local ip source in one ICMP error packet fixIPSrc :: Event -> Ippatt -> Event fixIPSrc (pk,pto) ipsrc | (pk !! fix_ip_ann) == 1 = (out,0) | otherwise = (pk,0) where a = appf3 pk (\_->0) fix_ip_ann out = putIp pk ipsrc 12 0 putIp :: Packet->Ippatt->Int->Int->Packet putIp pk ip pos n | n < 4 = putIp (appf3 pk (\_->(ip !! n)) (pos + n)) ip pos (n+1) | otherwise = pk ----------------- Decrement TTL field, if expired output error ICMP packet at second port decIPTTL :: Event -> Event decIPTTL (pk,port) | (pk !! ttlip_C) > 1 = ( appf3 pk (\x->x-1) ttlip_C, 0) | otherwise = (pk,1) -------------- Verify the correct packet length, if not, delivery error ICMP packet at second port ipFragmenter :: Event-> Int ->Event ipFragmenter (pk,port) size | (length pk) <= size = (pk,0) | otherwise = (pk,1) ------------------ Implements Address Resolution Protocol, needs mapping table arpQuerier :: Event-> Ippatt -> Ethpatt ->[Patt_mapTable]-> Event arpQuerier (pk, _) iploc ethloc mapTable | (eth !! 0) == -5 = ((ethloc++[1,1,1,1,1,1]++[8,6]++ pk),1) | otherwise = ((ethloc++eth++[8,0]++pk),0) where eth = isIPinMapTable (extractIptgt pk begIpTarg_C 0) mapTable extractIptgt :: Packet -> Int ->Int-> Ippatt extractIptgt pk p n | n < 4 = (pk !! p) : extractIptgt pk (p+1) (n+1) | otherwise = [] isIPinMapTable:: Ippatt -> [Patt_mapTable]-> Ethpatt isIPinMapTable iptgt ((ipmap,eth):xs) | isIp ==1 = eth | otherwise = if xs/=[] then isIPinMapTable iptgt xs else [-5] where isIp = isIpEq iptgt ipmap 0 isIpEq :: Ippatt->Ippatt->Int->Int isIpEq (t:ts) (m:ms) n | n==3 = if t==m then 1 else 0 | otherwise = if t==m then isIpEq ts ms (n+1) else 0 ----------------- Implements an output Queue, receive a list Queue an return it modified queue :: Event-> [Packet] -> [Packet] queue (pk,port) q = pk :q ----------------- Unimplemented element arpResponder x = x ----------------- Unimplemented element toLinux x = x ----------------- Take packets from Queue toDevice :: [Packet] -> Event toDevice (x:xs) = ( x,0) --This section detail Click Router implementation in a multi-paradigm language: Curry ---------------CLICK ROUTER router:: Event -> Event router inp = routerInputBranch inp ----------------------------- Begin Input Branch 1 of Router ------------------------ routerInputBranch (pk,0) = out where stream1 = classifier (pk,0) out = routerClassifBranch stream1 ----------------------------- Begin Input Branch 2 of Router ------------------------ routerInputBranch (pk,1) = out where stream1 = classifier (pk,0) out = routerClassifBranch2 stream1 ---------------- Input Branch 1 of Router, from Ethernet card 1 ----------------- routerClassifBranch (pk,0) = arpResponder (pk,0) routerClassifBranch (pk,1) = arpQuerier (pk,1) [154,250,159,1] [1,5,9,0,0,1] mapTable1 routerClassifBranch (pk,2) = out where st1 = paint (pk,2) 1 st2 = strip st1 14 st3 = checkIPHeader st2 st4 = getIPAddress st3 st5 = lookupIPRoute st4 out = rtableBranch st5 ---------------- Input Branch 2 of Router, from Ethernet card 2 ----------------- routerClassifBranch2 (pk,0) = arpResponder (pk,0) routerClassifBranch2 (pk,1) = arpQuerier (pk,1) [148,208,179,1] [1,7,9,0,0,1] mapTable2 routerClassifBranch2 (pk,2) = out where st1 = paint (pk,2) 2 st2 = strip st1 14 st3 = checkIPHeader st2 st4 = getIPAddress st3 st5 = lookupIPRoute st4 out = rtableBranch st5 mapTable1 = [ ([154,250,159,2],[1,5,9,0,0,2]), ([154,250,159,3],[1,5,9,0,0,3]) ] mapTable2 = [ ([148,208,179,2],[1,7,9,0,0,2]), ([148,208,179,3],[1,7,9,0,0,3]) ] ------------------ Routing Engine Output, by port 0 To Linux ------------------- rtableBranch (pk,0) = toLinux (pk,0) ------------------- Routing Engine Output, by port 1 to Branch 1 ------------------ rtableBranch (pk,1) = out where st1 = dropBroadcasts (pk,1) st2 = paintTee st1 1 out = paintTeeBranch st2 ------------------- Routing Engine Output, by port 2 to Branch 2 ------------------ rtableBranch (pk,2) = out where st1 = dropBroadcasts (pk,2 st2 = paintTee st1 2 out = paintTeeBranch2 st2 ------------------------------ ROUTER OUTPUT BRANCH 1 ------------------------------ paintTeeBranch (pk,0) = out -- PaintTee branch 1, output branch 1 where st1 = ipgwOptions (pk,0) out = ipgwOptionsBranch st1 paintTeeBranch (pk,1) = out -- PaintTee branch 2, produce ICMP error where st1 = icmpError (pk,1) [154,250,159,1] 5 0 st2 = lookupIPRoute st1 out = rtableBranch st2 ipgwOptionsBranch (pk,0) = out -- IpgwOptions branch 1, output branch 1 where st1 = fixIPSrc (pk,0) [154,250,159,1] st2 = decIPTTL st1 out = decIPTTLBranch st2 ipgwOptionsBranch (pk,1) = out -- IpgwOptions branch 2, produce ICMP error where st1 = icmpError (pk,1) [154,250,159,1] 12 0 st2 = lookupIPRoute st1 out = rtableBranch st2 decIPTTLBranch (pk,0) = out -- DecIPTTL branch 1, output branch 1 where st1 = ipFragmenter (pk,0) 1500 out = ipFragmenterBranch st1 decIPTTLBranch (pk,1) = out -- DecIPTTL branch 2, produce ICMP error where st1 = icmpError (pk,1) [154,250,159,1] 11 0 st2 = lookupIPRoute st1 out = rtableBranch st2 ipFragmenterBranch (pk,0) = out -- IpFragmenter branch 1, output branch 1 where st1 = arpQuerier (pk,0) [154,250,159,1] [1,5,9,0,0,1] mapTable1 q = queue st1 [[]] out = toDevice q -- Bye packet! ipFragmenterBranch (pk,1) = out -- IpFragmenter branch 2, produce ICMP error where st1 = icmpError (pk,1) [154,250,159,1] 3 4 st2 = lookupIPRoute st1 out = rtableBranch st2 ------------------------------ ROUTER OUTPUT BRANCH 2 ------------------------------ paintTeeBranch2 (pk,0) = out -- PaintTee branch 1, output branch 2 where st1 = ipgwOptions (pk,0) out = ipgwOptionsBranch2 st1 paintTeeBranch2 (pk,1) = out -- PaintTee branch 2, produce ICMP error where st1 = icmpError (pk,1) [148,208,179,1] 5 0 st2 = lookupIPRoute st1 out = rtableBranch st2 ipgwOptionsBranch2 (pk,0) = out -- IpgwOptions branch 1, output branch 2 where st1 = fixIPSrc (pk,0) [148,208,179,1] st2 = decIPTTL st1 out = decIPTTLBranch2 st2 ipgwOptionsBranch2 (pk,1) = out -- IpgwOptions branch 2, produce ICMP error where st1 = icmpError (pk,1) [148,208,179,1] 12 0 st2 = lookupIPRoute st1 out = rtableBranch st2 decIPTTLBranch2 (pk,0) = out -- DecIPTTL branch 1, output branch 2 where st1 = ipFragmenter (pk,0) 1500 out = ipFragmenterBranch2 st1 decIPTTLBranch2 (pk,1) = out -- DecIPTTL branch 2, produce ICMP error where st1 = icmpError (pk,1) [148,208,179,1] 11 0 st2 = lookupIPRoute st1 out = rtableBranch st2 ipFragmenterBranch2 (pk,0) = out -- IpFragmenter branch 1, output branch 2 where st1 = arpQuerier (pk,0) [148,208,179,1] [1,7,9,0,0,1] mapTable2 q = queue st1 [[]] out = toDevice q -- Bye packet! ipFragmenterBranch2 (pk,1) = out -- IpFragmenter branch 2, produce ICMP error where st1 = icmpError (pk,1) [148,208,179,1] 3 4 st2 = lookupIPRoute st1 out = rtableBranch st2 --------------------------- Init Router function -------------------------------- approuter l = map (\x->router x) (infiniteSource l)