multi: expose functions for message types

Rather than exposing low-level operations to send messages and deal with
xids, provide an async-based fucntion interface for dealing with those
methods. Currently suppor send_pkt_out and barrier.

Author: seliopou

async/Async_OpenFlow.mli

@@ -189,11 +189,11 @@ module OpenFlow0x01 : sig
     include Platform.CTL
       with type t := t
 
-    val send_txn
-      :  t
-      -> Client_id.t
-      -> OpenFlow0x01.Message.t
-      -> [ `Sent of Message.t Ivar.t | `Drop of exn ] Deferred.t
+    (* val clear_flows : t -> SDN.Pattern.t -> Client_id.t -> (unit, exn) Deferred.Result.t *)
+    val clear_table : t -> Client_id.t -> (unit, exn) Deferred.Result.t
+
+    val send_pkt_out : t -> Client_id.t -> OpenFlow0x01_Core.packetOut -> (unit, exn) Deferred.Result.t
+    val barrier : t -> Client_id.t -> (unit, exn) Result.t Deferred.t
   end
 
 end
@@ -212,11 +212,13 @@ module OpenFlow0x04 : sig
     include Platform.CTL
       with type t := t
 
-    val send_txn
-      :  t
-      -> Client_id.t
-      -> OpenFlow0x04.Message.t
-      -> [ `Sent of Message.t Ivar.t | `Drop of exn ] Deferred.t
+
+    (* val clear_flows : t -> Pattern.t -> Client_id.t -> (unit, exn) Deferred.Result.t *)
+    val clear_table : t -> Client_id.t -> (unit, exn) Deferred.Result.t
+
+    val send_pkt_out : t -> Client_id.t -> OpenFlow0x04_Core.packetOut -> (unit, exn) Deferred.Result.t
+    val barrier : t -> Client_id.t -> (unit, exn) Result.t Deferred.t
+
   end
 
 end
@@ -245,13 +247,18 @@ module SDN : sig
 
   val listen : t -> e Pipe.Reader.t
 
-  val clear_table : t -> switchId -> (unit, exn) Result.t Deferred.t
+  (* val clear_flows : t -> Pattern.t -> switchId -> (unit, exn) Deferred.Result.t *)
+  val clear_table : t -> switchId -> (unit, exn) Deferred.Result.t
 
   val install_flows
     :  ?clear:bool
     -> t
     -> switchId
     -> flow list
-    -> (unit, exn) Result.t Deferred.t
+    -> (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
 
 end

async/Async_OpenFlow0x01.ml

@@ -193,6 +193,9 @@ module Controller = struct
     let open ChunkController in
     listen_pipe t (run (handshake 0x01) t.sub (listen t.sub))
 
+  let clear_flows (t : t) (pattern : SDN_Types.Pattern.t) (sw_id : Client_id.t) =
+    failwith "NYI: OF0x01.clear_flows"
+
   let clear_table (t : t) (sw_id : Client_id.t) =
     send_result t sw_id (0l, M.FlowModMsg (C.delete_all_flows))
 
@@ -205,4 +208,20 @@ module Controller = struct
           ~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 =
+    send_result t sw_id (0l, M.PacketOutMsg pkt_out)
+
+  let barrier t sw_id =
+    try begin
+      send_txn t sw_id M.BarrierRequest
+      >>= function
+        | `Sent ivar -> begin Ivar.read ivar
+          >>| function
+            | M.BarrierReply -> Result.Ok ()
+            | _              -> assert false
+          end
+        | `Drop exn  -> return (Result.Error exn)
+    end with Not_found -> return (Result.Error Not_found)
+
 end

async/Async_OpenFlow0x04.ml

@@ -225,6 +225,9 @@ module Controller = struct
     let open ChunkController in
     listen_pipe t (run (handshake 0x04) t.sub (listen t.sub))
 
+  let clear_flows (t : t) (pattern : SDN_Types.Pattern.t) (sw_id : Client_id.t) =
+    failwith "NYI: OF0x04.clear_flows"
+
   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
@@ -240,4 +243,19 @@ module Controller = struct
         in
         Deferred.Result.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 =
+    try begin
+      send_txn t sw_id M.BarrierRequest
+      >>= function
+        | `Sent ivar -> begin Ivar.read ivar
+          >>| function
+            | M.BarrierReply -> Result.Ok ()
+            | _              -> assert false
+          end
+        | `Drop exn  -> return (Result.Error exn)
+    end with Not_found -> return (Result.Error Not_found)
+
 end

async/Async_SDN.ml

@@ -177,6 +177,9 @@ 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_table (t : t) (sw_id : SDN.switchId) =
   match switch_version t sw_id with
   | 0x01 -> OF0x01_Controller.clear_table t.sub_0x01 sw_id
@@ -199,3 +202,17 @@ let install_flows ?(clear=true) (t : t) (sw_id : SDN.switchId) flows =
     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"
+
+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"
+
+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"