Merge pull request #177 from frenetic-lang/flowstats

implement flowstats translation between 0x01 and SDN

lib/OpenFlow0x01.ml

@@ -1713,49 +1713,30 @@ module StatsRequest = struct
     match msg with
     | DescriptionRequest -> sizeof_ofp_stats_request
     | FlowTableStatsRequest -> sizeof_ofp_stats_request
-    | IndividualRequest flow_req ->
-      marshal_flow_stats_request flow_req.is_of_match flow_req.is_out_port flow_req.is_table_id out'
-    | AggregateRequest agg_req ->
-      marshal_flow_stats_request agg_req.as_of_match agg_req.as_out_port agg_req.as_table_id out'
+    | IndividualRequest stats_req
+    | AggregateRequest  stats_req ->
+      marshal_flow_stats_request stats_req.sr_of_match stats_req.sr_out_port stats_req.sr_table_id out'
 
-  let parse_flow_stats_request bits =
-    let is_of_match = Match.parse (get_ofp_flow_stats_request_of_match bits) in
-    let is_table_id = get_ofp_flow_stats_request_table_id bits in
-    let is_out_port =
+  let parse_stats_request bits =
+    let sr_of_match = Match.parse (get_ofp_flow_stats_request_of_match bits) in
+    let sr_table_id = get_ofp_flow_stats_request_table_id bits in
+    let sr_out_port =
       (let open PseudoPort in
       if ofp_port_to_int OFPP_NONE = (get_ofp_flow_stats_request_out_port bits) then
         None
       else
         Some (PhysicalPort (get_ofp_flow_stats_request_out_port bits)))
     in
-    { is_of_match = is_of_match;
-      is_table_id = is_table_id;
-      is_out_port = is_out_port
-    }
+    { sr_of_match; sr_table_id; sr_out_port }
 
-  let parse_aggregate_stats_request bits =
-    let as_of_match = Match.parse (get_ofp_flow_stats_request_of_match bits) in
-    let as_table_id = get_ofp_flow_stats_request_table_id bits in
-    let as_out_port =
-      (let open PseudoPort in
-      if ofp_port_to_int OFPP_NONE = (get_ofp_flow_stats_request_out_port bits) then
-        None
-      else
-        Some (PhysicalPort (get_ofp_flow_stats_request_out_port bits)))
-    in
-    { as_of_match = as_of_match;
-      as_table_id = as_table_id;
-      as_out_port = as_out_port
-    }
-
   let parse bits =
     let stats_type_code = get_ofp_stats_request_req_type bits in
     let body = Cstruct.shift bits sizeof_ofp_stats_request in
     match int_to_ofp_stats_types stats_type_code with
     | Some OFPST_DESC -> DescriptionRequest
     | Some OFPST_TABLE -> FlowTableStatsRequest
-    | Some OFPST_FLOW -> IndividualRequest (parse_flow_stats_request body)
-    | Some OFPST_AGGREGATE -> AggregateRequest (parse_aggregate_stats_request body)
+    | Some OFPST_FLOW -> IndividualRequest (parse_stats_request body)
+    | Some OFPST_AGGREGATE -> AggregateRequest (parse_stats_request body)
     | Some OFPST_QUEUE -> raise (Unparsable "queue statistics unsupported")
     | Some OFPST_VENDOR -> raise (Unparsable "vendor statistics unsupported")
     | Some OFPST_PORT -> raise (Unparsable "port statistics unsupported")

lib/OpenFlow0x01_Stats.ml

@@ -1,23 +1,17 @@
 open Packet
 open OpenFlow0x01_Core
 
-type individualStatsReq =
-  { is_of_match : pattern
-  ; is_table_id : int8
-  ; is_out_port : pseudoPort option 
-  }
-
-type aggregateStatsReq =
-  { as_of_match : pattern
-  ; as_table_id : int8
-  ; as_out_port : pseudoPort option
+type statsReq =
+  { sr_of_match : pattern
+  ; sr_table_id : int8
+  ; sr_out_port : pseudoPort option
   }
 
 type request =
   | DescriptionRequest
   | FlowTableStatsRequest
-  | IndividualRequest of individualStatsReq
-  | AggregateRequest of aggregateStatsReq
+  | IndividualRequest of statsReq
+  | AggregateRequest of statsReq
 
 type descriptionStats =
     { manufacturer : string

lib/OpenFlow0x01_Stats.mli

@@ -7,25 +7,18 @@ open OpenFlow0x01_Core
     entries to have this as an output port.  Use table ID [0xFF] to
     read from all tables. *)
 
-(** The body of an individual flow stat request. *)
-type individualStatsReq =
-  { is_of_match : pattern
-  ; is_table_id : int8
-  ; is_out_port : pseudoPort option
-  }
-
-(** The body of an aggregate flow stat request. *)
-type aggregateStatsReq =
-  { as_of_match : pattern
-  ; as_table_id : int8
-  ; as_out_port : pseudoPort option
+(** The body of an individual or aggregate flow stat request. *)
+type statsReq =
+  { sr_of_match : pattern
+  ; sr_table_id : int8
+  ; sr_out_port : pseudoPort option
   }
 
 type request =
   | DescriptionRequest
   | FlowTableStatsRequest
-  | IndividualRequest of individualStatsReq
-  | AggregateRequest of aggregateStatsReq
+  | IndividualRequest of statsReq
+  | AggregateRequest of statsReq
 
   (** The body of a reply to a description request. *)
 type descriptionStats =

lib/SDN_OpenFlow0x01.ml

@@ -37,6 +37,90 @@ let to_packetIn (pktIn : Core.packetIn) : AL.pktIn =
     | { input_payload; total_len; port; reason } ->
       (to_payload input_payload, total_len, Int32.of_int port, to_reason reason)
 
+let to_pattern (p:Core.pattern) : SDN_Types.Pattern.t =
+  let open SDN_Types.Pattern in
+  { dlSrc = p.Core.dlSrc
+  ; dlDst = p.Core.dlDst
+  ; dlTyp = p.Core.dlTyp
+  ; dlVlan = begin match p.Core.dlVlan with
+      | None -> None
+      | Some None -> Some(0xffff)
+      | Some vlan -> vlan
+    end
+  ; dlVlanPcp = p.Core.dlVlanPcp
+  ; nwSrc = begin match p.Core.nwSrc with
+      | None -> None
+      | Some({ Core.m_value; Core.m_mask = None }) ->
+        Some(m_value, 0l)
+      | Some({ Core.m_value; Core.m_mask = Some(m) }) ->
+        Some(m_value, Int32.sub 32l m)
+    end
+  ; nwDst = begin match p.Core.nwDst with
+      | None -> None
+      | Some({ Core.m_value; Core.m_mask = None }) ->
+        Some(m_value, 0l)
+      | Some({ Core.m_value; Core.m_mask = Some(m) }) ->
+        Some(m_value, Int32.sub 32l m)
+    end
+  ; nwProto = p.Core.nwProto
+  ; tpSrc = p.Core.tpSrc
+  ; tpDst = p.Core.tpDst
+  ; inPort = match p.Core.inPort with
+      | None    -> None
+      | Some(n) -> Some(Int32.of_int n)
+  }
+
+let to_pseudoPort (in_port : Core.portId option) pport =
+  let open Core in
+  match pport with
+  | PhysicalPort port ->
+    if Some port = in_port
+      then AL.InPort
+      else AL.Physical (Int32.of_int port)
+  | InPort -> AL.InPort
+  | Table  -> AL.Table
+  | Normal -> AL.Normal
+  | Flood  -> AL.Flood
+  | AllPorts -> AL.All
+  | Controller(buf) -> AL.Controller(buf)
+  | Local -> AL.Local
+
+let to_action (in_port : Core.portId option) (act : Core.action) : AL.action =
+  let open Core in
+  match act with
+  | Output pport -> AL.Output (to_pseudoPort in_port pport)
+  | SetDlVlan dlVlan -> AL.(Modify(SetVlan dlVlan))
+  | SetDlVlanPcp dlVlanPcp -> AL.(Modify(SetVlanPcp dlVlanPcp))
+  | SetDlSrc dlAddr -> AL.(Modify(SetEthSrc dlAddr))
+  | SetDlDst dlAddr -> AL.(Modify(SetEthDst dlAddr))
+  | SetNwSrc nwAddr -> AL.(Modify(SetIP4Src nwAddr))
+  | SetNwDst nwAddr -> AL.(Modify(SetIP4Dst nwAddr))
+  | SetNwTos nwTos -> AL.(Modify(SetIPProto nwTos))
+  | SetTpSrc tpPort -> AL.(Modify(SetTCPDstPort tpPort))
+  | SetTpDst tpPort -> AL.(Modify(SetTCPSrcPort tpPort))
+  | Enqueue _ -> assert false (* XXX(seliopou) raise an exception. It's not
+      possible to implement this without changing the types in SDN_Types. *)
+
+let to_flowStats stats : SDN_Types.flowStats =
+  let open SDN_Types in
+  let open OpenFlow0x01_Stats in
+  let pattern = to_pattern stats.of_match in
+  let inPort = match pattern.Pattern.inPort with
+    | None -> None
+    | Some(x) -> Some(from_portId x)
+  in
+  { flow_table_id = stats.table_id
+  ; flow_pattern = pattern
+  ; flow_duration_sec = stats.duration_sec
+  ; flow_duration_nsec = stats.duration_nsec
+  ; flow_priority = stats.priority
+  ; flow_idle_timeout = stats.idle_timeout
+  ; flow_hard_timeout = stats.hard_timeout
+  ; flow_actions = List.map (to_action inPort) stats.actions
+  ; flow_packet_count = stats.packet_count
+  ; flow_byte_count = stats.byte_count
+  }
+
 let from_pattern (pat : AL.Pattern.t) : Core.pattern =
   { Core.dlSrc = pat.AL.Pattern.dlSrc
   ; Core.dlDst = pat.AL.Pattern.dlDst

lib/SDN_OpenFlow0x01.mli

@@ -1,9 +1,11 @@
 exception Invalid_port of int32
 
 val to_payload : OpenFlow0x01_Core.payload -> SDN_Types.payload
-val from_payload : SDN_Types.payload -> OpenFlow0x01_Core.payload
 val to_reason : OpenFlow0x01_Core.packetInReason -> SDN_Types.packetInReason
 val to_packetIn : OpenFlow0x01_Core.packetIn -> SDN_Types.pktIn
+val to_flowStats : OpenFlow0x01_Stats.individualStats -> SDN_Types.flowStats
+
+val from_payload : SDN_Types.payload -> OpenFlow0x01_Core.payload
 val from_packetOut : SDN_Types.pktOut -> OpenFlow0x01_Core.packetOut
 val from_pattern : SDN_Types.Pattern.t -> OpenFlow0x01_Core.pattern
 val from_group : OpenFlow0x01_Core.portId option -> SDN_Types.group -> OpenFlow0x01_Core.action list

lib/SDN_Types.ml

@@ -305,7 +305,7 @@ type flowStats = {
   flow_priority: int16;
   flow_idle_timeout: int16;
   flow_hard_timeout: int16;
-  flow_action: action;
+  flow_actions: action list;
   flow_packet_count: int64;
   flow_byte_count: int64
 }

lib/SDN_Types.mli

@@ -195,7 +195,7 @@ type flowStats = {
   flow_priority: int16;
   flow_idle_timeout: int16;
   flow_hard_timeout: int16;
-  flow_action: action;
+  flow_actions: action list;
   flow_packet_count: int64;
   flow_byte_count: int64
 }