multi/0x01: add clear_flows API, make pattern args optional

Author: seliopou

async/Async_OpenFlow.mli

@@ -199,13 +199,29 @@ module OpenFlow0x01 : sig
     open OpenFlow0x01_Core
     open OpenFlow0x01_Stats
 
-    val clear_table : t -> Client_id.t -> (unit, exn) Deferred.Result.t
-    val send_flow_mods : ?clear:bool -> t -> Client_id.t -> flowMod list -> (unit, exn) Deferred.Result.t
+    val clear_flows
+      :  ?pattern:pattern -> t -> Client_id.t
+      -> (unit, exn) Deferred.Result.t
 
-    val send_pkt_out : t -> Client_id.t -> packetOut -> (unit, exn) Deferred.Result.t
-    val barrier : t -> Client_id.t -> (unit, exn) Result.t Deferred.t
-    val aggregate_stats : t -> Client_id.t -> pattern -> (aggregateStats, exn) Deferred.Result.t
-    val individual_stats : t -> Client_id.t -> pattern -> (individualStats list, exn) Deferred.Result.t
+    val send_flow_mods
+      :  ?clear:bool -> t -> Client_id.t -> flowMod list
+      -> (unit, exn) Deferred.Result.t
+
+    val send_pkt_out
+      :  t -> Client_id.t -> packetOut
+      -> (unit, exn) Deferred.Result.t
+
+    val barrier
+      :  t -> Client_id.t
+      -> (unit, exn) Result.t Deferred.t
+
+    val aggregate_stats
+      :  ?pattern:pattern -> t -> Client_id.t
+      -> (aggregateStats, exn) Deferred.Result.t
+
+    val individual_stats
+      :  ?pattern:pattern -> t -> Client_id.t
+      -> (individualStats list, exn) Deferred.Result.t
   end
 
 end

async/Async_OpenFlow0x01.ml

@@ -202,28 +202,28 @@ module Controller = struct
     let open ChunkController in
     listen_pipe t (run (handshake 0x01) t.sub (listen t.sub))
 
-  let clear_table (t : t) (sw_id : Client_id.t) =
-    send_result t sw_id (0l, M.FlowModMsg (C.delete_all_flows))
-
-  let send_flow_mods ?(clear=true) (t : t) (sw_id : Client_id.t) flow_mods =
-    begin if clear then clear_table t sw_id else return (Result.Ok ()) end
-    >>= function
-      | Result.Error exn -> return (Result.Error exn)
-      | Result.Ok () ->
-        let sends = List.map flow_mods
-          ~f:(fun f -> send_result t sw_id (0l, M.FlowModMsg f))
-        in
-        Deferred.Result.all_ignore sends
-
-  let send_pkt_out (t : t) (sw_id : Client_id.t) pkt_out =
+  let clear_flows ?(pattern=C.match_all) (t:t) (sw_id:Client_id.t) =
+    send_result t sw_id (0l, M.FlowModMsg
+      { C.delete_all_flows with C.pattern = pattern })
+
+  let send_flow_mods ?(clear=true) (t:t) (sw_id:Client_id.t) flow_mods =
+    let open Deferred.Result in
+    begin if clear then clear_flows t sw_id else return () end
+    >>= fun () ->
+      let sends = List.map flow_mods
+        ~f:(fun f -> send_result t sw_id (0l, M.FlowModMsg f))
+      in
+      all_ignore sends
+
+  let send_pkt_out (t:t) (sw_id:Client_id.t) pkt_out =
     send_result t sw_id (0l, M.PacketOutMsg pkt_out)
 
   let barrier t sw_id =
     send_txn_with t sw_id M.BarrierRequest (function
       | M.BarrierReply -> Result.Ok ()
       | _              -> assert false)
 
-  let aggregate_stats t sw_id pattern =
+  let aggregate_stats ?(pattern=C.match_all) (t:t) sw_id =
     let open OpenFlow0x01_Stats in
     let msg = AggregateRequest
       { as_of_match = pattern
@@ -234,7 +234,7 @@ module Controller = struct
       | M.StatsReplyMsg (AggregateFlowRep r) -> Result.Ok r
       | _                                    -> assert false)
 
-  let individual_stats t sw_id pattern =
+  let individual_stats ?(pattern=C.match_all) (t:t) sw_id =
     let open OpenFlow0x01_Stats in
     let msg = IndividualRequest
       { is_of_match = pattern

async/Async_SDN.ml

@@ -177,12 +177,17 @@ let switch_version (t : t) (sw_id : SDN.switchId) =
     end
   | Some _ -> 0x01
 
-let clear_flows (t : t) (pattern : SDN.Pattern.t) (sw_id : SDN.switchId) =
-  failwith "NYI: SDN.clear_flows"
+let clear_flows ?(pattern:SDN.Pattern.t option) (t:t) (sw_id:SDN.switchId) =
+  match switch_version t sw_id with
+  | 0x01 ->
+    let pattern = Option.map pattern ~f:SDN_OpenFlow0x01.from_pattern in
+    OF0x01_Controller.clear_flows ?pattern t.sub_0x01 sw_id
+  | 0x04
+  | _ -> failwith "Unsupported version"
 
 let clear_table (t : t) (sw_id : SDN.switchId) =
   match switch_version t sw_id with
-  | 0x01 -> OF0x01_Controller.clear_table t.sub_0x01 sw_id
+  | 0x01 -> OF0x01_Controller.clear_flows t.sub_0x01 sw_id
   | 0x04 -> OF0x04_Controller.clear_table t.sub_0x04 sw_id
   | _ -> failwith "Unsupported version"