{-
A simple controller that responds to each packet-in message by
installing a flow rule to process the packet-in packet and similar packets
using the switch's Flood port. The rule is installed with a 5 second hard (and inactivity)
timeout so the rule should be removed by the switch after 5 seconds.
This controller uses the Nettle.Servers.Server module and forks a Haskell thread
for every connecting OpenFlow switch.
-}
import Nettle.Servers.Server
import Nettle.OpenFlow
import Control.Concurrent
import qualified Data.ByteString as B
import System.Environment
main :: IO ()
main =
do portNum <- getPortNumber
ofpServer <- startOpenFlowServer Nothing portNum
forever (do (switch,sfr) <- acceptSwitch ofpServer
forkIO (handleSwitch switch)
)
closeServer ofpServer
getPortNumber :: IO ServerPortNumber
getPortNumber
= do args <- getArgs
if length args < 1
then error "Requires one command-line argument specifying the server port number."
else return (read (args !! 0))
handleSwitch :: SwitchHandle -> IO ()
handleSwitch switch
= do untilNothing (receiveFromSwitch switch) (messageHandler switch)
closeSwitchHandle switch
messageHandler :: SwitchHandle -> (TransactionID, SCMessage) -> IO ()
messageHandler switch (xid, scmsg) =
case scmsg of
PacketIn pkt ->
case enclosedFrame pkt of
Left s -> putStrLn (s ++ ": " ++ show (B.unpack (packetData pkt)))
Right frame ->
let flowEntry = AddFlow { match = frameToExactMatch (receivedOnPort pkt) frame
, priority = 32768
, actions = [SendOutPort Flood]
, cookie = 0
, idleTimeOut = ExpireAfter 5
, hardTimeOut = ExpireAfter 5
, notifyWhenRemoved = False
, applyToPacket = bufferID pkt
, overlapAllowed = False
}
in sendToSwitch switch (xid, FlowMod flowEntry)
_ -> return ()