-- | This module provides facilities for easily creating Netkit (<http://wiki.netkit.org/index.php/Main_Page>) labs -- to experiment with OpenFlow switches and controllers. -- This module provides a notation for describing simple -- OpenFlow-based network topologies, and provides a command-- that generates a NetKit lab that can be used to simulate the-- network.---- To use this module, describe the configuration of your test network, including-- hosts, switches and their interconnectivity using the functions in this module (see the example below), -- and then run one of the @makeLab@ commands to generate the Netkit files needed to run the lab.-- You can then move into the directory containing the Netkit lab and start the lab using Netkit commands -- (e.g. @lstart@).-- The generated lab will include hosts and switches, but not a controller. -- The lab will setup a TAP interface with subnet 10.0.0.0/8 from the switch virtual machines to the host on which you started the lab, -- and the switches will attempt to contact a controller with IP address 10.0.0.1 over that TAP interface, at the server port mentioned in the lab.-- You can then control the switches by starting a controller on the host at the specified port. See the example below for more details.-- -- The generated lab is designed to work with a customized netkit file system that -- has OpenFlow software in a particular location. Instructions for obtaining this file-- system are here <http://haskell.cs.yale.edu/?page_id=383>; see the last instruction in the section on Installing on Your Own Machine. -- The generator (i.e. @makeLab@) must know the location of this file in order to generate the Netkit lab files. -- The default options assume the files are in the user's @~/.nettle@ directory, but they can be placed in other locations as well. -- If they are in another location, then the Lab options must be set appropriately. moduleNettle.Netkit.LabUtil(-- * Lab descriptionsLabConfig(..),Options(..),OpenFlowVersion(..),ControllerTCPPort,Switch(..),Host(..),Port(..),Interface(..),SwitchPort(..),switch,host,port,(#),(<-->),(@@)-- * Generating labs,makeLab,makeLabWithDefaults,getDefaultOptions-- * Example-- $doc-example -- * Limitations-- $doc-limitations )whereimportNettle.OpenFlow.Switch(SwitchID)importNettle.OpenFlow.Porthiding(Port)importNettle.IPv4.IPAddressimportData.List(nub,elemIndex,find,union,sort,(\\),minimumBy)importSystem.Directory(createDirectory,createDirectoryIfMissing,getHomeDirectory,canonicalizePath)importControl.Monad.StateimportData.Maybe(fromJust)importData.BitsimportData.Map(Map)importqualifiedData.MapasMapimportSystem.FilePathimportSystem.Posix.FilesimportSystem.Posix.TypesimportData.Set(Set)importqualifiedData.SetasSetimportNettle.Netkit.UnionFindnewtypeSwitch=SwitchSwitchIDderiving(Show,Eq,Ord)dataHost=Host{hostID::Int}deriving(Show,Eq,Ord)dataInterface=Interface{interfaceID::Int,interfaceIPAddress::IPAddress}deriving(Show,Eq,Ord)newtypePort=PortPortIDderiving(Show,Eq,Ord)typeSwitchPort=(Switch,Port)typeControllerTCPPort=Intswitch::SwitchID->Switchswitchn=Switchnhost::Int->Hosthostn=Hostnport::PortID->Portportn=PortndataLabConfig=LabConfig{switches::[Switch]-- ^ Switches for this lab,controllerServerPort::ControllerTCPPort-- ^ The TCP port number at which the controller will listen for switch connections,hosts::[((Host,Interface),SwitchPort)]-- ^ A description of where the host interfaces are attached to switches in the network,links::[(SwitchPort,SwitchPort)]-- ^ A description of how switches are connected}deriving(Show,Eq)-- | A datatype for specifying lab options, including the paths to the kernel and filesystem-- used by netkit machines, as well as the OpenFlow version of the reference switch software.dataOptions=Options{pathToKernel,pathToFileSystem::MaybeString,openFlowVersion::OpenFlowVersion}deriving(Show,Eq)-- | An enumerated data type representing OpenFlow versions supported by -- this module.dataOpenFlowVersion=Ver0_9_0|Ver1_0_0deriving(Eq,Show,Ord,Enum)getDefaultOptions::OpenFlowVersion->IOOptionsgetDefaultOptionsversion=dohome<-getHomeDirectoryreturn(Options{pathToKernel=Nothing,pathToFileSystem=Just(fsdirhome),openFlowVersion=version})wherefsdirbase=base</>".nettle"</>"netkit"</>"netkit-filesystem-i386-F5.1_2010-11-19"</>"netkit-fs"infix8#infix7@@,<-->-- | Denotes a SwitchPort, i.e. a port on a switch.(#)::Switch->Port->SwitchPort(#)sp=(s,p)-- | Denotes where a host is attached to the network of switches.(@@)::(Host,Interface)->SwitchPort->((Host,Interface),SwitchPort)h@@sp=(h,sp)-- | Denotes a link (switch-to-switch) connection. (<-->)::SwitchPort->SwitchPort->(SwitchPort,SwitchPort)(<-->)ab=(a,b)-- | @makeLabWithDefaults path options lab@ is a command that writes the files and-- directories needed to run a Netkit lab that implements the description provided by @lab@. -- It writes the files to directory @path@, and the options are specified by @options@.makeLab::FilePath->Options->LabConfig->IO()makeLabpathoptionslab=dopath'<-canonicalizePathpathlayout<-lab2NetkitLayoutpath'optionslabmakeNetkitLayoutpath'layout-- | @makeLabWithDefaults path version lab@ is a command that writes the files and-- directories needed to run a Netkit lab that implements the description provided by @lab@. -- It writes the files to directory @path@, and the switches will run the OpenFlow reference-- switch software for OpenFlow version @version@.makeLabWithDefaults::FilePath->OpenFlowVersion->LabConfig->IO()makeLabWithDefaultspathversionlab=dooptions<-getDefaultOptionsversionmakeLabpathoptionslab-- Supporting functions and types...-- A value of type NetkitLayout represents the -- directories and files that need to be created-- for a lab.dataNetkitLayout=NetkitLab{dirs::[FilePath],files::[(FilePath,String,MaybeFileMode)]}deriving(Show,Read,Eq)-- Makes the directories and files described in a NetkitLayout value.makeNetkitLayout::FilePath->NetkitLayout->IO()makeNetkitLayoutpathlabLayout=docreateDirectoryIfMissingTruepathsequence_[createDirectoryd|d<-dirslabLayout]sequence_[createDirectoryIfMissingTrueparent>>writeFilefs>>casemof{Nothing->return();Justmode->setFileModefmode}|(f,s,m)<-fileslabLayout,let(parent,fname)=splitFileNamef]-- Returns a list of all switches explicitly mentioned-- in a configuration.switches'::LabConfig->[Switch]switches'c=nub([sw|(_,(sw,_))<-hostsc]++[sw|((sw,_),_)<-linksc]++[sw|(_,(sw,_))<-linksc]++switchesc)uniqueHosts::LabConfig->[Host]uniqueHosts=nub.map(fst.fst).hostscounts::Eqa=>[a]->[(a,Int)]countsxs=[(x,length(filter(==x)xs))|x<-nubxs]lab2NetkitLayout::FilePath->Options->LabConfig->IONetkitLayoutlab2NetkitLayoutlabdiroptionsconf|not(nulloccMoreThanOnce)=error("The following host IDs are used more than once for different hosts: "++showoccMoreThanOnce)|otherwise=dofsPath<-maybe(returnNothing)(return.Just<=<canonicalizePath)(pathToFileSystemoptions)kerPath<-maybe(returnNothing)(return.Just<=<canonicalizePath)(pathToKerneloptions)return$NetkitLabdirs(map(\(fn,cont,m)->(labdir</>fn,cont,m))(filesfsPathkerPath))whereoccMoreThanOnce=[hid|(hid,cnt)<-counts[hostIDh|h<-uniqueHostsconf],cnt>1]dirs=[labdir</>d|d<-(dirsForSwitches++dirsForHosts)]dirsForSwitches=[switchNames|s<-sws]dirsForHosts=[hostNameh|h<-uniqueHostsconf]filesfsPathkerPath=[labConfFilefsPathkerPath]++map(hostStartupFileconf.fst.fst)hostConns++mapswitchStartupFileswitchControlConfig++concatMap(switchScriptsconfoptionsswitchControlConfig)swslabConfFilefsPathkerPath=("lab.conf",makeLabConfContentsconffsPathkerPath,Nothing)switchControlConfig=configToSwitchControlConfigsconfsws=switches'confhostConns=hostsconfswConns=linksconf{- Scripts that should be available at the switches. -}switchScriptsconfoptionsswitchControlConfigsw=[(switchNamesw++"/startSwitch.sh",startSwitchContents,Justmode),(switchNamesw++"/startProtocol.sh",startProtocolContents,Justmode),(switchNamesw++"/etc/modprobe.d/blacklist",blacklistContents,Justmode),(switchNamesw++"/root/.profile","export PATH=$PATH:"++ofpBinDirversion,Justmode)]wherestartSwitchContents=makeScriptFile(ofdatapathCommandversionsw["eth"++showp|Portp<-portssw])startProtocolContents=makeScriptFile(ofprotocolCommandversioncontrollerAddressForSwitchcontrollerTCPPort)blacklistContents=unlines["blacklist net-pf-10","blacklist ipv6"]portssw=sort$fillMissingPorts$connectedPortsconfswcontrollerAddressForSwitch=let(_,_,_,addr)=fromJust$find(\(sw',_,_,_)->sw==sw')switchControlConfiginaddrmode=ownerModes`unionFileModes`groupModescontrollerTCPPort=controllerServerPortconfsws=switches'confhostConns=hostsconfswConns=linksconfversion=openFlowVersionoptionsfillMissingPorts::[Port]->[Port]fillMissingPortsps=ps`union`[Porti|i<-[1..maximumpnums]]wherepnums=[pnum|Portpnum<-ps]makeScriptFilecmd="#!/bin/bash\n\n"++cmd++"\n"ofpBinDir::OpenFlowVersion->FilePathofpBinDirVer0_9_0="/root/local/openflow-0.9.0/bin"ofpBinDirVer1_0_0="/root/local/openflow-1.0.0/bin"ofdatapathCommandversion(Switchdpid)ifaces=ofdatapathPathversion++" -i "++concat(sepBy","ifaces)++" punix:ofconnfile -d "++showDataPathIDdpid++" --no-local-port "++ifversion==Ver1_0_0then"--no-slicing"else""++";"ofdatapathPathversion=ofpBinDirversion</>"ofdatapath"ofprotocolCommandversioncaddrcport=ofprotocolPathversion++" unix:ofconnfile tcp:"++showOctetscaddr++":"++showcport++" -v -Fclosed"ofprotocolPathversion=ofpBinDirversion</>"ofprotocol"showDataPathID::SwitchID->StringshowDataPathIDn=replicate(totalLen-l)'0'++digswherel=lengthdigstotalLen=12digs=hexDigits(fromIntegraln)hexDigits::Int->[Char]hexDigits=reverse.map(intToHexDigit.(`mod`base)).takeWhile(>0).iterate(`div`base)wherebase=16intToHexDigit::Int->CharintToHexDigitn|n>=0&&n<10=head$shown|n==10='a'|n==11='b'|n==12='c'|n==13='d'|n==14='e'|n==15='f'sepBy_[]=[]sepBy_[x]=[x]sepBys(x:xs)=x:s:sepBysxs{- Start-up file for switches -}switchStartupFile::(Switch,Port,IPAddress,IPAddress)->(FilePath,String,MaybeFileMode)switchStartupFile(sw,Portnic,_,_)=(switchNamesw++".startup",contents,Nothing)wherecontents=line(defaultRouteCommandcontrolInterface)++startSwitchCommands++startProtocolCommandscontrolInterface="eth"++shownicstartSwitchCommands=line"chmod +x /startSwitch.sh"++line"screen -S startSwitch -d -m /startSwitch.sh "startProtocolCommands=line"chmod +x /startProtocol.sh"++line"screen -S startProtocol -d -m /startProtocol.sh "line::String->Stringlines=s++"\n"{- Start-up file for hosts -}-- hostStartupFile :: LabConfig -> Host -> hostStartupFilelabh=(hostNameh++".startup",contents,Nothing)wherecontents=concat[line(ifConfigCommand'(iNamei)(showOctets(interfaceIPAddressi))"255.255.255.0")|i<-ints]++line(defaultRouteCommand$iName$minimumBy(\ab->compare(interfaceIDa)(interfaceIDb))ints)h'=fromIntegral(hostIDh)iNamei="eth"++show(interfaceIDi)ints=hostInterfaceslabhhostInterfaces::LabConfig->Host->[Interface]hostInterfaceslabhost=[i|((host',i),_)<-hostslab,host'==host]defaultRouteCommandinterfaceName="route add default "++interfaceName{-
-- interfaceName = "eth0"
-- line (ifConfigCommand interfaceName (showOctets (ipAddress 11 1 h' 5)) "255.255.255.0" (showOctets (ipAddress 11 1 h' 11)))
-}ifConfigCommandifaceNameaddressmaskbcastAddress="ifconfig "++ifaceName++" "++address++" netmask "++mask++" broadcast "++bcastAddress++" up"ifConfigCommand'ifaceNameaddressmask="ifconfig "++ifaceName++" "++address++" netmask "++mask++" up"{- Function to make the lab.conf file -}makeLabConfContents::LabConfig->MaybeFilePath->MaybeFilePath->StringmakeLabConfContentsconffsPathkerPath=output$execState(labConfContentsconffsPathkerPath)initStatewhereinitState=ConfWriterState{output=""}typeConfWritera=StateConfWriterStateadataConfWriterState=ConfWriterState{output::String}deriving(Show,Eq)addLine::String->ConfWriter()addLines=modify(\state->state{output=outputstate++lines})labConfContents::LabConfig->MaybeFilePath->MaybeFilePath->ConfWriter()labConfContentslabfsPathkerPath=domapM_addHostSwitchConnectionLineshostConnsaddSwitchInterfacesmapM_addSwitchControllerLine(configToSwitchControlConfigslab)addKernelAndFSOptionssetMemoryParamswheresetMemoryParams=dosequence_[addLine(confLine(hostNameh)"mem""512")|h<-uniqueHostslab]addKernelAndFSOptions=letfname=domaybe(return())(addLine.confLinename"model-fs")fsPathmaybe(return())(addLine.confLinename"kernel")kerPathindosequence_[f(hostNameh)|h<-uniqueHostslab]sequence_[f(switchNamesw)|sw<-sws]addSwitchInterfaces=sequence_[addLine(confLine(switchNamesw)(showp)[label])|((sw,Portp),label)<-Map.assocsspLabels]addHostSwitchConnectionLines((h,i),(s,Portp))=doletlabel=spLabels(Portp)addLine(confLine(hostNameh)(show(interfaceIDi))[label])addSwitchControllerLine(sw,Portnic,nicIP,controlIP)=doletSwitchs=swletswitchIPAddress=showOctetsnicIPletcontrolIPAddress=showOctetscontrolIPletc="tap,"++controlIPAddress++","++switchIPAddressaddLine(confLine(switchNamesw)(shownic)c)confLinemachineNameparamNamevalue=machineName++"["++paramName++"]="++valuesws=switches'labhostConns=hostslabswConns=linkslabspLabels=labelledPartslabspLabelswp=Map.findWithDefault(error("unknown (switch,port): "++show(sw,p)))(sw,p)spLabelsunConnectedInterfaces::LabConfig->[(Switch,Port)]unConnectedInterfaceslab=[(sw,p)|sw<-switches'lab,p<-unConnectedPortslabsw]allSwitchPorts::LabConfig->[(Switch,Port)]allSwitchPortslab=[(sw,port)|sw<-switches'lab,port<-connectedPortslabsw]++[(sw,port)|sw<-switches'lab,port<-unConnectedPortslabsw]labelledParts::LabConfig->Map(Switch,Port)CharlabelledPartslab=Map.fromListkeyValswherestartRel=linkslab++[(sif,sif)|(_,sif)<-hostslab]partCharPairs=zip(Set.elems(finestPartitionstartRel))['a','b'..'z']keyVals=[(sp,c)|(spSet,c)<-partCharPairs,sp<-Set.elemsspSet]typeLabel=StringconnectedPorts::LabConfig->Switch->[Port]connectedPortslabsw=nub([p|(_,(sw',p))<-hostslab,sw==sw']++[p|((sw',p),_)<-linkslab,sw==sw']++[p|(_,(sw',p))<-linkslab,sw==sw'])unConnectedPorts::LabConfig->Switch->[Port]unConnectedPortslabsw=[Porti|i<-[1..maximumpnums]]\\pswherepnums=[pnum|Portpnum<-ps]ps=connectedPortslabswswitchName::Switch->StringswitchName(Switchs)="switch"++showshostName::Host->StringhostNameh="host"++show(hostIDh)typeSwitchControlConfig=[(Switch,Port,IPAddress,IPAddress)]configToSwitchControlConfigs::LabConfig->SwitchControlConfigconfigToSwitchControlConfigsconf=[(sw,switchSidePortsw,switchSideAddress(fromIntegralswnum),controlSideAddress(fromIntegralswnum))|sw@(Switchswnum)<-sws]whereswitchSideAddresssw=ipAddress1000(1+sw)controlSideAddresssw=ipAddress10001switchSidePortsw=port$maximum[p|Portp<-portsUsedsw]+1portsUsedsw=[p|(h,(sw',p))<-hostConns,sw==sw']++[p|((sw',p),_)<-swConns,sw==sw']++[p|(_,(sw',p))<-swConns,sw==sw']sws=switches'confhostConns=hostsconfswConns=linksconf-- $doc-example -- Below is an example lab config, describing a network with -- 3 switches, each connected to the other two and 3 hosts (one per switch).-- The switches will attempt have one interface associated with a TAP interface on the -- host system. This TAP interface has subnet 10.0.0.0/8 and the controller is assumed to -- be running at 10.0.0.1. In this example, the controller should be running at TCP -- port 2525, so that the switches will find it. -- -- > lab :: LabConfig-- > lab = LabConfig { controllerServerPort = 2525, -- > switches = [sw1, sw2, sw3], -- > hosts = [ (host 1, Interface 0 (ipAddress 11 1 1 5)) @@ (sw1 # port 1), -- > (host 2, Interface 0 (ipAddress 11 1 2 5)) @@ (sw2 # port 1), -- > (host 3, Interface 0 (ipAddress 11 1 3 5)) @@ (sw3 # port 1) ], -- > links = [sw1 # port 2 <--> sw2 # port 2, -- > sw1 # port 3 <--> sw3 # port 2,-- > sw2 # port 3 <--> sw3 # port 3 ] -- > }-- > where sw1 = switch 1-- > sw2 = switch 2-- > sw3 = switch 3 ---- The lab can be generated and written to directory \/foo\/bar by running the following command (the target directory may need to be created before running this command):---- > makeLabWithDefaults "/foo/bar" Ver1_0_0 lab---- The switches will have two files (both in the root directory), @startProtocol.sh@, @startSwitch.sh@ -- which run the ofprotocol and ofdatapath programs, respectively, with the correct-- parameters for the switch and controller. The switches will run these scripts at start up time.-- These scripts are run with @screen@, and you can reattach to them using @screen@. To see-- the screen session names, run @screen -list@ from one of the switch terminals.-- $doc-limitations-- The library currently has several limitations: -- * Each host interface is on a /24 subnet containing its IP address. This should be configurable.-- * The controller is assumed to be at 10.0.0.1. This should be configurable.