multi: finish basic API for 0x04

Missing query apis.

Author: seliopou

async/Async_OpenFlow.mli

@@ -242,11 +242,25 @@ module OpenFlow0x04 : sig
 
     open OpenFlow0x04_Core
 
-    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:oxmMatch -> t -> Client_id.t
+      -> (unit, exn) Deferred.Result.t
+
+    val clear_groups
+      :  ?pattern:(groupType * groupId) -> 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 send_pkt_out
+      :  t -> Client_id.t -> packetOut
+      -> (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 barrier
+      :  t -> Client_id.t
+      -> (unit, exn) Result.t Deferred.t
   end
 
 end
@@ -275,18 +289,19 @@ module SDN : sig
 
   val listen : t -> e Pipe.Reader.t
 
-  (* val clear_flows : t -> Pattern.t -> switchId -> (unit, exn) Deferred.Result.t *)
-  val clear_table : t -> switchId -> (unit, exn) Deferred.Result.t
+  val clear_flows
+    :  ?pattern:Pattern.t -> t -> switchId
+    -> (unit, exn) Deferred.Result.t
 
   val install_flows
-    :  ?clear:bool
-    -> t
-    -> switchId
-    -> flow list
+    :  ?clear:bool -> t -> switchId -> flow list
     -> (unit, exn) Deferred.Result.t
 
-  val send_pkt_out : t -> switchId -> pktOut -> (unit, exn) Deferred.Result.t
-
-  val barrier : t -> switchId -> (unit, exn) Deferred.Result.t
+  val send_pkt_out
+    :  t -> switchId -> pktOut
+    -> (unit, exn) Deferred.Result.t
 
+  val barrier
+    :  t -> switchId
+    -> (unit, exn) Result.t Deferred.t
 end

async/Async_OpenFlow0x04.ml

@@ -233,20 +233,22 @@ module Controller = struct
     let open ChunkController in
     listen_pipe t (run (handshake 0x04) t.sub (listen t.sub))
 
-  let clear_table (t : t) (sw_id : Client_id.t) =
-    let flows = send_result t sw_id (0l, M.FlowModMsg C.delete_all_flows) in
-    let groups = send_result t sw_id (0l, M.GroupModMsg C.delete_all_groups) in
-    Deferred.Result.all_ignore [flows; groups]
+  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.mfOfp_match = pattern })
+
+  let clear_groups ?(pattern=C.(All,0xfffffffcl)) (t:t) (sw_id:Client_id.t) =
+    let typ, id = pattern in
+    send_result t sw_id (0l, M.GroupModMsg (C.DeleteGroup(typ, id)))
 
   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 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)

async/Async_SDN.ml

@@ -21,9 +21,9 @@ type t =
   }
 
 type e = [
-  | `Connect of SDN.switchId * SDN.switchFeatures
+  | `Connect    of SDN.switchId * SDN.switchFeatures
   | `Disconnect of SDN.switchId * Sexp.t
-  | `PacketIn of SDN.switchId * SDN.pktIn
+  | `PacketIn   of SDN.switchId * SDN.pktIn
   | `PortUp     of SDN.switchId * SDN.portId
   | `PortDown   of SDN.switchId * SDN.portId ]
 
@@ -71,7 +71,9 @@ let listen_of0x01 (t : t) : Chunk_Controller.h Pipe.Writer.t * e Pipe.Reader.t =
         | `Connect(sw_id, fs) ->
           let sdn_fs =
             { SDN.switch_id = sw_id
-            ; SDN.switch_ports = List.filter_map fs.OF.SwitchFeatures.ports ~f:get_port }
+            ; SDN.switch_ports = List.filter_map fs.OF.SwitchFeatures.ports
+                ~f:get_port
+            }
           in
           Some(`Connect(sw_id, sdn_fs))
         | `Disconnect(sw_id, exn) ->
@@ -165,7 +167,7 @@ let listen (t : t) : e Pipe.Reader.t =
     match version with
     | 0x01 -> Pipe.write of0x01_w e
     | 0x04 -> Pipe.write of0x04_w e
-    | _    -> failwith "Unsupported version"));
+    | v -> failwith Printf.(sprintf "SDN.listen: unsupported version: %d" v)));
   Pipe.interleave [of0x01_r; of0x04_r]
 
 let switch_version (t : t) (sw_id : SDN.switchId) =
@@ -182,14 +184,13 @@ let clear_flows ?(pattern:SDN.Pattern.t option) (t:t) (sw_id:SDN.switchId) =
   | 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_flows t.sub_0x01 sw_id
-  | 0x04 -> OF0x04_Controller.clear_table t.sub_0x04 sw_id
-  | _ -> failwith "Unsupported version"
+  | 0x04 ->
+    let pattern = match Option.map pattern ~f:SDN_OpenFlow0x04.from_pattern with
+    | Some(pattern, _) -> Some(pattern)
+    | None             -> None
+    in
+    OF0x04_Controller.clear_flows ?pattern t.sub_0x04 sw_id
+  | v -> failwith Printf.(sprintf "SDN.clear_flows: unsupported version: %d" v)
 
 let install_flows ?(clear=true) (t : t) (sw_id : SDN.switchId) flows =
   let priority = ref 65536 in
@@ -203,21 +204,22 @@ let install_flows ?(clear=true) (t : t) (sw_id : SDN.switchId) flows =
     let f flow = decr priority; SDN_OpenFlow0x04.from_flow groups !priority flow in
     let flow_mods = List.map flows ~f in
     let open Deferred.Result in
+    OF0x04_Controller.clear_groups t.sub_0x04 sw_id >>= fun () ->
     OF0x04_Controller.send_flow_mods ~clear t.sub_0x04 sw_id flow_mods >>= fun () ->
     let f group = OF0x04_Controller.send_result t.sub_0x04 sw_id (0l, group) in
     Deferred.Result.all_ignore (List.map (GroupTable0x04.commit groups) ~f)
-  | _ -> failwith "Unsupported version"
+  | v -> failwith Printf.(sprintf "SDN.install_flows: unsupported version: %d" v)
 
 let send_pkt_out (t : t) (sw_id : SDN.switchId) (pkt_out : SDN.pktOut) =
   match switch_version t sw_id with
   | 0x01 -> OF0x01_Controller.send_pkt_out t.sub_0x01 sw_id
       (SDN_OpenFlow0x01.from_packetOut pkt_out)
   | 0x04 -> OF0x04_Controller.send_pkt_out t.sub_0x04 sw_id
       (SDN_OpenFlow0x04.from_packetOut pkt_out)
-  | _ -> failwith "Unsupported version"
+  | v -> failwith Printf.(sprintf "SDN.send_pkt_out: unsupported version: %d" v)
 
 let barrier (t : t) (sw_id : SDN.switchId) =
   match switch_version t sw_id with
   | 0x01 -> OF0x01_Controller.barrier t.sub_0x01 sw_id
   | 0x04 -> OF0x04_Controller.barrier t.sub_0x04 sw_id
-  | _ -> failwith "Unsupported version"
+  | v -> failwith Printf.(sprintf "SDN.barrier: unsupported version: %d" v)