Merge pull request #172 from frenetic-lang/mask-more-bugfix

    Fix bug in IP wildcarding.

Author: seliopou

lib/SDN_OpenFlow0x01.ml

@@ -2,7 +2,6 @@ module AL = SDN_Types
 module Core = OpenFlow0x01_Core
 module Msg = OpenFlow0x01.Message
 
-
 exception Invalid_port of int32
 
 let from_portId (pport_id : AL.portId) : Core.portId =
@@ -48,13 +47,23 @@ let from_pattern (pat : AL.Pattern.t) : Core.pattern =
       | None -> None)
   ; Core.dlVlanPcp = pat.AL.Pattern.dlVlanPcp
   ; Core.nwSrc = (match pat.AL.Pattern.nwSrc with
-    | None   -> None
-    | Some (p,m) -> let mo = if m = 32l then None else Some m in
-      Some { Core.m_value = p; Core.m_mask = mo })
+    | None -> None
+    | Some (p,m) ->
+       let mo =
+         if m = 32l then
+           None
+         else
+           Some (Int32.sub 32l m) in
+       Some { Core.m_value = p; Core.m_mask = mo })
   ; Core.nwDst = (match pat.AL.Pattern.nwDst with
-    | None   -> None
-    | Some (p,m) -> let mo = if m = 32l then None else Some m in
-      Some { Core.m_value = p; Core.m_mask = mo })
+    | None -> None
+    | Some (p,m) ->
+       let mo =
+         if m = 32l then
+           None
+         else
+           Some (Int32.sub 32l m) in
+       Some { Core.m_value = p; Core.m_mask = mo })
   ; Core.nwProto = pat.AL.Pattern.nwProto
   ; Core.nwTos = None
   ; Core.tpSrc = pat.AL.Pattern.tpSrc
@@ -82,11 +91,11 @@ module Common = HighLevelSwitch_common.Make (struct
       | AL.All ->
         (Mod.none, Output AllPorts)
       | AL.Physical pport_id ->
-        let pport_id = from_portId pport_id in
-        if Some pport_id = inPort then
-          (Mod.none, Output InPort)
-        else
-          (Mod.none, Output (PhysicalPort pport_id))
+         let pport_id = from_portId pport_id in
+         if Some pport_id = inPort then
+           (Mod.none, Output InPort)
+         else
+           (Mod.none, Output (PhysicalPort pport_id))
       | AL.Controller n -> 
         (Mod.none, Output (Controller n))
       | AL.Local ->
@@ -119,30 +128,34 @@ module Common = HighLevelSwitch_common.Make (struct
         end
       | AL.Modify (AL.SetVlanPcp pcp) ->
         (Mod.dlVlanPcp, SetDlVlanPcp(VInt.(get_int4 (Int4 pcp))))
-      | AL.Modify (AL.SetEthTyp _) -> raise (Invalid_argument "cannot set Ethernet type")
-      | AL.Modify (AL.SetIPProto _) -> raise (Invalid_argument "cannot set IP protocol")
+      | AL.Modify (AL.SetEthTyp _) ->
+         raise (Invalid_argument "cannot set Ethernet type")
+      | AL.Modify (AL.SetIPProto _) ->
+         raise (Invalid_argument "cannot set IP protocol")
       | AL.Modify (AL.SetIP4Src nwAddr) ->
         (Mod.nwSrc, SetNwSrc nwAddr)
       | AL.Modify (AL.SetIP4Dst nwAddr) ->
         (Mod.nwDst, SetNwDst nwAddr)
       | AL.Modify (AL.SetTCPSrcPort tp) ->
-        (Mod.tpSrc, SetTpSrc VInt.(get_int16 (Int16 tp)))
+         (Mod.tpSrc, SetTpSrc VInt.(get_int16 (Int16 tp)))
       | AL.Modify (AL.SetTCPDstPort tp) ->
         (Mod.tpDst, SetTpDst VInt.(get_int16 (Int16 tp)))
 end)
 
-let from_group (inPort : Core.portId option) (group : AL.group) : Core.action list =
+let from_group (inPort : Core.portId option) (group : AL.group)
+  : Core.action list =
   match group with
   | [] -> []
   | [par] -> Common.flatten_par inPort par
-  | _ -> raise (SDN_Types.Unsupported "OpenFlow 1.0 does not support fast-failover")
+  | _ ->
+     raise (SDN_Types.Unsupported "OpenFlow 1.0 does not support fast-failover")
 
 let from_timeout (timeout : AL.timeout) : Core.timeout =
   match timeout with
     | AL.Permanent -> Core.Permanent
     | AL.ExpiresAfter n -> Core.ExpiresAfter n
 
-let from_flow (priority : int) (flow : AL.flow) : Core.flowMod = 
+let from_flow (priority : int) (flow : AL.flow) : Core.flowMod =
   let open AL in
   match flow with
   | { pattern; action; cookie; idle_timeout; hard_timeout } ->