From 5e1fe76b4df54c4a0ee38bd4d403350db082f406 Mon Sep 17 00:00:00 2001 From: Craig Riecke Date: Fri, 22 Jul 2016 08:02:26 -0400 Subject: [PATCH] Refactor Into Plugin Architecture (#512) --- _oasis | 6 +- async/Frenetic_Compile_Server.ml | 4 +- async/Frenetic_Http_Controller.ml | 45 +- async/Frenetic_NetKAT_Controller.ml | 317 +++------- async/Frenetic_NetKAT_Controller.mli | 63 +- async/Frenetic_NetKAT_Updates.ml | 24 +- async/Frenetic_NetKAT_Updates.mli | 6 +- async/Frenetic_OpenFlow0x01_Controller.ml | 172 ------ async/Frenetic_OpenFlow0x01_Controller.mli | 23 - async/Frenetic_OpenFlow0x01_Plugin.ml | 391 ++++++++++++ async/Frenetic_OpenFlow0x01_Plugin.mli | 35 ++ ...ler.ml => Frenetic_OpenFlow0x04_Plugin.ml} | 0 ...r.mli => Frenetic_OpenFlow0x04_Plugin.mli} | 0 async/Frenetic_Ox.ml | 56 +- async/Frenetic_Shell.ml | 6 +- async/async.mldylib | 5 +- async/async.mllib | 5 +- examples/Learning_Switch.ml | 2 +- frenetic/frenetic.ml | 4 +- frenetic/openflow.ml | 127 ++-- lang/python/frenetic/__init__.py | 17 +- lang/python/frenetic/syntax.py | 42 +- lib/Frenetic_NetKAT.ml | 12 - lib/Frenetic_NetKAT.mli | 12 - lib/Frenetic_NetKAT_Json.ml | 244 ++++++-- lib/Frenetic_NetKAT_Json.mli | 32 +- lib/Frenetic_NetKAT_SDN_Json.ml | 163 ----- lib/Frenetic_NetKAT_SDN_Json.mli | 28 - lib/Frenetic_OpenFlow.ml | 581 +++++++++++++----- lib/Frenetic_OpenFlow.mli | 125 ++-- lib/Frenetic_OpenFlow0x01.ml | 2 + lib/Frenetic_OpenFlow0x01.mli | 2 + lib/frenetic.mldylib | 3 +- lib/frenetic.mllib | 3 +- lib/frenetic.odocl | 4 +- lib_test/Test.ml | 1 - lib_test/Test_Frenetic_NetKAT_Json.ml | 197 +++--- lib_test/Test_Frenetic_NetKAT_SDN_Json.ml | 53 -- lib_test/data/flow_stats.json | 1 + lib_test/data/pkt_out_buffered.json | 4 +- lib_test/data/pkt_out_multiple_ports.json | 6 +- lib_test/data/port_stats.json | 2 +- lib_test/data/query.json | 1 - setup.ml | 12 +- 44 files changed, 1558 insertions(+), 1280 deletions(-) delete mode 100644 async/Frenetic_OpenFlow0x01_Controller.ml delete mode 100644 async/Frenetic_OpenFlow0x01_Controller.mli create mode 100644 async/Frenetic_OpenFlow0x01_Plugin.ml create mode 100644 async/Frenetic_OpenFlow0x01_Plugin.mli rename async/{Frenetic_OpenFlow0x04_Controller.ml => Frenetic_OpenFlow0x04_Plugin.ml} (100%) rename async/{Frenetic_OpenFlow0x04_Controller.mli => Frenetic_OpenFlow0x04_Plugin.mli} (100%) delete mode 100644 lib/Frenetic_NetKAT_SDN_Json.ml delete mode 100644 lib/Frenetic_NetKAT_SDN_Json.mli delete mode 100644 lib_test/Test_Frenetic_NetKAT_SDN_Json.ml create mode 100644 lib_test/data/flow_stats.json delete mode 100644 lib_test/data/query.json diff --git a/_oasis b/_oasis index 277e5d485..fbb7e913d 100644 --- a/_oasis +++ b/_oasis @@ -56,7 +56,6 @@ Library frenetic Frenetic_NetKAT_Net, Frenetic_NetKAT_Parser, Frenetic_NetKAT_Pretty, - Frenetic_NetKAT_SDN_Json, Frenetic_NetKAT_Semantics, Frenetic_Network, Frenetic_OpenFlow, @@ -90,9 +89,8 @@ Library async Frenetic_Compile_Server, Frenetic_Log, Frenetic_Http_Controller, - Frenetic_OpenFlow0x01_Controller, + Frenetic_OpenFlow0x01_Plugin, Frenetic_NetKAT_Controller, - Frenetic_NetKAT_Updates, Frenetic_Ox Executable frenetic @@ -181,7 +179,7 @@ Executable benchmark Test all_tests Run$: flag(tests) # -only-test Test_Frenetic_GroupTable0x04.ml - Command: $testtool inline-test-runner frenetic + Command: $testtool inline-test-runner frenetic TestTools: testtool Document frenetic diff --git a/async/Frenetic_Compile_Server.ml b/async/Frenetic_Compile_Server.ml index 96553ed9c..29156715e 100644 --- a/async/Frenetic_Compile_Server.ml +++ b/async/Frenetic_Compile_Server.ml @@ -22,7 +22,7 @@ let compile_respond pol = (* JSON conversion is not timed. *) let json_tbls = List.map tbls ~f:(fun (sw, tbl) -> `Assoc [("switch_id", `Int (Int64.to_int_exn sw)); - ("tbl", Frenetic_NetKAT_SDN_Json.flowTable_to_json tbl)]) in + ("tbl", Frenetic_NetKAT_Json.flowTable_to_json tbl)]) in let resp = Yojson.Basic.to_string ~std:true (`List json_tbls) in let headers = Cohttp.Header.init_with "X-Compile-Time" (Float.to_string time) in @@ -53,7 +53,7 @@ let handle_request let sw = Int64.of_string switchId in Comp.compile_local ~options:!current_compiler_options !policy |> Comp.to_table ~options:!current_compiler_options sw |> - Frenetic_NetKAT_SDN_Json.flowTable_to_json |> + Frenetic_NetKAT_Json.flowTable_to_json |> Yojson.Basic.to_string ~std:true |> Cohttp_async.Server.respond_with_string | `POST, ["config"] -> diff --git a/async/Frenetic_Http_Controller.ml b/async/Frenetic_Http_Controller.ml index fdce9724e..9c9de4647 100644 --- a/async/Frenetic_Http_Controller.ml +++ b/async/Frenetic_Http_Controller.ml @@ -18,11 +18,6 @@ type client = { let current_compiler_options = ref Comp.default_compiler_options -(* TODO(arjun): - - - - These are OpenFlow 1.0 types. Everywhere else, we are using SDN_Types. *) let port_to_json port = `Int (Int32.to_int_exn port) let switch_and_ports_to_json (sw, ports) = @@ -34,7 +29,6 @@ let current_switches_to_json lst = let current_switches_to_json_string lst = Yojson.Basic.to_string ~std:true (current_switches_to_json lst) -(* *) let unions (pols : policy list) : policy = List.fold_left pols ~init:drop ~f:(fun p q -> Union (p, q)) @@ -66,8 +60,9 @@ let get_client (clientId: string): client = { policy_node = node; event_reader = r; event_writer = w } ) +(* The Controller module is a parameter because port_stats and packet_out are called directly. *) let handle_request - (module Controller : Frenetic_NetKAT_Controller.CONTROLLER) + (module Controller : Frenetic_NetKAT_Controller.CONTROLLER) ~(body : Cohttp_async.Body.t) (client_addr : Socket.Address.Inet.t) (request : Request.t) : Server.response Deferred.t = @@ -79,22 +74,21 @@ let handle_request | `GET, ["port_stats"; switch_id; port_id] -> port_stats (Int64.of_string switch_id) (Int32.of_string port_id) >>= fun portStats -> - Server.respond_with_string (Frenetic_NetKAT_Json.port_stats_to_json_string portStats) + Server.respond_with_string (Frenetic_NetKAT_Json.port_stat_to_json_string portStats) | `GET, ["current_switches"] -> - current_switches () >>= fun switches -> + switches () >>= fun switches -> Server.respond_with_string (current_switches_to_json_string switches) | `GET, ["query"; name] -> - if (is_query name) then - query name - >>= fun stats -> - Server.respond_with_string (Frenetic_NetKAT_Json.stats_to_json_string stats) - else - begin - Log.info "query %s is not defined in the current policy" name; - let headers = Cohttp.Header.init_with "X-Query-Not-Defined" "true" in - Server.respond_with_string ~headers - (Frenetic_NetKAT_Json.stats_to_json_string (0L, 0L)) - end + (* TODO: check if query exists *) + query name + >>= fun stats -> + Server.respond_with_string (Frenetic_NetKAT_Json.stats_to_json_string stats) + (* begin *) + (* Log.info "query %s is not defined in the current policy" name; *) + (* let headers = Cohttp.Header.init_with "X-Query-Not-Defined" "true" in *) + (* Server.respond_with_string ~headers *) + (* (Frenetic_NetKAT_Json.stats_to_json_string (0L, 0L)) *) + (* end *) | `GET, [clientId; "event"] -> let curr_client = get_client clientId in (* Check if there are events that this client has not seen yet *) @@ -106,10 +100,9 @@ let handle_request handle_parse_errors' body (fun str -> let json = Yojson.Basic.from_string str in - Frenetic_NetKAT_SDN_Json.pkt_out_from_json json) - (fun (sw_id, pkt_out) -> - send_packet_out sw_id pkt_out - >>= fun () -> + Frenetic_NetKAT_Json.pkt_out_from_json json) + (fun (sw_id, port_id, payload, policies) -> + packet_out sw_id port_id payload policies >>= fun () -> Cohttp_async.Server.respond `OK) | `POST, [clientId; "update_json"] -> handle_parse_errors body parse_update_json @@ -144,14 +137,14 @@ let print_error addr exn = | None -> Log.error "%s" monitor_exn let listen ~http_port ~openflow_port = - let module Controller = Frenetic_NetKAT_Controller.Make in + let module Controller = Frenetic_NetKAT_Controller.Make(Frenetic_OpenFlow0x01_Plugin) in let on_handler_error = `Call print_error in let _ = Cohttp_async.Server.create ~on_handler_error (Tcp.on_port http_port) (handle_request (module Controller)) in let (_, pol_reader) = Frenetic_DynGraph.to_pipe pol in - let _ = Pipe.iter pol_reader ~f:(fun pol -> Controller.update_policy pol) in + let _ = Pipe.iter pol_reader ~f:(fun pol -> Controller.update pol) in Controller.start openflow_port; don't_wait_for(propogate_events Controller.event); Deferred.return () diff --git a/async/Frenetic_NetKAT_Controller.ml b/async/Frenetic_NetKAT_Controller.ml index c212530d5..14cbf6818 100644 --- a/async/Frenetic_NetKAT_Controller.ml +++ b/async/Frenetic_NetKAT_Controller.ml @@ -1,281 +1,108 @@ open Core.Std open Async.Std + open Frenetic_NetKAT open Frenetic_OpenFlow -module OF10 = Frenetic_OpenFlow0x01 -module Controller = Frenetic_OpenFlow0x01_Controller module Log = Frenetic_Log -module Upd = Frenetic_NetKAT_Updates - -let printf = Log.printf - -let bytes_to_headers - (port_id : Frenetic_OpenFlow.portId) - (bytes : Cstruct.t) - : Frenetic_NetKAT_Semantics.HeadersValues.t = - let open Frenetic_NetKAT_Semantics.HeadersValues in - let open Frenetic_Packet in - let pkt = Frenetic_Packet.parse bytes in - { location = Frenetic_NetKAT.Physical port_id - ; ethSrc = pkt.dlSrc - ; ethDst = pkt.dlDst - ; vlan = (match pkt.dlVlan with Some (v) -> v | None -> 0) - ; vlanPcp = pkt.dlVlanPcp - ; ethType = dlTyp pkt - ; ipProto = (try nwProto pkt with Invalid_argument(_) -> 0) - ; ipSrc = (try nwSrc pkt with Invalid_argument(_) -> 0l) - ; ipDst = (try nwDst pkt with Invalid_argument(_) -> 0l) - ; tcpSrcPort = (try tpSrc pkt with Invalid_argument(_) -> 0) - ; tcpDstPort = (try tpDst pkt with Invalid_argument(_) -> 0) - } -let packet_sync_headers (pkt:Frenetic_NetKAT_Semantics.packet) : Frenetic_NetKAT_Semantics.packet * bool = - let open Frenetic_NetKAT_Semantics in - let open Frenetic_NetKAT in - let change = ref false in - let g p q acc f = - let v = Field.get f pkt.Frenetic_NetKAT_Semantics.headers in - if p v acc then - acc - else begin - change := true; - q acc v - end in - let fail field = (fun _ -> failwith "unsupported modification") in - let packet = Frenetic_Packet.parse (Frenetic_OpenFlow.payload_bytes pkt.payload) in - let packet' = HeadersValues.Fields.fold - ~init:packet - ~location:(fun acc _ -> acc) - ~ethSrc:(g (fun v p -> v = p.Frenetic_Packet.dlSrc) Frenetic_Packet.setDlSrc) - ~ethDst:(g (fun v p -> v = p.Frenetic_Packet.dlDst) Frenetic_Packet.setDlDst) - (* XXX(seliopou): Fix impls of: vlan, vlanPcp *) - ~vlan:(g (fun _ _ -> true) (fail "vlan")) - ~vlanPcp:(g (fun _ _ -> true) (fail "vlanPcp")) - ~ipSrc:(g - (fun v p -> try v = Frenetic_Packet.nwSrc p with Invalid_argument(_) -> true) - (fun acc nw -> Frenetic_Packet.setNwSrc acc nw)) - ~ipDst:(g - (fun v p -> try v = Frenetic_Packet.nwDst p with Invalid_argument(_) -> true) - (fun acc nw -> Frenetic_Packet.setNwDst acc nw)) - ~tcpSrcPort:(g - (fun v p -> try v= Frenetic_Packet.tpSrc p with Invalid_argument(_) -> true) - Frenetic_Packet.setTpSrc) - ~tcpDstPort:(g - (fun v p -> try v = Frenetic_Packet.tpDst p with Invalid_argument(_) -> true) - Frenetic_Packet.setTpDst) - (* XXX(seliopou): currently does not support: *) - ~ethType:(g (fun _ _ -> true) (fail "ethType")) - ~ipProto:(g (fun _ _ -> true) (fail "ipProto")) in - ({ pkt with payload = match pkt.payload with - | Frenetic_OpenFlow.NotBuffered(_) -> Frenetic_OpenFlow.NotBuffered(Frenetic_Packet.marshal packet') - | Frenetic_OpenFlow.Buffered(n, _) -> Frenetic_OpenFlow.Buffered(n, Frenetic_Packet.marshal packet') - }, !change) - -let of_to_netkat_event fdd (evt : Controller.event) : Frenetic_NetKAT.event list = - match evt with - (* TODO(arjun): include switch features in SwitchUp *) - | `Connect (sw_id, feats) -> - (* TODO(joe): Did we just want the port number? Or do we want the entire description? *) - let ps = - List.filter - (List.map feats.ports ~f:(fun desc -> Int32.of_int_exn desc.port_no)) - ~f:(fun p -> not (p = 0xFFFEl)) - in [SwitchUp(sw_id, ps)] - | `Disconnect (sw_id) -> [SwitchDown sw_id] - | `Message (sw_id, hdr, PortStatusMsg ps) -> - begin match ps.reason, ps.desc.config.down with - | Add, _ - | Modify, true -> - let pt_id = Int32.of_int_exn (ps.desc.port_no) in - [PortUp (sw_id, pt_id)] - | Delete, _ - | Modify, false -> - let pt_id = Int32.of_int_exn (ps.desc.port_no) in - [PortDown (sw_id, pt_id)] - end - | `Message (sw_id,hdr,PacketInMsg pi) when pi.port <= 0xff00 -> - let port_id = Int32.of_int_exn pi.port in - let payload : Frenetic_OpenFlow.payload = - match pi.input_payload with - | Buffered (id,bs) -> Buffered (id,bs) - | NotBuffered bs -> NotBuffered bs in - (* Eval the packet to get the list of packets that should go to - * pipes, and the list of packets that can be forwarded to physical - * locations. - * *) - let open Frenetic_NetKAT_Semantics in - let pkt0 = { - switch = sw_id; - headers = bytes_to_headers port_id (Frenetic_OpenFlow.payload_bytes payload); - payload = payload; - } in - let pis, _, _ = - match pi.reason with - | NoMatch -> ( [("table_miss", pkt0)], [], [] ) - | ExplicitSend -> Frenetic_NetKAT_Compiler.eval_pipes pkt0 fdd - in - List.map pis ~f:(fun (pipe, pkt2) -> - let pkt3, changed = packet_sync_headers pkt2 in - let payload = match payload, changed with - | Frenetic_OpenFlow.NotBuffered(_), _ - | _ , true -> - Frenetic_OpenFlow.NotBuffered(Frenetic_OpenFlow.payload_bytes pkt3.payload) - | Frenetic_OpenFlow.Buffered(buf_id, bytes), false -> - Frenetic_OpenFlow.Buffered(buf_id, bytes) - in - PacketIn(pipe, sw_id, port_id, payload, pi.total_len) - ) - | _ -> [] +module type PLUGIN = sig + val start: int -> unit + val events : event Pipe.Reader.t + val switch_features : switchId -> switchFeatures option Deferred.t + val update : Frenetic_NetKAT_Compiler.t -> unit Deferred.t + val update_switch : switchId -> Frenetic_NetKAT_Compiler.t -> unit Deferred.t + val packet_out : switchId -> portId option -> payload -> Frenetic_NetKAT.policy list -> unit Deferred.t + val flow_stats : switchId -> Pattern.t -> flowStats Deferred.t + val port_stats : switchId -> portId -> portStats Deferred.t +end module type CONTROLLER = sig - val update_policy : policy -> unit Deferred.t - val send_packet_out : switchId -> Frenetic_OpenFlow.pktOut -> unit Deferred.t - val event : unit -> event Deferred.t - val query : string -> (Int64.t * Int64.t) Deferred.t - val port_stats : switchId -> portId -> OF10.portStats list Deferred.t - val is_query : string -> bool val start : int -> unit - val current_switches : unit -> (switchId * portId list) list Deferred.t + val event : unit -> event Deferred.t + val switches : unit -> (switchId * portId list) list Deferred.t + val port_stats : switchId -> portId -> portStats Deferred.t + val update : Frenetic_NetKAT.policy -> unit Deferred.t + val packet_out : switchId -> portId option -> payload -> Frenetic_NetKAT.policy list -> unit Deferred.t + val query : string -> (int64 * int64) Deferred.t val set_current_compiler_options : Frenetic_NetKAT_Compiler.compiler_options -> unit end - -module Make : CONTROLLER = struct - let fdd = ref (Frenetic_NetKAT_Compiler.compile_local drop) - let current_compiler_options = ref (Frenetic_NetKAT_Compiler.default_compiler_options) - let stats : (string, Int64.t * Int64.t) Hashtbl.Poly.t = Hashtbl.Poly.create () + +module Make (P:PLUGIN) : CONTROLLER = struct + (* Global variables *) let (pol_reader, pol_writer) = Pipe.create () - let (pktout_reader, pktout_writer) = Pipe.create () let (event_reader, event_writer) = Pipe.create () - - (* TODO(arjun,jnfoster): Result should be determined with network is - updated. *) - let update_policy (pol : policy) : unit Deferred.t = - Pipe.write pol_writer pol - - let send_packet_out (sw_id : switchId) - (pkt_out : Frenetic_OpenFlow.pktOut) : unit Deferred.t = - Log.printf ~level:`Debug "SENDING PKT_OUT"; - Pipe.write pktout_writer (sw_id, pkt_out) + let switch_hash : (switchId, portId list) Hashtbl.Poly.t = Hashtbl.Poly.create () + let current_compiler_options = ref (Frenetic_NetKAT_Compiler.default_compiler_options) + let fdd = ref (Frenetic_NetKAT_Compiler.compile_local Frenetic_NetKAT.drop) + + let update (pol:policy) : unit Deferred.t = + fdd := Frenetic_NetKAT_Compiler.compile_local pol; + P.update !fdd + + let handle_event (evt:event) : unit Deferred.t = + Pipe.write_without_pushback event_writer evt; + match evt with + | SwitchUp (sw,ports) -> + let _ = Hashtbl.Poly.add switch_hash sw ports in + P.update_switch sw !fdd + | SwitchDown sw -> + Hashtbl.Poly.remove switch_hash sw; + return () + | _ -> + Deferred.return () + + let start (openflow_port:int) : unit = + P.start openflow_port; + don't_wait_for (Pipe.iter P.events ~f:handle_event) let event () : event Deferred.t = - Pipe.read event_reader - >>= function - | `Eof -> assert false + Pipe.read event_reader >>= function | `Ok evt -> Deferred.return evt + | `Eof -> assert false - let current_switches () = - Controller.get_switches () >>= fun switches -> - Deferred.List.filter_map ~f:Controller.get_switch_features - switches >>| fun features -> - let get_switch_and_ports (feats : OF10.SwitchFeatures.t) = - (feats.switch_id, - List.filter_map ~f:(fun port_desc -> - if port_desc.port_no = 0xFFFE then - None - else - Some (Int32.of_int_exn port_desc.port_no)) - feats.ports) in - List.map ~f:get_switch_and_ports features + let switches () : (switchId * portId list) list Deferred.t = + return (Hashtbl.Poly.to_alist switch_hash) + + let port_stats (sw : switchId) (pt : portId) : portStats Deferred.t = + P.port_stats sw pt + + let packet_out (sw:switchId) (ingress_port:portId option) (pay:payload) (pol:policy list) : unit Deferred.t = + P.packet_out sw ingress_port pay pol let get_table (sw_id : switchId) : (Frenetic_OpenFlow.flow * string list) list = - Frenetic_NetKAT_Compiler.to_table' ~options:!current_compiler_options sw_id !fdd + Frenetic_NetKAT_Compiler.to_table' sw_id !fdd + + let sum_stat_pairs stats = + List.fold stats ~init:(0L, 0L) + ~f:(fun (pkts, bytes) (pkts', bytes') -> + Int64.(pkts + pkts', bytes + bytes')) + + (* TODO: The NetKAT Controller used to preserve statistics across queries, and + add the accumulated stats in here. This is no longer done - is that right? *) - let raw_query (name : string) : (Int64.t * Int64.t) Deferred.t = - Controller.get_switches () >>= fun switches -> + let query (name : string) : (Int64.t * Int64.t) Deferred.t = Deferred.List.map ~how:`Parallel - switches ~f:(fun sw_id -> + (Hashtbl.Poly.keys switch_hash) + ~f:(fun sw_id -> let pats = List.filter_map (get_table sw_id) ~f:(fun (flow, names) -> if List.mem names name then Some flow.pattern else None) in - Deferred.List.map ~how:`Parallel pats + Deferred.List.map ~how:`Parallel + pats ~f:(fun pat -> - let pat0x01 = To0x01.from_pattern pat in - let req = - OF10.IndividualRequest - { sr_of_match = pat0x01; sr_table_id = 0xff; sr_out_port = None } in - Controller.send_txn sw_id (OF10.Message.StatsRequestMsg req) >>= function - | `Eof -> return (0L,0L) - | `Ok l -> match l with - | [OF10.Message.StatsReplyMsg (IndividualFlowRep stats)] -> - return (List.sum (module Int64) stats ~f:(fun stat -> stat.packet_count), - List.sum (module Int64) stats ~f:(fun stat -> stat.byte_count)) - | _ -> return (0L, 0L) + P.flow_stats sw_id pat + >>| fun(stats) -> (stats.flow_packet_count, stats.flow_byte_count) ) + >>| fun stats -> sum_stat_pairs stats ) - >>| fun stats -> - List.fold (List.concat stats) ~init:(0L, 0L) - ~f:(fun (pkts, bytes) (pkts', bytes') -> - Int64.(pkts + pkts', bytes + bytes')) - - let query (name : string) : (Int64.t * Int64.t) Deferred.t = - raw_query name - >>= fun (pkts, bytes) -> - let (pkts', bytes') = Hashtbl.Poly.find_exn stats name in - Deferred.return (Int64.(pkts + pkts', bytes + bytes')) - - let port_stats (sw_id : switchId) (pid : portId) : OF10.portStats list Deferred.t = - let pt = Int32.(to_int_exn pid) in - let req = OF10.PortRequest (Some (PhysicalPort pt)) in - Controller.send_txn sw_id (OF10.Message.StatsRequestMsg req) >>= function - | `Eof -> assert false - | `Ok l -> match l with - | [OF10.Message.StatsReplyMsg (PortRep ps)] -> return ps - | _ -> assert false - - let is_query (name : string) : bool = Hashtbl.Poly.mem stats name - - let update_all_switches (pol : policy) : unit Deferred.t = - Log.printf ~level:`Debug "Installing policy\n%s" (Frenetic_NetKAT_Pretty.string_of_policy pol); - - let new_queries = Frenetic_NetKAT_Semantics.queries_of_policy pol in - (* Discard old queries *) - let filterer ~(key:string) ~(data:int64 * int64) = List.mem new_queries key in - Hashtbl.Poly.filteri_inplace ~f:filterer stats ; - (* Queries that have to be saved. *) - let preserved_queries = Hashtbl.Poly.keys stats in - (* Initialize new queries to 0 *) - List.iter new_queries ~f:(fun query -> - if not (Hashtbl.Poly.mem stats query) then - Hashtbl.Poly.set stats ~key:query ~data:(0L, 0L)); - (* Update queries that have been preserved. The query function itself - adds the current value of the counters to the cumulative sum. We - simply store this in stats. *) - Deferred.List.iter preserved_queries ~f:(fun qname -> - query qname - >>| fun stat -> - Hashtbl.Poly.set stats qname stat) - >>= fun () -> - (* Actually update things *) - fdd := Frenetic_NetKAT_Compiler.compile_local ~options:!current_compiler_options pol; - Upd.BestEffortUpdate.set_current_compiler_options !current_compiler_options; - Upd.BestEffortUpdate.implement_policy !fdd - - let handle_event (evt : Controller.event) : unit Deferred.t = - List.iter (of_to_netkat_event !fdd evt) ~f:(fun netkat_evt -> - Pipe.write_without_pushback event_writer netkat_evt); - match evt with - | `Connect (sw_id, feats) -> - printf ~level:`Info "switch %Ld connected" sw_id; - Upd.BestEffortUpdate.set_current_compiler_options !current_compiler_options; - Upd.BestEffortUpdate.bring_up_switch sw_id !fdd - | _ -> Deferred.return () + >>| fun stats -> sum_stat_pairs stats let set_current_compiler_options opt = current_compiler_options := opt - let send_pktout ((sw_id, pktout) : switchId * Frenetic_OpenFlow.pktOut) : unit Deferred.t = - let pktout0x01 = To0x01.from_packetOut pktout in - Controller.send sw_id 0l (OF10.Message.PacketOutMsg pktout0x01) >>= function - | `Eof -> return () - | `Ok -> return () - - let start (openflow_port:int) : unit = - Controller.init openflow_port; - don't_wait_for (Pipe.iter pol_reader ~f:update_all_switches); - don't_wait_for (Pipe.iter (Controller.events) ~f:handle_event); - don't_wait_for (Pipe.iter pktout_reader ~f:send_pktout) end + diff --git a/async/Frenetic_NetKAT_Controller.mli b/async/Frenetic_NetKAT_Controller.mli index 55f221cd8..bdf248948 100644 --- a/async/Frenetic_NetKAT_Controller.mli +++ b/async/Frenetic_NetKAT_Controller.mli @@ -1,37 +1,48 @@ open Core.Std open Async.Std -open Frenetic_NetKAT + open Frenetic_OpenFlow + +module type PLUGIN = sig + val start: int -> unit + val events : event Pipe.Reader.t + val switch_features : switchId -> switchFeatures option Deferred.t + val update : Frenetic_NetKAT_Compiler.t -> unit Deferred.t + val update_switch : switchId -> Frenetic_NetKAT_Compiler.t -> unit Deferred.t + val packet_out : switchId -> portId option -> payload -> Frenetic_NetKAT.policy list -> unit Deferred.t + val flow_stats : switchId -> Pattern.t -> flowStats Deferred.t + val port_stats : switchId -> portId -> portStats Deferred.t +end -module OF10 = Frenetic_OpenFlow0x01 -module Controller = Frenetic_OpenFlow0x01_Controller -module Log = Frenetic_Log -module Upd = Frenetic_NetKAT_Updates +module type CONTROLLER = sig + (** [start pt] initializes the controller, listening on TCP port [pt]. *) + val start : int -> unit -val bytes_to_headers : - Frenetic_OpenFlow.portId -> - Cstruct.t -> - Frenetic_NetKAT_Semantics.HeadersValues.t + (** [event ()] returns the next event from the network. *) + val event : unit -> event Deferred.t -val packet_sync_headers : - Frenetic_NetKAT_Semantics.packet -> - Frenetic_NetKAT_Semantics.packet * bool + (** [current_switches ()] returns the set of switches currently + connected to this controller. *) + val switches : unit -> (switchId * portId list) list Deferred.t -val of_to_netkat_event : - Frenetic_NetKAT_Compiler.t -> - Controller.event -> - Frenetic_NetKAT.event list + (** [port_stats sw pt] returns byte and packet counts for switch[sw] port [pt]. *) + val port_stats : switchId -> portId -> portStats Deferred.t -module type CONTROLLER = sig - val update_policy : policy -> unit Deferred.t - val send_packet_out : switchId -> Frenetic_OpenFlow.pktOut -> unit Deferred.t - val event : unit -> event Deferred.t - val query : string -> (Int64.t * Int64.t) Deferred.t - val port_stats : switchId -> portId -> OF10.portStats list Deferred.t - val is_query : string -> bool - val start : int -> unit - val current_switches : unit -> (switchId * portId list) list Deferred.t + (** [update p] sets the global policy to [p]. *) + val update : Frenetic_NetKAT.policy -> unit Deferred.t + + (** [send_packet_out sw pd p] injects packets into the network by + applying [p] to [pd] at [sw]. Optional ingress port helps locate buffer. *) + val packet_out : switchId -> portId option -> payload -> Frenetic_NetKAT.policy list -> unit Deferred.t + + (** [query x] returns byte and packet counts for query [x]. *) + val query : string -> (int64 * int64) Deferred.t + + (** [set_current_compiler_options co] sets compiler options for subsequent invocations *) val set_current_compiler_options : Frenetic_NetKAT_Compiler.compiler_options -> unit + end -module Make : CONTROLLER +module Make(P:PLUGIN) : CONTROLLER + + diff --git a/async/Frenetic_NetKAT_Updates.ml b/async/Frenetic_NetKAT_Updates.ml index 7c2c3c89e..4b3ec64a2 100644 --- a/async/Frenetic_NetKAT_Updates.ml +++ b/async/Frenetic_NetKAT_Updates.ml @@ -1,3 +1,5 @@ +(* TODO: Currently Unused. See Frenetic_OpenFlow0x01_Controller for Future Directions *) + open Core.Std open Async.Std @@ -9,8 +11,6 @@ module Log = Frenetic_Log module Controller = Frenetic_OpenFlow0x01_Controller module Comp = Frenetic_NetKAT_Compiler -open Frenetic_OpenFlow.To0x01 - exception UpdateError module SwitchMap = Map.Make(struct @@ -35,13 +35,11 @@ end module type UPDATE = sig val bring_up_switch : - ?old:Comp.t -> SDN.switchId -> Comp.t -> unit Deferred.t val implement_policy : - ?old:Comp.t -> Comp.t -> unit Deferred.t @@ -49,7 +47,10 @@ module type UPDATE = sig end module BestEffortUpdate = struct - let current_compiler_options = ref Comp.default_compiler_options + open Frenetic_OpenFlow.To0x01 + + let current_compiler_options = + ref Comp.default_compiler_options let restrict sw_id repr = Comp.restrict Frenetic_NetKAT.(Switch sw_id) repr @@ -70,7 +71,7 @@ module BestEffortUpdate = struct | `Eof -> raise UpdateError | `Ok -> return () - let bring_up_switch ?old (sw_id : SDN.switchId) new_r = + let bring_up_switch (sw_id : SDN.switchId) new_r = let table = Comp.to_table ~options:!current_compiler_options sw_id new_r in Log.printf ~level:`Debug "Setting up flow table\n%s" (Frenetic_OpenFlow.string_of_flowTable ~label:(Int64.to_string sw_id) table); @@ -85,10 +86,10 @@ module BestEffortUpdate = struct Log.flushed () >>| fun () -> Log.error "%s\n%!" (Exn.to_string _exn) - let implement_policy ?old repr = + let implement_policy repr = (Controller.get_switches ()) >>= fun switches -> Deferred.List.iter switches (fun sw_id -> - bring_up_switch ~old sw_id repr) + bring_up_switch sw_id repr) let set_current_compiler_options opt = current_compiler_options := opt @@ -96,6 +97,7 @@ end module PerPacketConsistent (Args : CONSISTENT_UPDATE_ARGS) : UPDATE = struct open Frenetic_OpenFlow + open To0x01 open Args let current_compiler_options = ref Comp.default_compiler_options @@ -105,7 +107,7 @@ module PerPacketConsistent (Args : CONSISTENT_UPDATE_ARGS) : UPDATE = struct | `Ok dl -> return (Ok ()) | `Eof -> return (Error UpdateError) - let install_flows_for sw_id ?old table = + let install_flows_for sw_id table = let to_flow_mod p f = M.FlowModMsg (from_flow p f) in let priority = ref 65536 in let flows = List.map table ~f:(fun flow -> @@ -258,7 +260,7 @@ module PerPacketConsistent (Args : CONSISTENT_UPDATE_ARGS) : UPDATE = struct let ver = ref 1 - let implement_policy ?old repr : unit Deferred.t = + let implement_policy repr : unit Deferred.t = (* XXX(seliopou): It might be better to iterate over client ids rather than * switch ids. A client id is guaranteed to be unique within a run of a * program, whereas a switch id may be reused across client ids, i.e., a @@ -283,7 +285,7 @@ module PerPacketConsistent (Args : CONSISTENT_UPDATE_ARGS) : UPDATE = struct >>| fun () -> incr ver - let bring_up_switch ?old (sw_id : switchId) repr = + let bring_up_switch (sw_id : switchId) repr = Monitor.try_with ~name:"PerPacketConsistent.bring_up_switch" (fun () -> delete_flows_for sw_id >>= fun () -> internal_install_policy_for !ver repr sw_id >>= fun () -> diff --git a/async/Frenetic_NetKAT_Updates.mli b/async/Frenetic_NetKAT_Updates.mli index 99ed3f157..ff7876941 100644 --- a/async/Frenetic_NetKAT_Updates.mli +++ b/async/Frenetic_NetKAT_Updates.mli @@ -1,3 +1,5 @@ +(* TODO: Currently Unused. See Frenetic_OpenFlow0x01_Controller for Future Directions *) + open Core.Std open Async.Std @@ -5,8 +7,6 @@ module Net = Frenetic_NetKAT_Net.Net module SDN = Frenetic_OpenFlow module Comp = Frenetic_NetKAT_Compiler -open SDN.To0x01 - exception UpdateError module SwitchMap : sig @@ -31,13 +31,11 @@ end module type UPDATE = sig val bring_up_switch : - ?old:Comp.t -> SDN.switchId -> Comp.t -> unit Deferred.t val implement_policy : - ?old:Comp.t -> Comp.t -> unit Deferred.t diff --git a/async/Frenetic_OpenFlow0x01_Controller.ml b/async/Frenetic_OpenFlow0x01_Controller.ml deleted file mode 100644 index c77ee3fdc..000000000 --- a/async/Frenetic_OpenFlow0x01_Controller.ml +++ /dev/null @@ -1,172 +0,0 @@ -open Core.Std -open Async.Std -open Frenetic_OpenFlow0x01 -module Log = Frenetic_Log - -type event = [ - | `Connect of switchId * SwitchFeatures.t - | `Disconnect of switchId - | `Message of switchId * Frenetic_OpenFlow_Header.t * Message.t -] - -let chan = Ivar.create () - -let (events, events_writer) = Pipe.create () - -let server_sock_addr = Ivar.create () -let server_reader = Ivar.create () -let server_writer = Ivar.create () - -let read_outstanding = ref false -let read_finished = Condition.create () - -let rec clear_to_read () = if (!read_outstanding) - then Condition.wait read_finished >>= clear_to_read - else return (read_outstanding := true) - -let signal_read () = read_outstanding := false; - Condition.broadcast read_finished () - -let openflow_executable () = - let prog_alt1 = Filename.dirname(Sys.executable_name) ^ "/openflow" in - let prog_alt2 = Filename.dirname(Sys.executable_name) ^ "/openflow.native" in - Sys.file_exists prog_alt1 - >>= function - | `Yes -> return prog_alt1 - | _ -> Sys.file_exists prog_alt2 - >>= function - | `Yes -> return prog_alt2 - | _ -> failwith (Printf.sprintf "Can't find OpenFlow executable %s!" prog_alt2) - -let init port = - Log.info "Calling create!"; - let sock_port = 8984 in - let sock_addr = `Inet (Unix.Inet_addr.localhost, sock_port) in - let args = ["-s"; string_of_int sock_port; - "-p"; string_of_int port; - "-v"] in - don't_wait_for ( - Log.info "Current uid: %n" (Unix.getuid ()); - Log.flushed () >>= fun () -> - openflow_executable () >>= fun prog -> - Process.create ~prog ~args () - >>= function - | Error err -> Log.error "Failed to launch openflow server %s!" prog; - raise (Core_kernel.Error.to_exn err) - | Ok proc -> - Log.info "Successfully launched OpenFlow controller with pid %s" (Pid.to_string (Process.pid proc)); - (* Redirect stdout of the child proc to out stdout for logging *) - let buf = String.create 1000 in - don't_wait_for (Deferred.repeat_until_finished () (fun () -> - Reader.read (Process.stdout proc) buf >>| function - | `Eof -> `Finished () - | `Ok n -> `Repeat (Writer.write (Lazy.force Writer.stdout) ~len:n buf))); - Log.info "Connecting to first OpenFlow server socket"; - let rec wait_for_server () = - Monitor.try_with ~extract_exn:true (fun () -> Socket.connect (Socket.create Socket.Type.tcp) sock_addr) >>= function - | Ok sock -> return sock - | Error exn -> Log.info "Failed to open socket to OpenFlow server: %s" (Exn.to_string exn); - Log.info "Retrying in 1 second"; - after (Time.Span.of_sec 1.) - >>= wait_for_server in - wait_for_server () - >>= fun sock -> - Ivar.fill server_sock_addr sock_addr; - Log.info "Successfully connected to first OpenFlow server socket"; - Ivar.fill server_reader (Reader.create (Socket.fd sock)); - Ivar.fill server_writer (Writer.create (Socket.fd sock)); - (* We open a second socket to get the events stream *) - Log.info "Connecting to second OpenFlow server socket"; - Socket.connect (Socket.create Socket.Type.tcp) sock_addr - >>= fun sock -> - Log.info "Successfully connected to second OpenFlow server socket"; - let reader = Reader.create (Socket.fd sock) in - let writer = Writer.create (Socket.fd sock) in - Writer.write_marshal writer ~flags:[] `Events; - Deferred.repeat_until_finished () - (fun () -> - Reader.read_marshal reader - >>= function - | `Eof -> - Log.info "OpenFlow controller closed events socket"; - Pipe.close events_writer; - Socket.shutdown sock `Both; - return (`Finished ()) - | `Ok (`Events_resp evt) -> - Pipe.write events_writer evt >>| fun () -> - `Repeat ())) - - -let ready_to_process () = - Ivar.read server_reader - >>= fun reader -> - Ivar.read server_writer - >>= fun writer -> - clear_to_read () - >>= fun () -> - let read () = Reader.read_marshal reader >>| function - | `Eof -> Log.error "OpenFlow server socket shutdown unexpectedly!"; - failwith "Can not reach OpenFlow server!" - | `Ok a -> a in - let write = Writer.write_marshal writer ~flags:[] in - return (read, write) - -let get_switches () = - ready_to_process () - >>= fun (recv, send) -> - send `Get_switches; - recv () - >>| function - | `Get_switches_resp resp -> - signal_read (); resp - -let get_switch_features (switch_id : switchId) = - ready_to_process () - >>= fun (recv, send) -> - send (`Get_switch_features switch_id); - recv () - >>| function - | `Get_switch_features_resp resp -> - signal_read (); resp - -let send swid xid msg = - ready_to_process () - >>= fun (recv, send) -> - send (`Send (swid,xid,msg)); - recv () - >>| function - | `Send_resp resp -> - signal_read (); resp - -let send_batch swid xid msgs = - ready_to_process () - >>= fun (recv, send) -> - send (`Send_batch (swid,xid,msgs)); - recv () - >>| function - | `Send_batch_resp resp -> - signal_read (); resp - -(* We open a new socket for each send_txn call so that we can block on the reply *) -let send_txn swid msg = - Ivar.read server_sock_addr - >>= fun sock_addr -> - Socket.connect (Socket.create Socket.Type.tcp) sock_addr - >>= fun sock -> - let reader = Reader.create (Socket.fd sock) in - let writer = Writer.create (Socket.fd sock) in - Writer.write_marshal writer ~flags:[] (`Send_txn (swid,msg)); - Reader.read_marshal reader >>| fun resp -> - match resp with - | `Eof -> - Socket.shutdown sock `Both; - `Eof - | `Ok (`Send_txn_resp `Eof) -> - Socket.shutdown sock `Both; - `Eof - | `Ok (`Send_txn_resp (`Ok resp)) -> - Socket.shutdown sock `Both; - resp - | _ -> - Log.debug "send_txn returned something unintelligible"; - `Eof diff --git a/async/Frenetic_OpenFlow0x01_Controller.mli b/async/Frenetic_OpenFlow0x01_Controller.mli deleted file mode 100644 index 515850695..000000000 --- a/async/Frenetic_OpenFlow0x01_Controller.mli +++ /dev/null @@ -1,23 +0,0 @@ -open Core.Std -open Async.Std -open Frenetic_OpenFlow0x01 - -type event = [ - | `Connect of switchId * SwitchFeatures.t - | `Disconnect of switchId - | `Message of switchId * Frenetic_OpenFlow_Header.t * Message.t -] -val init: int -> unit - -val get_switches : unit -> switchId list Deferred.t - -val get_switch_features : switchId -> SwitchFeatures.t option Deferred.t - -val events : event Pipe.Reader.t - -val send : switchId -> xid -> Message.t -> [`Ok | `Eof] Deferred.t - -val send_batch : switchId -> xid -> Message.t list -> [`Ok | `Eof] Deferred.t - -val send_txn : switchId -> Message.t -> [`Ok of (Message.t list) | `Eof] Deferred.t - diff --git a/async/Frenetic_OpenFlow0x01_Plugin.ml b/async/Frenetic_OpenFlow0x01_Plugin.ml new file mode 100644 index 000000000..f193c7507 --- /dev/null +++ b/async/Frenetic_OpenFlow0x01_Plugin.ml @@ -0,0 +1,391 @@ +open Core.Std +open Async.Std + +open Frenetic_OpenFlow +module Log = Frenetic_Log +module OF10 = Frenetic_OpenFlow0x01 + +(* TODO: See openflow.ml for discussion. This is transitional. + + IF YOU CHANGE THE PROTOCOL HERE, YOU MUST ALSO CHANGE IT IN openflow.ml + *) + +type rpc_ack = RpcOk | RpcEof + +type rpc_command = + | GetSwitches + | SwitchesReply of OF10.switchId list + | GetSwitchFeatures of OF10.switchId + | SwitchFeaturesReply of OF10.SwitchFeatures.t option + | Send of OF10.switchId * OF10.xid * OF10.Message.t + | SendReply of rpc_ack + | SendBatch of OF10.switchId * OF10.xid * OF10.Message.t list + | BatchReply of rpc_ack + | GetEvents + | EventsReply of event + | SendTrx of OF10.switchId * OF10.Message.t + | TrxReply of rpc_ack * OF10.Message.t list + | Finished of unit (* This is not sent by the client explicitly *) + +let chan = Ivar.create () + +let (events, events_writer) = Pipe.create () + +let server_sock_addr = Ivar.create () +let server_reader = Ivar.create () +let server_writer = Ivar.create () + +let read_outstanding = ref false +let read_finished = Condition.create () + +module LowLevel = struct + module OF10 = Frenetic_OpenFlow0x01 + + let openflow_executable () = + let prog_alt1 = Filename.dirname(Sys.executable_name) ^ "/openflow" in + let prog_alt2 = Filename.dirname(Sys.executable_name) ^ "/openflow.native" in + Sys.file_exists prog_alt1 + >>= function + | `Yes -> return prog_alt1 + | _ -> Sys.file_exists prog_alt2 + >>= function + | `Yes -> return prog_alt2 + | _ -> failwith (Printf.sprintf "Can't find OpenFlow executable %s!" prog_alt2) + + + let start port = + Log.info "Calling create!"; + let sock_port = 8984 in + let sock_addr = `Inet (Unix.Inet_addr.localhost, sock_port) in + let args = ["-s"; string_of_int sock_port; + "-p"; string_of_int port; + "-v"] in + don't_wait_for ( + Log.info "Current uid: %n" (Unix.getuid ()); + Log.flushed () >>= fun () -> + openflow_executable () >>= fun prog -> + Process.create ~prog ~args () + >>= function + | Error err -> Log.error "Failed to launch openflow server %s!" prog; + raise (Core_kernel.Error.to_exn err) + | Ok proc -> + Log.info "Successfully launched OpenFlow controller with pid %s" (Pid.to_string (Process.pid proc)); + (* Redirect stdout of the child proc to out stdout for logging *) + let buf = String.create 1000 in + don't_wait_for (Deferred.repeat_until_finished () (fun () -> + Reader.read (Process.stdout proc) buf >>| function + | `Eof -> `Finished () + | `Ok n -> `Repeat (Writer.write (Lazy.force Writer.stdout) ~len:n buf))); + Log.info "Connecting to first OpenFlow server socket"; + let rec wait_for_server () = + Monitor.try_with ~extract_exn:true (fun () -> Socket.connect (Socket.create Socket.Type.tcp) sock_addr) >>= function + | Ok sock -> return sock + | Error exn -> Log.info "Failed to open socket to OpenFlow server: %s" (Exn.to_string exn); + Log.info "Retrying in 1 second"; + after (Time.Span.of_sec 1.) + >>= wait_for_server in + wait_for_server () + >>= fun sock -> + Ivar.fill server_sock_addr sock_addr; + Log.info "Successfully connected to first OpenFlow server socket"; + Ivar.fill server_reader (Reader.create (Socket.fd sock)); + Ivar.fill server_writer (Writer.create (Socket.fd sock)); + (* We open a second socket to get the events stream *) + Log.info "Connecting to second OpenFlow server socket"; + Socket.connect (Socket.create Socket.Type.tcp) sock_addr + >>= fun sock -> + Log.info "Successfully connected to second OpenFlow server socket"; + let reader = Reader.create (Socket.fd sock) in + let writer = Writer.create (Socket.fd sock) in + Writer.write_marshal writer ~flags:[] GetEvents; + Deferred.repeat_until_finished () + (fun () -> + Reader.read_marshal reader + >>= function + | `Eof -> + Log.info "OpenFlow controller closed events socket"; + Pipe.close events_writer; + Socket.shutdown sock `Both; + return (`Finished ()) + | `Ok (EventsReply evt) -> + Pipe.write events_writer evt >>| fun () -> + `Repeat () + | `Ok (_) -> + Log.error "Got a message that's not an EventsReply. WTF? Dropping."; + return (`Repeat ()) + ) + ) + + let rec clear_to_read () = if (!read_outstanding) + then Condition.wait read_finished >>= clear_to_read + else return (read_outstanding := true) + + let signal_read () = read_outstanding := false; + Condition.broadcast read_finished () + + let ready_to_process () = + Ivar.read server_reader + >>= fun reader -> + Ivar.read server_writer + >>= fun writer -> + clear_to_read () + >>= fun () -> + let read () = Reader.read_marshal reader >>| function + | `Eof -> Log.error "OpenFlow server socket shutdown unexpectedly!"; + failwith "Can not reach OpenFlow server!" + | `Ok a -> a in + let write = Writer.write_marshal writer ~flags:[] in + return (read, write) + + let send swid xid msg = + ready_to_process () + >>= fun (recv, send) -> + send (Send (swid,xid,msg)); + recv () + >>| function + | SendReply resp -> + signal_read (); resp + | _ -> Log.error "Received a reply that's not SendReply to a Send"; assert false + + let send_batch swid xid msgs = + ready_to_process () + >>= fun (recv, send) -> + send (SendBatch (swid,xid,msgs)); + recv () + >>| function + | BatchReply resp -> + signal_read (); resp + | _ -> Log.error "Received a reply that's not BatchReply to a SendBatch"; assert false + + + (* We open a new socket for each send_txn call so that we can block on the reply *) + let send_txn swid msg = + Ivar.read server_sock_addr + >>= fun sock_addr -> + Socket.connect (Socket.create Socket.Type.tcp) sock_addr + >>= fun sock -> + let reader = Reader.create (Socket.fd sock) in + let writer = Writer.create (Socket.fd sock) in + Writer.write_marshal writer ~flags:[] (SendTrx (swid,msg)); + Reader.read_marshal reader >>| fun resp -> + match resp with + | `Eof -> + Socket.shutdown sock `Both; + TrxReply (RpcEof,[]) + | `Ok (TrxReply (RpcEof,_)) -> + Socket.shutdown sock `Both; + TrxReply (RpcEof,[]) + | `Ok (TrxReply (RpcOk, resp)) -> + Socket.shutdown sock `Both; + TrxReply (RpcOk, resp) + | _ -> + Log.debug "send_txn returned something unintelligible"; + TrxReply (RpcEof,[]) + + let events = events +end + +let start port = + LowLevel.start port + +let switch_features (switch_id : switchId) = + LowLevel.ready_to_process () + >>= fun (recv, send) -> + send (GetSwitchFeatures switch_id); + recv () + >>= function + | SwitchFeaturesReply resp -> + LowLevel.signal_read (); + (match resp with + | Some sf -> return (Some (From0x01.from_switch_features sf)) + | None -> return None) + | _ -> + Log.error "Received a reply that's not SwitchFeaturesReply to a GetSwitchFeatures"; + assert false + +(* We just brute-force this, even though there's significant overlap with from_action *) +let action_from_policy (pol:Frenetic_NetKAT.policy) : action option = + match pol with + | Mod hv -> + begin + match hv with + | Location location -> + begin + match location with + | Physical p -> Some (Output (Physical p)) + | FastFail _ -> None + | Pipe _ -> Some (Output (Controller 128)) + | Query q -> None + end + | EthSrc dlAddr -> + Some (Modify(SetEthSrc dlAddr)) + | EthDst dlAddr -> + Some (Modify(SetEthDst dlAddr)) + | Vlan n -> + Some (Modify(SetVlan (Some n))) + | VlanPcp pcp -> + Some (Modify(SetVlanPcp pcp)) + | EthType dlTyp -> + Some (Modify(SetEthTyp dlTyp)) + | IPProto nwProto -> + Some (Modify(SetIPProto nwProto)) + | IP4Src (nwAddr, mask) -> + Some (Modify(SetIP4Src nwAddr)) + | IP4Dst (nwAddr, mask) -> + Some (Modify(SetIP4Dst nwAddr)) + | TCPSrcPort tpPort -> + Some (Modify(SetTCPSrcPort tpPort)) + | TCPDstPort tpPort -> + Some (Modify(SetTCPDstPort tpPort)) + | Switch _ | VSwitch _ | VPort _ | VFabric _ -> None + end + | _ -> None + +let actions_from_policies pol_list = + List.filter_map pol_list ~f:action_from_policy + +let packet_out + (swid:int64) + (ingress_port:portId option) + (payload:payload) + (pol_list:Frenetic_NetKAT.policy list) = + (* Turn this into a generic PktOut event, then run it through OF10 translator *) + let actions = actions_from_policies pol_list in + let openflow_generic_pkt_out = (payload, ingress_port, actions) in + let pktout0x01 = Frenetic_OpenFlow.To0x01.from_packetOut openflow_generic_pkt_out in + LowLevel.send swid 0l (OF10.Message.PacketOutMsg pktout0x01) >>= function + | RpcEof -> return () + | RpcOk -> return () + +let bogus_flow_stats = { + flow_table_id = 66L; flow_pattern = Pattern.match_all; + flow_actions = []; flow_duration_sec = 0L; flow_duration_nsec = 0L; + flow_priority = 0L; flow_idle_timeout = 0L; flow_hard_timeout = 0L; + flow_packet_count = 0L; flow_byte_count = 0L +} + +(* We aggregate all the OF10 stats and convert them to a generic OpenFlow at the same time *) +let collapse_stats ifrl = + let open OF10 in + { bogus_flow_stats with + flow_packet_count = List.sum (module Int64) ifrl ~f:(fun stat -> stat.packet_count) + ; flow_byte_count = List.sum (module Int64) ifrl ~f:(fun stat -> stat.byte_count) + } + +let flow_stats (sw_id : switchId) (pat: Pattern.t) : flowStats Deferred.t = + let pat0x01 = To0x01.from_pattern pat in + let req = OF10.IndividualRequest + { sr_of_match = pat0x01; sr_table_id = 0xff; sr_out_port = None } in + LowLevel.send_txn sw_id (OF10.Message.StatsRequestMsg req) >>= function + | TrxReply (RpcEof, _) -> assert false + | TrxReply (RpcOk, l) -> (match l with + | [] -> Log.info "Got an empty list"; return bogus_flow_stats + | [hd] -> ( match hd with + | StatsReplyMsg (IndividualFlowRep ifrl) -> + return (collapse_stats ifrl) + | _ -> Log.error "Got a reply, but the type is wrong"; return bogus_flow_stats + ) + | hd :: tl -> Log.info "Got a > 2 element list"; return bogus_flow_stats + ) + | _ -> Log.error "Received a reply that's not TrxReply to a SendTrx"; assert false + +let bogus_port_stats = { + port_no = 666L + ; port_rx_packets = 0L ; port_tx_packets = 0L + ; port_rx_bytes = 0L ; port_tx_bytes = 0L ; port_rx_dropped = 0L + ; port_tx_dropped = 0L ; port_rx_errors = 0L + ; port_tx_errors = 0L ; port_rx_frame_err = 0L + ; port_rx_over_err = 0L ; port_rx_crc_err = 0L + ; port_collisions = 0L +} + +let port_stats (sw_id : switchId) (pid : portId) : portStats Deferred.t = + let pt = Int32.(to_int_exn pid) in + let req = OF10.PortRequest (Some (PhysicalPort pt)) in + LowLevel.send_txn sw_id (OF10.Message.StatsRequestMsg req) >>= function + | TrxReply (RpcEof, _) -> assert false + | TrxReply (RpcOk, l) -> (match l with + | [] -> Log.info "Got an empty list"; return bogus_port_stats + | [hd] -> ( match hd with + | StatsReplyMsg (PortRep psl) -> + return (Frenetic_OpenFlow.From0x01.from_port_stats (List.hd_exn psl)) + | _ -> Log.error "Got a reply, but the type is wrong"; return bogus_port_stats + ) + | hd :: tl -> Log.info "Got a > 2 element list"; return bogus_port_stats + ) + | _ -> Log.error "Received a reply that's not TrxReply to a SendTrx"; assert false + +let get_switches () = + LowLevel.ready_to_process () + >>= fun (recv, send) -> + send GetSwitches; + recv () + >>| function + | SwitchesReply resp -> + LowLevel.signal_read (); resp + | _ -> Log.error "Received a reply that's not SwitchesReply to a GetSwitches"; assert false + +(* TODO: The following is ripped out of Frenetic_NetKAT_Updates. Turns out you can't call +stuff in that because of a circular dependency. In a later version, we should implement +generic commands in Frenetic_OpenFlow (similar to events, but going the opposite +directions), and let openflow.ml translate these to the specifc version of OpenFlow. That +way, we can simply pass a plugin instance where the update can write to. *) + +module BestEffortUpdate0x01 = struct + module Comp = Frenetic_NetKAT_Compiler + module M = OF10.Message + open Frenetic_OpenFlow.To0x01 + + exception UpdateError + + let current_compiler_options = + ref Comp.default_compiler_options + + let restrict sw_id repr = + Comp.restrict Frenetic_NetKAT.(Switch sw_id) repr + + let install_flows_for sw_id table = + let to_flow_mod p f = M.FlowModMsg (from_flow p f) in + let priority = ref 65536 in + let flows = List.map table ~f:(fun flow -> + decr priority; + to_flow_mod !priority flow) in + LowLevel.send_batch sw_id 0l flows >>= function + | RpcEof -> raise UpdateError + | RpcOk -> return () + + let delete_flows_for sw_id = + let delete_flows = M.FlowModMsg OF10.delete_all_flows in + LowLevel.send sw_id 5l delete_flows >>= function + | RpcEof -> raise UpdateError + | RpcOk -> return () + + let bring_up_switch (sw_id : switchId) new_r = + let table = Comp.to_table ~options:!current_compiler_options sw_id new_r in + Log.debug "Setting up flow table\n%s" + (Frenetic_OpenFlow.string_of_flowTable ~label:(Int64.to_string sw_id) table); + Monitor.try_with ~name:"BestEffort.bring_up_switch" (fun () -> + delete_flows_for sw_id >>= fun _ -> + install_flows_for sw_id table) + >>= function + | Ok x -> return x + | Error _exn -> + Log.debug + "switch %Lu: disconnected while attempting to bring up... skipping" sw_id; + Log.flushed () >>| fun () -> + Log.error "%s\n%!" (Exn.to_string _exn) + + let implement_policy repr = + (get_switches ()) >>= fun switches -> + Deferred.List.iter switches (fun sw_id -> + bring_up_switch sw_id repr) + + let set_current_compiler_options opt = + current_compiler_options := opt +end + +let update (compiler: Frenetic_NetKAT_Compiler.t) = + BestEffortUpdate0x01.implement_policy compiler + +let update_switch (swid: switchId) (compiler: Frenetic_NetKAT_Compiler.t) = + BestEffortUpdate0x01.bring_up_switch swid compiler diff --git a/async/Frenetic_OpenFlow0x01_Plugin.mli b/async/Frenetic_OpenFlow0x01_Plugin.mli new file mode 100644 index 000000000..79a677efd --- /dev/null +++ b/async/Frenetic_OpenFlow0x01_Plugin.mli @@ -0,0 +1,35 @@ +open Core.Std +open Async.Std +open Frenetic_OpenFlow + +(* plugin function implementations *) + +val start: int -> unit + +val events : event Pipe.Reader.t + +val switch_features : switchId -> switchFeatures option Deferred.t + +val packet_out : switchId -> portId option -> payload -> Frenetic_NetKAT.policy list -> unit Deferred.t + +val flow_stats : switchId -> Pattern.t -> flowStats Deferred.t + +val port_stats : switchId -> portId -> portStats Deferred.t + +val update : Frenetic_NetKAT_Compiler.t -> unit Deferred.t + +val update_switch : switchId -> Frenetic_NetKAT_Compiler.t -> unit Deferred.t + +(* Low-level interface for Frenetic_Ox programming *) + +type rpc_ack = RpcOk | RpcEof + +module LowLevel : sig + module OF10 = Frenetic_OpenFlow0x01 + + val start: int -> unit + + val send : OF10.switchId -> OF10.xid -> OF10.Message.t -> rpc_ack Deferred.t + + val events : event Pipe.Reader.t +end \ No newline at end of file diff --git a/async/Frenetic_OpenFlow0x04_Controller.ml b/async/Frenetic_OpenFlow0x04_Plugin.ml similarity index 100% rename from async/Frenetic_OpenFlow0x04_Controller.ml rename to async/Frenetic_OpenFlow0x04_Plugin.ml diff --git a/async/Frenetic_OpenFlow0x04_Controller.mli b/async/Frenetic_OpenFlow0x04_Plugin.mli similarity index 100% rename from async/Frenetic_OpenFlow0x04_Controller.mli rename to async/Frenetic_OpenFlow0x04_Plugin.mli diff --git a/async/Frenetic_Ox.ml b/async/Frenetic_Ox.ml index ad0f29aa9..dbfbaa98b 100644 --- a/async/Frenetic_Ox.ml +++ b/async/Frenetic_Ox.ml @@ -75,48 +75,66 @@ module Platform = struct >>> fun () -> munge_exns thk end + module Make (Handlers:OXMODULE) = struct - module Controller = Frenetic_OpenFlow0x01_Controller - + module Controller = Frenetic_OpenFlow0x01_Plugin.LowLevel + let handle_pkt_out ((sw, xid, msg) : to_sw) : unit Deferred.t = + let open Frenetic_OpenFlow0x01_Plugin in Controller.send sw xid msg >>= function - | `Ok -> + | RpcOk -> return () - | `Eof -> + | RpcEof -> Log.error ~tags "unhandled exception sending message to switch %Ld" sw; return () - let handler (e:Controller.event) : unit Deferred.t = + let handler (evt:Frenetic_OpenFlow.event) : unit Deferred.t = let open Message in let open FlowMod in let open SwitchFeatures in - match e with - | `Connect (sw, feats) -> + match evt with + | SwitchUp (sw, feats) -> let res1 = Controller.send sw 0l (FlowModMsg delete_all_flows) in let res2 = Controller.send sw 1l BarrierRequest in (Deferred.both res1 res2 >>| function - | `Ok, `Ok -> - let sw = feats.switch_id in - Handlers.switch_connected sw feats + | RpcOk, RpcOk -> + let sf = Frenetic_OpenFlow.{switch_id = sw; switch_ports = feats} in + Handlers.switch_connected sw (Frenetic_OpenFlow.To0x01.from_switch_features sf) | _ -> ()) - | `Message (sw,hdr, msg) -> - return - (match msg with - | PacketInMsg pktIn -> Handlers.packet_in sw hdr.xid pktIn - | BarrierReply -> Handlers.barrier_reply sw hdr.xid - | StatsReplyMsg rep -> Handlers.stats_reply sw hdr.xid rep - | msg -> Log.info ~tags "ignored a message from %Ld" sw) - | `Disconnect sw -> + | SwitchDown sw -> Log.info "switch %Ld disconnected\n%!" sw; return () + | PortUp (sw,port) -> + Log.info "Port %ld on Switch %Ld connected\n%!" port sw; + return () + | PortDown (sw,port) -> + Log.info "Port %ld on Switch %Ld disconnected\n%!" port sw; + return () + | PacketIn (pipe,sw,port,pl,total_len,reason) -> + let open Frenetic_OpenFlow.To0x01 in + let pktIn = { + input_payload = from_payload pl + ; total_len = total_len + ; port = Int32.to_int_exn port + ; reason = from_packet_in_reason reason + } in + return (Handlers.packet_in sw 0l pktIn) + | PortStats (sw,rep) -> assert false + | FlowStats (sw,rep) -> assert false + (* + | PortStats (sw,rep) + | FlowStats (sw,rep) -> + let (_, rep) = message_from_event evt in + return (Handlers.stats_reply sw 0l rep) + *) let start () : unit = (* intentionally on stdout *) Format.printf "Ox controller launching...\n%!"; INRIASys.catch_break true; - Controller.init 6633 ; + Controller.start 6633 ; Deferred.don't_wait_for (Monitor.try_with ~name:"controller" (fun () -> Deferred.both diff --git a/async/Frenetic_Shell.ml b/async/Frenetic_Shell.ml index 4d3872f02..a3e439e8a 100644 --- a/async/Frenetic_Shell.ml +++ b/async/Frenetic_Shell.ml @@ -2,7 +2,7 @@ open Core.Std open Async.Std open Frenetic_NetKAT -module Controller = Frenetic_NetKAT_Controller.Make +module Controller = Frenetic_NetKAT_Controller.Make(Frenetic_OpenFlow0x01_Plugin) module Comp = Frenetic_NetKAT_Compiler module Field = Frenetic_Fdd.Field module Log = Frenetic_Log @@ -306,7 +306,7 @@ let load_file (filename : string) : unit = | Ok p -> policy := (p, policy_string); printf "%s\n%!" policy_string; - don't_wait_for (Controller.update_policy p) + don't_wait_for (Controller.update p) | Error msg -> print_endline msg with | Sys_error msg -> printf "Load failed: %s\n%!" msg @@ -327,7 +327,7 @@ let rec repl () : unit Deferred.t = | Some (Show (FlowTable t)) -> print_policy_table t | Some (Update (pol, pol_str)) -> policy := (pol, pol_str); - don't_wait_for (Controller.update_policy pol) + don't_wait_for (Controller.update pol) | Some (Load filename) -> load_file filename | Some (Order order) -> set_order order | Some (ToggleRemoveTailDrops) -> toggle_remove_tail_drops () diff --git a/async/async.mldylib b/async/async.mldylib index dd49901d5..321120372 100644 --- a/async/async.mldylib +++ b/async/async.mldylib @@ -1,11 +1,10 @@ # OASIS_START -# DO NOT EDIT (digest: 449f69178a54a84a122ebc3e258ebd94) +# DO NOT EDIT (digest: 4885011f14a1a132b11c91868bc127d1) Frenetic_Compile_Server Frenetic_Log Frenetic_Http_Controller -Frenetic_OpenFlow0x01_Controller +Frenetic_OpenFlow0x01_Plugin Frenetic_NetKAT_Controller -Frenetic_NetKAT_Updates Frenetic_Ox Frenetic_Common Frenetic_DynGraph diff --git a/async/async.mllib b/async/async.mllib index dd49901d5..321120372 100644 --- a/async/async.mllib +++ b/async/async.mllib @@ -1,11 +1,10 @@ # OASIS_START -# DO NOT EDIT (digest: 449f69178a54a84a122ebc3e258ebd94) +# DO NOT EDIT (digest: 4885011f14a1a132b11c91868bc127d1) Frenetic_Compile_Server Frenetic_Log Frenetic_Http_Controller -Frenetic_OpenFlow0x01_Controller +Frenetic_OpenFlow0x01_Plugin Frenetic_NetKAT_Controller -Frenetic_NetKAT_Updates Frenetic_Ox Frenetic_Common Frenetic_DynGraph diff --git a/examples/Learning_Switch.ml b/examples/Learning_Switch.ml index 0e7564db7..354dc6e62 100644 --- a/examples/Learning_Switch.ml +++ b/examples/Learning_Switch.ml @@ -4,7 +4,7 @@ open Core.Std open Frenetic_OpenFlow0x01 open Frenetic_OpenFlow0x01.Message -module OF0x01Controller = Frenetic_OpenFlow0x01_Controller +module OF0x01Controller = Frenetic_OpenFlow0x01_Plugin module SwitchTable = Map.Make(Int64) diff --git a/frenetic/frenetic.ml b/frenetic/frenetic.ml index 2e978fe68..91886a1b1 100644 --- a/frenetic/frenetic.ml +++ b/frenetic/frenetic.ml @@ -131,7 +131,7 @@ let openflow13_controller : Command.t = +> Flag.table_fields ++ default_spec) (fun openflow_port policy_file table_fields -> - run (Frenetic_OpenFlow0x04_Controller.main openflow_port policy_file table_fields)) + run (Frenetic_OpenFlow0x04_Plugin.main openflow_port policy_file table_fields)) let openflow13_fault_tolerant_controller : Command.t = Command.basic @@ -142,7 +142,7 @@ let openflow13_fault_tolerant_controller : Command.t = +> Flag.topology_file ++ default_spec) (fun openflow_port policy_file topology_file -> - run (Frenetic_OpenFlow0x04_Controller.fault_tolerant_main + run (Frenetic_OpenFlow0x04_Plugin.fault_tolerant_main openflow_port policy_file topology_file)) let main : Command.t = diff --git a/frenetic/openflow.ml b/frenetic/openflow.ml index 9dbd8f920..56f17765c 100644 --- a/frenetic/openflow.ml +++ b/frenetic/openflow.ml @@ -2,12 +2,41 @@ open Core.Std open Async.Std open Frenetic_OpenFlow0x01 module Log = Frenetic_Log +module ToGeneric = Frenetic_OpenFlow.From0x01 -type event = [ - | `Connect of switchId * SwitchFeatures.t - | `Disconnect of switchId - | `Message of switchId * Frenetic_OpenFlow_Header.t * Message.t -] +type event = Frenetic_OpenFlow.event + +(* TODO: This protocol needs to be cleaned up. It makes more sense to define the + RPC protocol in Frenetic_OpenFlow, but we can't at the moment because Send sends + OpenFlow0x01 messages. It should be the job of openflow.ml to convert 1.x specific + messages to the generic OpenFlow messages and pass them over the pipe to Frenetic. + + IF YOU CHANGE THE PROTOCOL HERE, YOU MUST ALSO CHANGE IT IN Frenetic_OpenFlow0x01_Plugin. + Unfortunately, we can't just plop this in Frenetic_OpenFlow0x01 (because it references + Frenetic_OpenFlow) or Frenetic_OpenFlow (because it references Frenetic_OpenFlow0x01). We + could have put it in its own module, but I dont' want to give legitimacy to something + that's transitional. + *) + +type rpc_ack = RpcOk | RpcEof + +(* Don't send this over RPC. You'll be sorry! *) +type trx_status = Done | Unfulfilled of Message.t list Deferred.t + +type rpc_command = + | GetSwitches + | SwitchesReply of switchId list + | GetSwitchFeatures of switchId + | SwitchFeaturesReply of SwitchFeatures.t option + | Send of switchId * xid * Message.t + | SendReply of rpc_ack + | SendBatch of switchId * xid * Message.t list + | BatchReply of rpc_ack + | GetEvents + | EventsReply of event + | SendTrx of switchId * Message.t + | TrxReply of rpc_ack * Message.t list + | Finished of unit (* This is not sent by the client explicitly *) let (events, events_writer) : event Pipe.Reader.t * event Pipe.Writer.t = Pipe.create () @@ -80,7 +109,12 @@ let client_handler (a:Socket.Address.Inet.t) (r:Reader.t) (w:Writer.t) : unit De | Initial, `Eof -> return () | Initial, `Ok (hdr,Hello bytes) -> - (* TODO(jnf): check version? *) + (* We could check the version here, but OpenFlow will respond with a HELLO of + the latest supported version. 0x04 sends a bitmap of supported versions in the + payload, but that requires a 0x04 translation in a 0x01 plugin, which is crazy. + It's better just to blow up if the switch doesn't support 0x01, which is + what would happen anyway. A 0x04 version of openflow.ml will check the version + correctly because it has a HELLO processor. *) serialize 0l SwitchFeaturesRequest; loop SentSwitchFeatures | Initial, `Ok(hdr,msg) -> @@ -105,27 +139,31 @@ let client_handler (a:Socket.Address.Inet.t) (r:Reader.t) (w:Writer.t) : unit De serialize xid msg; Ivar.read ivar; in + let generic_sw_f = ToGeneric.from_switch_features features in + let port_list = generic_sw_f.switch_ports in Hashtbl.Poly.add_exn switches ~key:switchId ~data:{ features; send; send_txn }; - Log.debug "Switch %s connected" (string_of_switchId switchId); - Pipe.write_without_pushback events_writer (`Connect (switchId, features)); + Log.debug "Switch %s connected%!" (string_of_switchId switchId); + Pipe.write_without_pushback events_writer (SwitchUp (switchId, port_list)); loop (Connected threadState) (* TODO: Queue up these messages and deliver them when we're done connecting *) | SentSwitchFeatures, `Ok (hdr,msg) -> - Log.debug "Dropping unexpected msg received before SwitchFeatures response: %s" (Message.to_string msg); + Log.debug "Dropping unexpected msg received before SwitchFeatures response: %s%!" (Message.to_string msg); loop state (* Connected *) | Connected threadState, `Eof -> Hashtbl.Poly.remove switches threadState.switchId; - Log.debug "Switch %s disconnected" (string_of_switchId threadState.switchId); - Pipe.write_without_pushback events_writer (`Disconnect threadState.switchId); + Log.debug "Switch %s disconnected%!" (string_of_switchId threadState.switchId); + Pipe.write_without_pushback events_writer (SwitchDown threadState.switchId); return () | Connected threadState, `Ok (hdr, msg) -> - (* TODO: Am not sure we should be writing a transactional response to the event writer *) - Pipe.write_without_pushback events_writer (`Message (threadState.switchId, hdr, msg)); + let generic_openflow_event = ToGeneric.event_from_message threadState.switchId msg in + let goe = Option.value ~default:(SwitchDown 0L) generic_openflow_event in + Log.info "Writing event response %s%!" (Frenetic_OpenFlow.string_of_event goe); + Pipe.write_without_pushback events_writer goe; (match Hashtbl.Poly.find threadState.txns hdr.xid with | None -> () - | Some (ivar,msgs) -> + | Some (ivar ,msgs) -> Hashtbl.Poly.remove threadState.txns hdr.xid; (* Am not sure why this is a list, since there will never be more than one. The above line removes the hash entry so it'll never come up again. *) @@ -147,64 +185,73 @@ let send switchId xid msg = match Hashtbl.Poly.find switches switchId with | Some switchState -> switchState.send xid msg; - `Ok + RpcOk | None -> - `Eof + RpcEof let send_batch switchId xid msgs = match Hashtbl.Poly.find switches switchId with | Some switchState -> List.iter msgs ~f:(switchState.send xid); - `Ok + RpcOk | None -> - `Eof + RpcEof let send_txn switchId msg = match Hashtbl.Poly.find switches switchId with | Some switchState -> (* The following returns a Deferred which will be fulfilled when a matching response is received *) - `Ok (switchState.send_txn msg) + Unfulfilled (switchState.send_txn msg) | None -> - `Eof + Done let rpc_handler (a:Socket.Address.Inet.t) (reader:Reader.t) (writer:Writer.t) : unit Deferred.t = let read () = Reader.read_marshal reader >>| function | `Eof -> Log.error "Upstream socket closed unexpectedly!"; - `Finished () + Finished () | `Ok a -> a in let write = Writer.write_marshal writer ~flags:[] in Deferred.repeat_until_finished () (fun () -> read () >>= function - | `Finished () -> return (`Finished ()) - | `Get_switches -> + | Finished () -> return (`Finished ()) + | GetSwitches -> let switches = get_switches () in - write (`Get_switches_resp switches); + write (SwitchesReply switches); return (`Repeat ()) - | `Get_switch_features sw_id -> - write (`Get_switch_features_resp (get_switch_features sw_id)); + | GetSwitchFeatures sw_id -> + write (SwitchFeaturesReply (get_switch_features sw_id)); return (`Repeat ()) - | `Send (sw_id, xid, msg) -> - write (`Send_resp (send sw_id xid msg)); + | Send (sw_id, xid, msg) -> + write (SendReply (send sw_id xid msg)); return (`Repeat ()) - | `Send_batch (sw_id, xid, msgs) -> - write (`Send_batch_resp (send_batch sw_id xid msgs)); + | SendBatch (sw_id, xid, msgs) -> + write (BatchReply (send_batch sw_id xid msgs)); return (`Repeat ()) - | `Events -> + | GetEvents -> Pipe.iter_without_pushback events - ~f:(fun evt -> - write (`Events_resp evt)) >>| fun () -> + ~f:(fun evt -> write (EventsReply evt)) + >>| fun () -> Log.error "Event stream stopped unexpectedly!"; - `Finished () - | `Send_txn (swid, msg) -> + `Finished () (* You don't need a return here, because of the >>| operator *) + | SwitchesReply _ + | SwitchFeaturesReply _ + | SendReply _ + | BatchReply _ + | EventsReply _ + | TrxReply (_, _) -> + Log.error("Reply sent from client. Wrong direction!"); + return (`Repeat ()) + | SendTrx (swid, msg) -> let run_trx = send_txn swid msg in let () = match run_trx with - | `Eof -> write (`Send_trx_rep `Eof) - | `Ok ivar_deferred -> + | Done -> write (TrxReply (RpcEof, [])) + | Unfulfilled ivar_deferred -> + Log.info "Wrote Transaction repsonse"; upon ivar_deferred - (fun collected_responses -> write (`Send_txn_resp (`Ok (`Ok collected_responses)))) - in - return (`Repeat ())) + (fun collected_responses -> write (TrxReply (RpcOk, collected_responses))) + in + return (`Repeat ())) let run_server port rpc_port = don't_wait_for diff --git a/lang/python/frenetic/__init__.py b/lang/python/frenetic/__init__.py index 8366602d5..329510fa6 100644 --- a/lang/python/frenetic/__init__.py +++ b/lang/python/frenetic/__init__.py @@ -49,8 +49,11 @@ def packet(self, payload, protocol): return p return None - def pkt_out(self, switch_id, payload, actions, in_port=None): - msg = PacketOut(switch=switch_id, payload=payload, actions=actions, in_port=in_port) + def pkt_out(self, switch_id, payload, actions, in_port=None, policies=None): + # Renamed actions to policies in the internal API to make it clearer, but + # kept actions keyword for backward compatibility. + _policies = policies if policies != None else actions + msg = PacketOut(switch=switch_id, payload=payload, policies=_policies, in_port=in_port) pkt_out_url = "http://%s:%s/pkt_out" % (self.frenetic_http_host, self.frenetic_http_port) request = HTTPRequest(pkt_out_url, method='POST', body=json.dumps(msg.to_json())) return self.__http_client.fetch(request) @@ -158,8 +161,12 @@ def __poll_event(self): def __handle_event(self, response): try: event = json.loads(response.result().body) - - typ = event['type'] + # For some reason, port stats are leaking into the event queue, so + # just get them out + if isinstance(event, list) or 'type' not in event: + typ = "UNKNOWN" + else: + typ = event['type'] if typ == 'switch_up': switch_id = event['switch_id'] ports = event['ports'] @@ -178,8 +185,6 @@ def __handle_event(self, response): elif typ == 'packet_in': pk = PacketIn(event) self.packet_in(pk.switch_id, pk.port_id, pk.payload) - else: - print response self.__poll_event() diff --git a/lang/python/frenetic/syntax.py b/lang/python/frenetic/syntax.py index 522912c77..ca1569c2c 100644 --- a/lang/python/frenetic/syntax.py +++ b/lang/python/frenetic/syntax.py @@ -63,52 +63,52 @@ def to_json(self): class PacketOut(object): - def __init__(self, switch, payload, actions, in_port = None): + def __init__(self, switch, payload, policies, in_port = None): assert type(switch) == int and switch >= 0 self.switch = switch assert isinstance(payload,Buffered) or isinstance(payload,NotBuffered) self.payload = payload - assert isinstance(actions,list) or isinstance(actions, Seq) or \ - isinstance(actions,SinglePolicy) or isinstance(actions,SetPort) + assert isinstance(policies,list) or isinstance(policies, Seq) or \ + isinstance(policies,SinglePolicy) or isinstance(policies,SetPort) - # We flatten all Sequences into lists of actions. (We don't do this for + # We flatten a Sequence into a list of policies. (We don't do this for # Unions because packet outs can't send out parallel packets except for # multiple ports, which we deal with separately.) - if isinstance(actions, Seq): - actions = actions.children - elif isinstance(actions,SinglePolicy) or isinstance(actions,SetPort): - actions = [actions] + if isinstance(policies, Seq): + policies = policies.children + elif isinstance(policies,SinglePolicy) or isinstance(policies,SetPort): + policies = [policies] - scrubbed_actions = [] - for action in actions: + scrubbed_policies = [] + for action in policies: assert isinstance(action, Mod) or isinstance(action, Output) or \ isinstance(action,SinglePolicy) or isinstance(action,SetPort) - # In Frenetic 4.0, Mod(Location()) is not accepted. When the plugin architecture - # of 4.1 is instated, this will change, but for the time being, convert a Mod(Location()) - # to an Output for convenience - if isinstance(action, Mod): + # In Frenetic 4.1, Output is no longer accepted because Output is not a NetKAT + # policy. Convert all Output's to Mod(Location()) + if isinstance(action, Output): + ps = action.pseudoport + scrubbed_policies.append(Mod(Location(ps))) + elif isinstance(action, Mod): if action.hv.header == "location": assert isinstance(action.hv.value, Physical), "Only port outputs are allowed in pkt_out" - scrubbed_actions.append(Output(Physical(action.hv.value.port))) - else: - scrubbed_actions.append(action) + scrubbed_policies.append(action) # A SetPort might have many destinations, so we convert them here. elif isinstance(action, SetPort): for p in action.port_list: - scrubbed_actions.append(Output(Physical(p))) + scrubbed_policies.append(Mod(Location(Physical(p)))) # All others have no scrubbing involved else: - scrubbed_actions.append(action) + scrubbed_policies.append(action) - self.actions = scrubbed_actions + self.policies = scrubbed_policies assert in_port == None or (type(in_port) == int and in_port >= 0) self.in_port = in_port def to_json(self): return { "switch": self.switch, "in_port": self.in_port, - "actions": [ action.to_json() for action in self.actions ], + "policies": [ action.to_json() for action in self.policies ], "payload": self.payload.to_json() } class PacketIn(object): diff --git a/lib/Frenetic_NetKAT.ml b/lib/Frenetic_NetKAT.ml index c8030b352..fbd8ee786 100644 --- a/lib/Frenetic_NetKAT.ml +++ b/lib/Frenetic_NetKAT.ml @@ -68,15 +68,3 @@ type host = Frenetic_Packet.dlAddr * Frenetic_Packet.nwAddr [@@deriving sexp] type bufferId = Int32.t [@@deriving sexp] (* XXX(seliopou): different than Frenetic_OpenFlow *) -type event = - | PacketIn of string * switchId * portId * payload * int - | Query of string * int64 * int64 - | SwitchUp of switchId * portId list - | SwitchDown of switchId - | PortUp of switch_port - | PortDown of switch_port - | LinkUp of switch_port * switch_port - | LinkDown of switch_port * switch_port - | HostUp of switch_port * host - | HostDown of switch_port * host - [@@deriving sexp] diff --git a/lib/Frenetic_NetKAT.mli b/lib/Frenetic_NetKAT.mli index 09fa8015d..c0f6574ec 100644 --- a/lib/Frenetic_NetKAT.mli +++ b/lib/Frenetic_NetKAT.mli @@ -83,15 +83,3 @@ type host = Frenetic_Packet.dlAddr * Frenetic_Packet.nwAddr [@@deriving sexp] type bufferId = Int32.t [@@deriving sexp] (* XXX(seliopou): different than Frenetic_OpenFlow *) -type event = - | PacketIn of string * switchId * portId * payload * int - | Query of string * int64 * int64 - | SwitchUp of switchId * portId list - | SwitchDown of switchId - | PortUp of switch_port - | PortDown of switch_port - | LinkUp of switch_port * switch_port - | LinkDown of switch_port * switch_port - | HostUp of switch_port * host - | HostDown of switch_port * host - [@@deriving sexp] diff --git a/lib/Frenetic_NetKAT_Json.ml b/lib/Frenetic_NetKAT_Json.ml index 89b7c9c36..ec92fe1ef 100644 --- a/lib/Frenetic_NetKAT_Json.ml +++ b/lib/Frenetic_NetKAT_Json.ml @@ -10,7 +10,9 @@ open Yojson.Basic open Frenetic_NetKAT open Frenetic_NetKAT_Optimize -(** IP & MAC Addresses **) + +(** Optimize & MAC Addresses **) + let string_of_mac = Frenetic_Packet.string_of_mac let mac_of_string = Frenetic_Packet.mac_of_string @@ -174,7 +176,6 @@ let rec policy_of_json (json : json) : policy = json |> member "pt2" |> to_int |> int_to_uint32) | str -> raise (Invalid_argument ("invalid policy type " ^ str)) - (* by default, Yojson produces non-standard JSON *) let policy_to_json_string (pol : policy) : string = Yojson.Basic.to_string ~std:true (policy_to_json pol) @@ -185,10 +186,178 @@ let policy_of_json_string (str : string) : policy = let policy_of_json_channel (chan : In_channel.t) : policy = policy_of_json (from_channel chan) +let stats_to_json ((pkts, bytes) : Int64.t * Int64.t) : json = + `Assoc [("packets", `Int (Int64.to_int_exn pkts)); + ("bytes", `Int (Int64.to_int_exn bytes))] + +let stats_to_json_string (stats : Int64.t * Int64.t) : string = + Yojson.Basic.to_string ~std:true (stats_to_json stats) + +open Frenetic_OpenFlow +let pseudoport_from_json (json : json) : pseudoport = + let open Yojson.Basic.Util in + match json |> member "type" |> to_string with + | "physical" -> Physical (json |> member "port" |> to_int |> Int32.of_int_exn) + | "inport" -> InPort + | "table" -> Table + | "normal" -> Normal + | "flood" -> Flood + | "all" -> All + | "controller" -> Controller (json |> member "bytes" |> to_int) + | "local" -> Local + | str -> failwith ("invalid pseudoport type: " ^ str) + +let pseudoport_to_json (p : pseudoport) = match p with + | Physical n -> `Assoc [("type", `String "physical"); + ("port", `Int (Int32.to_int_exn n))] + | InPort -> `Assoc [("type", `String "inport")] + | Table -> `Assoc [("type", `String "table")] + | Normal -> `Assoc [("type", `String "normal")] + | Flood -> `Assoc [("type", `String "flood")] + | All -> `Assoc [("type", `String "all")] + | Local -> `Assoc [("type", `String "local")] + | Controller n -> `Assoc [("type", `String "controller"); + ("bytes", `Int n)] + +let payload_from_json (json : json) : payload = + let open Yojson.Basic.Util in + match json |> member "type" |> to_string with + | "notbuffered" -> + let base64 = json |> member "data" |> to_string in + NotBuffered (Cstruct.of_string (B64.decode base64)) + | "buffered" -> + let bufferId = Int32.of_int_exn (json |> member "bufferid" |> to_int) in + (* TODO(arjun): Why does Buffered take a second argument. Won't it be ignored + if a buffer ID is specified? *) + Buffered (bufferId, Cstruct.of_string "") + | _ -> failwith "invalid payload" + +let int32_option_from_json (json : json) : Int32.t option = + let open Yojson.Basic.Util in + match to_int_option json with + | None -> None + | Some n -> Some (Int32.of_int_exn n) + +let policies_of_json (json: json) : policy list = + let open Yojson.Basic.Util in + json |> to_list |> List.map ~f:policy_of_json + +let ingress_port_of_json (json: json) : portId option = + let open Yojson.Basic.Util in + match json |> to_int_option with + | None -> None + | Some n -> Int32.of_int n + +let pkt_out_from_json (json : json) : switchId * portId option * payload * policy list = + let open Yojson.Basic.Util in + let switch = json |> member "switch" |> to_int |> Int64.of_int in + let payload = json |> member "payload" |> payload_from_json in + let policies = json |> member "policies" |> policies_of_json in + let in_port = json |> member "in_port" |> ingress_port_of_json in + (switch, in_port, payload, policies) + +let pattern_to_json (p:Pattern.t) : json = + let open Pattern in + let str_field f = function + | None -> `Null + | Some x -> `String (f x) in + let int_field f = function + | None -> `Null + | Some x -> `Int (f x) in + `Assoc [ + ("dlSrc", str_field Frenetic_Packet.string_of_mac p.dlSrc); + ("dlDst", str_field Frenetic_Packet.string_of_mac p.dlDst); + ("dlTyp", int_field ident p.dlTyp); + ("dlVlan", int_field ident p.dlVlan); + ("dlVlanPcp", int_field ident p.dlVlanPcp); + ("nwSrc", str_field Pattern.Ip.string_of p.nwSrc); + ("nwDst", str_field Pattern.Ip.string_of p.nwDst); + ("nwProto", int_field ident p.nwProto); + ("tpSrc", int_field ident p.tpSrc); + ("tpDst", int_field ident p.tpDst); + ("inPort", int_field Int32.to_int_exn p.inPort) ] + +let modify_to_json (m : modify) : json = match m with + | SetEthSrc m -> + `List [`String "SetDlSrc"; `String (Frenetic_Packet.string_of_mac m)] + | SetEthDst m -> + `List [`String "SetDlDst"; `String (Frenetic_Packet.string_of_mac m)] + | SetVlan o -> + `List [`String "SetVlan"; `Int (match o with None -> 0xffff | Some n -> n)] + | SetVlanPcp n -> + `List [`String "SetVlanPcp"; `Int n] + | SetEthTyp n -> + `List [`String "SetDlTyp"; `Int n] + | SetIPProto n -> + `List [`String "SetNwProto"; `Int n] + | SetIP4Src n -> + `List [`String "SetNwSrc"; `String (Frenetic_Packet.string_of_ip n)] + | SetIP4Dst n -> + `List [`String "SetNwDst"; `String (Frenetic_Packet.string_of_ip n)] + | SetTCPSrcPort n -> + `List [`String "SetTpSrc"; `Int n] + | SetTCPDstPort n -> + `List [`String "SetTpDst"; `Int n] + +let action_to_json (a : action) : json = match a with + | Output p -> `List [`String "Output"; pseudoport_to_json p] + | Enqueue (p, q) -> + `List [`String "Enqueue"; + `Int (Int32.to_int_exn p); + `Int (Int32.to_int_exn q)] + | Modify m -> + `List [`String "Modify"; modify_to_json m] + (* TODO(grouptable): who gets this json? *) + | FastFail p_lst -> failwith "Not Yet Implemented" + +let seq_to_json (s : seq) : json =`List (List.map ~f:action_to_json s) + +let par_to_json (p : par) : json = `List (List.map ~f:seq_to_json p) + +let action_to_json (g : group) : json = match g with + | [p] -> par_to_json p + | _ -> failwith "NYI: serializing groups with multiple buckets" + +let timeout_to_json (t : timeout) : json = match t with + | Permanent -> `String "Permanent" + | ExpiresAfter n -> `List [`String "ExpiresAfter"; `Int n] + +let flow_to_json (n : int) (f : flow) : json = + `Assoc [ + ("priority", `Int n); + ("pattern", pattern_to_json f.pattern); + ("action", action_to_json f.action); + ("cookie", `String (Int64.to_string f.cookie)); + ("idle_timeout", timeout_to_json f.idle_timeout); + ("hard_timeout", timeout_to_json f.hard_timeout) + ] + +let flowTable_to_json (tbl : flowTable) : json = + let priorities = List.range ~stride:(-1) 65535 (65535 - List.length tbl) in + `List (List.map2_exn ~f:flow_to_json priorities tbl) + +let port_stat_to_json (portStat: Frenetic_OpenFlow.portStats) : json = + `Assoc [("port_no", `Int (Int64.to_int_exn portStat.port_no)); + ("rx_packets", `Int (Int64.to_int_exn portStat.port_rx_packets)); + ("tx_packets", `Int (Int64.to_int_exn portStat.port_tx_packets)); + ("rx_bytes", `Int (Int64.to_int_exn portStat.port_rx_bytes)); + ("tx_bytes", `Int (Int64.to_int_exn portStat.port_tx_bytes)); + ("rx_dropped", `Int (Int64.to_int_exn portStat.port_rx_dropped)); + ("tx_dropped", `Int (Int64.to_int_exn portStat.port_tx_dropped)); + ("rx_errors", `Int (Int64.to_int_exn portStat.port_rx_errors)); + ("tx_errors", `Int (Int64.to_int_exn portStat.port_tx_errors)); + ("rx_fram_err", `Int (Int64.to_int_exn portStat.port_rx_frame_err)); + ("rx_over_err", `Int (Int64.to_int_exn portStat.port_rx_over_err)); + ("rx_crc_err", `Int (Int64.to_int_exn portStat.port_rx_crc_err)); + ("collisions", `Int (Int64.to_int_exn portStat.port_collisions))] + +let port_stat_to_json_string (portStat: Frenetic_OpenFlow.portStats) : string = + Yojson.Basic.to_string ~std:true (port_stat_to_json portStat) + let event_to_json (event : event) : json = let open Yojson.Basic.Util in match event with - | PacketIn (pipe, sw_id, pt_id, payload, len) -> + | PacketIn (pipe, sw_id, pt_id, payload, len, reason) -> let buffer = Frenetic_OpenFlow.payload_bytes payload |> Cstruct.to_string |> B64.encode in @@ -205,12 +374,6 @@ let event_to_json (event : event) : json = ]); ("length", `Int len) ] - | Query (name, pkt_count, byte_count) -> - `Assoc [ - ("type", `String "query"); - ("packet_count", `Int (Int64.to_int_exn pkt_count)); - ("byte_count", `Int (Int64.to_int_exn byte_count)) - ] | SwitchUp (sw_id, ports) -> let json_ports = List.map ports (fun port -> `Int (Int32.to_int_exn port)) in `Assoc [ @@ -235,67 +398,14 @@ let event_to_json (event : event) : json = ("switch_id", `Int (Int64.to_int_exn sw_id)); ("port_id", `Int (Int32.to_int_exn pt_id)) ] - | LinkUp ((sw_id1, pt_id1), (sw_id2, pt_id2)) -> - `Assoc [ - ("type", `String "link_up"); - ("src", `Assoc [("switch_id", `Int (Int64.to_int_exn sw_id1)); - ("port_id", `Int (Int32.to_int_exn pt_id1))]); - ("dst", `Assoc [("switch_id", `Int (Int64.to_int_exn sw_id2)); - ("port_id", `Int (Int32.to_int_exn pt_id2))]) - ] - | LinkDown ((sw_id1, pt_id1), (sw_id2, pt_id2)) -> + | PortStats (sw_id, portStats) -> + `List [ port_stat_to_json portStats ] + | FlowStats (sw_id, flowStats) -> `Assoc [ - ("type", `String "link_down"); - ("src", `Assoc [("switch_id", `Int (Int64.to_int_exn sw_id1)); - ("port_id", `Int (Int32.to_int_exn pt_id1))]); - ("dst", `Assoc [("switch_id", `Int (Int64.to_int_exn sw_id2)); - ("port_id", `Int (Int32.to_int_exn pt_id2))]) - ] - | HostUp ((sw_id, pt_id), (dlAddr, nwAddr)) -> - `Assoc [ - ("type", `String "host_up"); - ("switch_id", `Int (Int64.to_int_exn sw_id)); - ("port_id", `Int (Int32.to_int_exn pt_id)); - ("dl_addr", `String (Frenetic_Packet.string_of_dlAddr dlAddr)); - ("nw_addr", `String (Frenetic_Packet.string_of_nwAddr nwAddr)) - ] - | HostDown ((sw_id, pt_id), (dlAddr, nwAddr)) -> - `Assoc [ - ("type", `String "host_down"); - ("switch_id", `Int (Int64.to_int_exn sw_id)); - ("port_id", `Int (Int32.to_int_exn pt_id)); - ("dl_addr", `String (Frenetic_Packet.string_of_dlAddr dlAddr)); - ("nw_addr", `String (Frenetic_Packet.string_of_nwAddr nwAddr)) + ("packets", `Int (Int64.to_int_exn flowStats.flow_packet_count)); + ("bytes", `Int (Int64.to_int_exn flowStats.flow_byte_count)) ] let event_to_json_string (event : event) : string = Yojson.Basic.to_string ~std:true (event_to_json event) -let stats_to_json ((pkts, bytes) : Int64.t * Int64.t) : json = - `Assoc [("packets", `Int (Int64.to_int_exn pkts)); - ("bytes", `Int (Int64.to_int_exn bytes))] - -let stats_to_json_string (stats : Int64.t * Int64.t) : string = - Yojson.Basic.to_string ~std:true (stats_to_json stats) - -let port_stat_to_json (portStat: Frenetic_OpenFlow0x01.portStats) : json = - `Assoc [("port_no", `Int portStat.port_no); - ("rx_packets", `Int (Int64.to_int_exn portStat.rx_packets)); - ("tx_packets", `Int (Int64.to_int_exn portStat.tx_packets)); - ("rx_bytes", `Int (Int64.to_int_exn portStat.rx_bytes)); - ("tx_bytes", `Int (Int64.to_int_exn portStat.tx_bytes)); - ("rx_dropped", `Int (Int64.to_int_exn portStat.rx_dropped)); - ("tx_dropped", `Int (Int64.to_int_exn portStat.tx_dropped)); - ("rx_errors", `Int (Int64.to_int_exn portStat.rx_errors)); - ("tx_errors", `Int (Int64.to_int_exn portStat.tx_errors)); - ("rx_fram_err", `Int (Int64.to_int_exn portStat.rx_frame_err)); - ("rx_over_err", `Int (Int64.to_int_exn portStat.rx_over_err)); - ("rx_crc_err", `Int (Int64.to_int_exn portStat.rx_crc_err)); - ("collisions", `Int (Int64.to_int_exn portStat.collisions))] - -let port_stats_to_json (portStats : Frenetic_OpenFlow0x01.portStats list) : json = - `List (List.map portStats ~f:port_stat_to_json) - -let port_stats_to_json_string (portStats : Frenetic_OpenFlow0x01.portStats list) : string = - Yojson.Basic.to_string ~std:true (port_stats_to_json portStats) - diff --git a/lib/Frenetic_NetKAT_Json.mli b/lib/Frenetic_NetKAT_Json.mli index f2e72970a..7264a7dba 100644 --- a/lib/Frenetic_NetKAT_Json.mli +++ b/lib/Frenetic_NetKAT_Json.mli @@ -5,14 +5,10 @@ type This module also serializes/deserializes switch-to-controller OpenFlow messages for net apps. - TODO: These functions should be moved to Frenetic_NetKAT_SDN_Json, or should be consolidated - here. There's no good reason to differentiate between switch-to-controller and - controller-to-switch OpenFlow messages. The only problem is this module can't open - Frenetic_OpenFlow due to collisions in some data types ... that'll need to be solved. - *) open Core.Std open Frenetic_NetKAT +open Frenetic_OpenFlow open Yojson.Basic (* {1 Json Serialization/Deserialization} *) @@ -26,32 +22,24 @@ val policy_to_json : policy -> json val from_json_header_val : json -> header_val -(** Serialize an abstract OpenFlow event (PacketIn, SwitchUp, etc.) to Yojson format. *) -val event_to_json : event -> json - -(** Serialize an OpenFlow switch stats response to Yojson format. *) -val stats_to_json : Int64.t * Int64.t -> json - -(** Serialize an OpenFlow port stats response to Yojson format *) -val port_stats_to_json : Frenetic_OpenFlow0x01.portStats list -> json - -(* {1 Shortcuts} *) - -(** Same as policy_of_json, but receives json string *) -val policy_of_json_string : string -> policy - (** Same as policy_of_json, but reads json from input channel *) val policy_of_json_channel : In_channel.t -> policy (** Same as event_to_json but returns json string *) val event_to_json_string : event -> string -(** Same as policy_to_json but returns json string *) +(** Same as policy_of_json, but receives json string *) +val policy_of_json_string : string -> policy + val policy_to_json_string : policy -> string (** Sames as stats_to_json but returns json string *) val stats_to_json_string : Int64.t * Int64.t -> string -(** Same as port_stats_to_json but returns json string *) -val port_stats_to_json_string : Frenetic_OpenFlow0x01.portStats list -> string +val port_stat_to_json_string : portStats -> string +(* Used to be in Frenetic_NetKAT_SDN_Json *) +val pseudoport_to_json : pseudoport -> json +val pseudoport_from_json : json -> pseudoport +val flowTable_to_json : flowTable -> json +val pkt_out_from_json : json -> switchId * portId option * payload * policy list diff --git a/lib/Frenetic_NetKAT_SDN_Json.ml b/lib/Frenetic_NetKAT_SDN_Json.ml deleted file mode 100644 index 18e679765..000000000 --- a/lib/Frenetic_NetKAT_SDN_Json.ml +++ /dev/null @@ -1,163 +0,0 @@ -open Core.Std -open Yojson.Basic -open Frenetic_OpenFlow - -let pseudoport_from_json (json : json) : pseudoport = - let open Yojson.Basic.Util in - match json |> member "type" |> to_string with - | "physical" -> Physical (json |> member "port" |> to_int |> Int32.of_int_exn) - | "inport" -> InPort - | "table" -> Table - | "normal" -> Normal - | "flood" -> Flood - | "all" -> All - | "controller" -> Controller (json |> member "bytes" |> to_int) - | "local" -> Local - | str -> failwith ("invalid pseudoport type: " ^ str) - -let pseudoport_to_json (p : pseudoport) = match p with - | Physical n -> `Assoc [("type", `String "physical"); - ("port", `Int (Int32.to_int_exn n))] - | InPort -> `Assoc [("type", `String "inport")] - | Table -> `Assoc [("type", `String "table")] - | Normal -> `Assoc [("type", `String "normal")] - | Flood -> `Assoc [("type", `String "flood")] - | All -> `Assoc [("type", `String "all")] - | Local -> `Assoc [("type", `String "local")] - | Controller n -> `Assoc [("type", `String "controller"); - ("bytes", `Int n)] - -let payload_from_json (json : json) : payload = - let open Yojson.Basic.Util in - match json |> member "type" |> to_string with - | "notbuffered" -> - let base64 = json |> member "data" |> to_string in - NotBuffered (Cstruct.of_string (B64.decode base64)) - | "buffered" -> - let bufferId = Int32.of_int_exn (json |> member "bufferid" |> to_int) in - (* TODO(arjun): Why does Buffered take a second argument. Won't it be ignored - if a buffer ID is specified? *) - Buffered (bufferId, Cstruct.of_string "") - | _ -> failwith "invalid payload" - -let int32_option_from_json (json : json) : Int32.t option = - let open Yojson.Basic.Util in - match to_int_option json with - | None -> None - | Some n -> Some (Int32.of_int_exn n) - -let modify_from_json (json : json) : action = - (* The mod structure is exactly like the equivalent in flow tables *) - let header_val = Frenetic_NetKAT_Json.from_json_header_val(json) in - let set_field_val = match header_val with - | EthSrc m -> SetEthSrc m - | EthDst m -> SetEthDst m - | Vlan vl -> SetVlan (Some vl) - | VlanPcp n -> SetVlanPcp n - | EthType n -> SetEthTyp n - | IPProto n -> SetIPProto n - (* Masks are not supported on modifications *) - | IP4Src (addr,mask) -> SetIP4Src addr - | IP4Dst (addr,mask) -> SetIP4Dst addr - | TCPSrcPort n -> SetTCPSrcPort n - | TCPDstPort n -> SetTCPDstPort n - | Switch _ | Location _ | VSwitch _ | VPort _ | VFabric _ - -> failwith "Unsupported field modification" in - Modify set_field_val - -let action_from_json (json : json) : action = - let open Yojson.Basic.Util in - match json |> member "type" |> to_string with - | "output" -> Output (json |> member "pseudoport" |> pseudoport_from_json) - | "mod" -> modify_from_json json - | "enqueue" -> failwith "NYI: parsing enqueue actions from JSON" - | str -> failwith ("invalid action type: " ^ str) - -let pkt_out_from_json (json : json) : switchId * pktOut = - let open Yojson.Basic.Util in - let actions = json |> member "actions" |> to_list |> - List.map ~f:action_from_json in - let in_port = json |> member "in_port" |> int32_option_from_json in - let switch = json |> member "switch" |> to_int |> Int64.of_int in - let packet = json |> member "payload" |> payload_from_json in - (switch, (packet, in_port, actions)) - -let pattern_to_json (p:Pattern.t) : json = - let open Pattern in - let str_field f = function - | None -> `Null - | Some x -> `String (f x) in - let int_field f = function - | None -> `Null - | Some x -> `Int (f x) in - `Assoc [ - ("dlSrc", str_field Frenetic_Packet.string_of_mac p.dlSrc); - ("dlDst", str_field Frenetic_Packet.string_of_mac p.dlDst); - ("dlTyp", int_field ident p.dlTyp); - ("dlVlan", int_field ident p.dlVlan); - ("dlVlanPcp", int_field ident p.dlVlanPcp); - ("nwSrc", str_field Pattern.Ip.string_of p.nwSrc); - ("nwDst", str_field Pattern.Ip.string_of p.nwDst); - ("nwProto", int_field ident p.nwProto); - ("tpSrc", int_field ident p.tpSrc); - ("tpDst", int_field ident p.tpDst); - ("inPort", int_field Int32.to_int_exn p.inPort) ] - -let modify_to_json (m : modify) : json = match m with - | SetEthSrc m -> - `List [`String "SetDlSrc"; `String (Frenetic_Packet.string_of_mac m)] - | SetEthDst m -> - `List [`String "SetDlDst"; `String (Frenetic_Packet.string_of_mac m)] - | SetVlan o -> - `List [`String "SetVlan"; `Int (match o with None -> 0xffff | Some n -> n)] - | SetVlanPcp n -> - `List [`String "SetVlanPcp"; `Int n] - | SetEthTyp n -> - `List [`String "SetDlTyp"; `Int n] - | SetIPProto n -> - `List [`String "SetNwProto"; `Int n] - | SetIP4Src n -> - `List [`String "SetNwSrc"; `String (Frenetic_Packet.string_of_ip n)] - | SetIP4Dst n -> - `List [`String "SetNwDst"; `String (Frenetic_Packet.string_of_ip n)] - | SetTCPSrcPort n -> - `List [`String "SetTpSrc"; `Int n] - | SetTCPDstPort n -> - `List [`String "SetTpDst"; `Int n] - -let action_to_json (a : action) : json = match a with - | Output p -> `List [`String "Output"; pseudoport_to_json p] - | Enqueue (p, q) -> - `List [`String "Enqueue"; - `Int (Int32.to_int_exn p); - `Int (Int32.to_int_exn q)] - | Modify m -> - `List [`String "Modify"; modify_to_json m] - (* TODO(grouptable): who gets this json? *) - | FastFail p_lst -> failwith "Not Yet Implemented" - -let seq_to_json (s : seq) : json =`List (List.map ~f:action_to_json s) - -let par_to_json (p : par) : json = `List (List.map ~f:seq_to_json p) - -let action_to_json (g : group) : json = match g with - | [p] -> par_to_json p - | _ -> failwith "NYI: serializing groups with multiple buckets" - -let timeout_to_json (t : timeout) : json = match t with - | Permanent -> `String "Permanent" - | ExpiresAfter n -> `List [`String "ExpiresAfter"; `Int n] - -let flow_to_json (n : int) (f : flow) : json = - `Assoc [ - ("priority", `Int n); - ("pattern", pattern_to_json f.pattern); - ("action", action_to_json f.action); - ("cookie", `String (Int64.to_string f.cookie)); - ("idle_timeout", timeout_to_json f.idle_timeout); - ("hard_timeout", timeout_to_json f.hard_timeout) - ] - -let flowTable_to_json (tbl : flowTable) : json = - let priorities = List.range ~stride:(-1) 65535 (65535 - List.length tbl) in - `List (List.map2_exn ~f:flow_to_json priorities tbl) diff --git a/lib/Frenetic_NetKAT_SDN_Json.mli b/lib/Frenetic_NetKAT_SDN_Json.mli deleted file mode 100644 index 498d7147f..000000000 --- a/lib/Frenetic_NetKAT_SDN_Json.mli +++ /dev/null @@ -1,28 +0,0 @@ -(** JSON serialization/deserialization of abstract OpenFlow messages. - - Frenetic acts as a passthrough mechanism for certain OpenFlow events. For example, - a net app can execute an OpenFlow Packet Out message to send a packet to the - switch. NetKAT has nothing to say about this transaction, so the JSON used to - construct the message pretty much mirrors the OpenFlow. - - JSON NetKAT-specific messages to Frenetic (specifically "implement this policy") are - serialized/deserailized by the similarly-named Frenetic_NetKAT_Json module - -*) - -open Core.Std -open Frenetic_OpenFlow -open Yojson.Basic - -(** Construct a Json representiation from a pseudoport like Physical(2l) *) -val pseudoport_to_json : pseudoport -> json - -(** Construct a pseudoport from Json representiation like Assoc `physical: 2 *) -val pseudoport_from_json : json -> pseudoport - -(** Construct an abstract PacketOut message from a Json representation. *) -val pkt_out_from_json : json -> switchId * pktOut - -(** Construct a json repesentation from an abstract flow table. Used mostly for Frenetic compile_server *) -val flowTable_to_json : flowTable -> json - diff --git a/lib/Frenetic_OpenFlow.ml b/lib/Frenetic_OpenFlow.ml index 4c86be78a..ddc8e3340 100644 --- a/lib/Frenetic_OpenFlow.ml +++ b/lib/Frenetic_OpenFlow.ml @@ -286,8 +286,6 @@ type packetInReason = | ExplicitSend [@@deriving sexp] -type pktIn = payload * int * portId * packetInReason [@@deriving sexp] - type pktOut = payload * (portId option) * (action list) [@@deriving sexp] type switchFeatures = { @@ -296,18 +294,43 @@ type switchFeatures = { } [@@deriving sexp] type flowStats = { - flow_table_id : int8; (** ID of table flow came from. *) + flow_table_id : int64; (** ID of table flow came from. *) flow_pattern : Pattern.t; - flow_duration_sec: int32; - flow_duration_nsec: int32; - flow_priority: int16; - flow_idle_timeout: int16; - flow_hard_timeout: int16; flow_actions: action list; + flow_duration_sec: int64; + flow_duration_nsec: int64; + flow_priority: int64; + flow_idle_timeout: int64; + flow_hard_timeout: int64; flow_packet_count: int64; flow_byte_count: int64 } [@@deriving sexp] +type portStats = + { port_no : int64 + ; port_rx_packets : int64 + ; port_tx_packets : int64 + ; port_rx_bytes : int64 + ; port_tx_bytes : int64 + ; port_rx_dropped : int64 + ; port_tx_dropped : int64 + ; port_rx_errors : int64 + ; port_tx_errors : int64 + ; port_rx_frame_err : int64 + ; port_rx_over_err : int64 + ; port_rx_crc_err : int64 + ; port_collisions : int64 +} [@@deriving sexp] + +type event = + | SwitchUp of switchId * portId list + | SwitchDown of switchId + | PortUp of switchId * portId + | PortDown of switchId * portId + | PacketIn of string * switchId * portId * payload * int * packetInReason + | PortStats of switchId * portStats + | FlowStats of switchId * flowStats + let format_modify (fmt:Format.formatter) (m:modify) : unit = match m with | SetEthSrc(dlAddr) -> @@ -407,6 +430,7 @@ let format_flowTable (fmt:Format.formatter) (l:flowTable) : unit = let string_of_action = Frenetic_Util.make_string_of format_action let string_of_seq = Frenetic_Util.make_string_of format_seq let string_of_par = Frenetic_Util.make_string_of format_par +let string_of_group = Frenetic_Util.make_string_of format_group let string_of_flow = Frenetic_Util.make_string_of format_flow let string_of_vlan (x : int) : string = @@ -576,153 +600,404 @@ let string_of_flowTable ?(label="") (tbl : flowTable) : string = let b = bottom max_p max_a in String.concat (t :: l :: (List.append entry_strings [b])) +let string_of_event = function + | SwitchUp _-> "SwitchUp" + | SwitchDown _-> "SwitchDown" + | PortUp _-> "PortUp" + | PortDown _-> "PortDown" + | PacketIn _-> "PacketIn" + | PortStats _-> "PortStats" + | FlowStats _-> "FlowStats" + module To0x01 = struct -exception Invalid_port of int32 - -let from_portId (pport_id : portId) : OF10.portId = - if pport_id > 0xff00l then (* pport_id <= OFPP_MAX *) - raise (Invalid_port pport_id) - else - Int32.to_int_exn pport_id - -let from_output (inPort : OF10.portId option) (pseudoport : pseudoport) : OF10.action = - match pseudoport with - | InPort -> Output InPort - | Table -> Output Table - | Normal -> Output Normal - | Flood -> Output Flood - | All -> Output AllPorts - | Physical pport_id -> - let pport_id = from_portId pport_id in - if Some pport_id = inPort then - Output InPort - else - Output (PhysicalPort pport_id) - | Controller n -> - Output (Controller n) - | Local -> - Output Local - -let from_action (inPort : OF10.portId option) (act : action) : OF10.action = - match act with - | Output pseudoport -> - from_output inPort pseudoport - | Enqueue (pport_id, queue_id) -> - let pport_id = from_portId pport_id in - if Some pport_id = inPort then - Enqueue(InPort, queue_id) - else - Enqueue (PhysicalPort pport_id, queue_id) - | Modify (SetEthSrc dlAddr) -> - SetDlSrc dlAddr - | Modify (SetEthDst dlAddr) -> - SetDlDst dlAddr - | Modify (SetVlan vlan) -> - begin match vlan with - | None - | Some(0xffff) -> - SetDlVlan None - | Some(n) -> - SetDlVlan (Some n) - end - | Modify (SetVlanPcp pcp) -> - SetDlVlanPcp pcp - | Modify (SetEthTyp _) -> - raise (Invalid_argument "cannot set Ethernet type") - | Modify (SetIPProto _) -> - raise (Invalid_argument "cannot set IP protocol") - | Modify (SetIP4Src nwAddr) -> - SetNwSrc nwAddr - | Modify (SetIP4Dst nwAddr) -> - SetNwDst nwAddr - | Modify (SetTCPSrcPort tp) -> - SetTpSrc tp - | Modify (SetTCPDstPort tp) -> - SetTpDst tp - (* TODO(grouptable) *) - | FastFail _ -> failwith "Openflow 1.0 does not support fast failover." - -let from_seq (inPort : OF10.portId option) (seq : seq) : OF10.action list = - List.map seq ~f:(from_action inPort) - -let from_par (inPort : OF10.portId option) (par : par) : OF10.action list = - List.concat (List.map par ~f:(from_seq inPort)) - -let from_group (inPort : OF10.portId option) (group : group) - : OF10.action list = - match group with - | [] -> [] - | [par] -> from_par inPort par - | _ -> - raise (Unsupported "OpenFlow 1.0 does not support fast-failover") - -let from_timeout (timeout : timeout) : OF10.timeout = - match timeout with - | Permanent -> Permanent - | ExpiresAfter n -> ExpiresAfter n - - -let from_pattern (pat : Pattern.t) : OF10.pattern = - { dlSrc = pat.dlSrc - ; dlDst = pat.dlDst - ; dlTyp = pat.dlTyp - ; dlVlan = (match pat.dlVlan with - | Some(0xffff) -> Some None - | Some(x) -> Some (Some x) - | None -> None) - ; dlVlanPcp = pat.dlVlanPcp - ; nwSrc = (match pat.nwSrc with - | None -> None - | Some (p,m) -> - let mo = - if m = 32l then - None - else - Some (Int32.(32l - m)) in - Some { m_value = p; m_mask = mo }) - ; nwDst = (match pat.nwDst with - | None -> None - | Some (p,m) -> - let mo = - if m = 32l then - None - else - Some (Int32.(32l - m)) in - Some { m_value = p; m_mask = mo }) - ; nwProto = pat.nwProto - ; nwTos = None - ; tpSrc = pat.tpSrc - ; tpDst = pat.tpDst - ; inPort = Core_kernel.Option.map pat.inPort from_portId + exception Invalid_port of int32 + + let from_portId (pport_id : portId) : OF10.portId = + if pport_id > 0xff00l then (* pport_id <= OFPP_MAX *) + raise (Invalid_port pport_id) + else + Int32.to_int_exn pport_id + + let from_output (inPort : OF10.portId option) (pseudoport : pseudoport) : OF10.action = + match pseudoport with + | InPort -> Output InPort + | Table -> Output Table + | Normal -> Output Normal + | Flood -> Output Flood + | All -> Output AllPorts + | Physical pport_id -> + let pport_id = from_portId pport_id in + if Some pport_id = inPort then + Output InPort + else + Output (PhysicalPort pport_id) + | Controller n -> + Output (Controller n) + | Local -> + Output Local + + let from_action (inPort : OF10.portId option) (act : action) : OF10.action = + match act with + | Output pseudoport -> + from_output inPort pseudoport + | Enqueue (pport_id, queue_id) -> + let pport_id = from_portId pport_id in + if Some pport_id = inPort then + Enqueue(InPort, queue_id) + else + Enqueue (PhysicalPort pport_id, queue_id) + | Modify (SetEthSrc dlAddr) -> + SetDlSrc dlAddr + | Modify (SetEthDst dlAddr) -> + SetDlDst dlAddr + | Modify (SetVlan vlan) -> + begin match vlan with + | None + | Some(0xffff) -> + SetDlVlan None + | Some(n) -> + SetDlVlan (Some n) + end + | Modify (SetVlanPcp pcp) -> + SetDlVlanPcp pcp + | Modify (SetEthTyp _) -> + raise (Invalid_argument "cannot set Ethernet type") + | Modify (SetIPProto _) -> + raise (Invalid_argument "cannot set IP protocol") + | Modify (SetIP4Src nwAddr) -> + SetNwSrc nwAddr + | Modify (SetIP4Dst nwAddr) -> + SetNwDst nwAddr + | Modify (SetTCPSrcPort tp) -> + SetTpSrc tp + | Modify (SetTCPDstPort tp) -> + SetTpDst tp + (* TODO(grouptable) *) + | FastFail _ -> failwith "Openflow 1.0 does not support fast failover." + + let from_seq (inPort : OF10.portId option) (seq : seq) : OF10.action list = + List.map seq ~f:(from_action inPort) + + let from_par (inPort : OF10.portId option) (par : par) : OF10.action list = + List.concat (List.map par ~f:(from_seq inPort)) + + let from_group (inPort : OF10.portId option) (group : group) + : OF10.action list = + match group with + | [] -> [] + | [par] -> from_par inPort par + | _ -> + raise (Unsupported "OpenFlow 1.0 does not support fast-failover") + + let from_timeout (timeout : timeout) : OF10.timeout = + match timeout with + | Permanent -> Permanent + | ExpiresAfter n -> ExpiresAfter n + + let from_pattern (pat : Pattern.t) : OF10.pattern = + { dlSrc = pat.dlSrc + ; dlDst = pat.dlDst + ; dlTyp = pat.dlTyp + ; dlVlan = (match pat.dlVlan with + | Some(0xffff) -> Some None + | Some(x) -> Some (Some x) + | None -> None) + ; dlVlanPcp = pat.dlVlanPcp + ; nwSrc = (match pat.nwSrc with + | None -> None + | Some (p,m) -> + let mo = + if m = 32l then + None + else + Some (Int32.(32l - m)) in + Some { m_value = p; m_mask = mo }) + ; nwDst = (match pat.nwDst with + | None -> None + | Some (p,m) -> + let mo = + if m = 32l then + None + else + Some (Int32.(32l - m)) in + Some { m_value = p; m_mask = mo }) + ; nwProto = pat.nwProto + ; nwTos = None + ; tpSrc = pat.tpSrc + ; tpDst = pat.tpDst + ; inPort = Core_kernel.Option.map pat.inPort from_portId + } + + let from_flow (priority : int) (flow : flow) : OF10.flowMod = + match flow with + | { pattern; action; cookie; idle_timeout; hard_timeout } -> + let pat = from_pattern pattern in + { command = AddFlow; + pattern = pat; + priority = priority; + actions = from_group pat.inPort action; + cookie = cookie; + idle_timeout = from_timeout idle_timeout; + hard_timeout = from_timeout hard_timeout; + notify_when_removed = false; + apply_to_packet = None; + out_port = None; + check_overlap = false } + + let from_payload (pay : payload) : OF10.payload = + match pay with + | Buffered (buf_id, b) -> + Buffered (buf_id, b) + | NotBuffered b -> NotBuffered b + + let port_config_none = OF10.{ + down = false ; no_stp = false ; no_recv = false ; no_recv_stp = false + ; no_flood = false ; no_fwd = false ; no_packet_in = false } -let from_flow (priority : int) (flow : flow) : OF10.flowMod = - match flow with - | { pattern; action; cookie; idle_timeout; hard_timeout } -> - let pat = from_pattern pattern in - { command = AddFlow; - pattern = pat; - priority = priority; - actions = from_group pat.inPort action; - cookie = cookie; - idle_timeout = from_timeout idle_timeout; - hard_timeout = from_timeout hard_timeout; - notify_when_removed = false; - apply_to_packet = None; - out_port = None; - check_overlap = false } - -let from_payload (pay : payload) : OF10.payload = - match pay with - | Buffered (buf_id, b) -> - Buffered (buf_id, b) - | NotBuffered b -> NotBuffered b - -let from_packetOut (pktOut : pktOut) : OF10.packetOut = - let output_payload, port_id, apply_actions = pktOut in - let output_payload = from_payload output_payload in - let port_id = Core_kernel.Option.map port_id from_portId in - let apply_actions = from_par port_id [apply_actions] in - { output_payload; port_id; apply_actions } + let port_features_none = OF10.{ + f_10MBHD = false ; f_10MBFD = false ; f_100MBHD = false ; f_100MBFD = false + ; f_1GBHD = false ; f_1GBFD = false ; f_10GBFD = false ; copper = false + ; fiber = false ; autoneg = false ; pause = false ; pause_asym = false + } + + let port_description_template (portId: portId) : OF10.portDescription = { + port_no = Int.of_int32_exn portId ; hw_addr = 0L; name = ""; config = port_config_none + ; state = { down = false; stp_state = Listen} + ; curr = port_features_none ; advertised = port_features_none + ; supported = port_features_none ; peer = port_features_none + } + + let from_switch_features (feats : switchFeatures) : OF10.SwitchFeatures.t = + let sp = List.map feats.switch_ports ~f:port_description_template in + { switch_id = feats.switch_id + ; num_buffers = 0l ; num_tables = 0 + ; supported_capabilities = { + flow_stats = false ; table_stats = false ; port_stats = false ; stp = false + ; ip_reasm = false ; queue_stats = false ; arp_match_ip = false + } + ; supported_actions = { + output = false ; set_vlan_id = false ; set_vlan_pcp = false ; strip_vlan = false + ; set_dl_src = false ; set_dl_dst = false ; set_nw_src = false ; set_nw_dst = false + ; set_nw_tos = false ; set_tp_src = false ; set_tp_dst = false ; enqueue = false + ; vendor = false + } + ; ports = sp + } + + let from_packet_in_reason (pir : packetInReason) : OF10.packetInReason = + match pir with + | NoMatch -> NoMatch + | ExplicitSend -> ExplicitSend + + let from_packetOut (pktOut : pktOut) : OF10.packetOut = + let output_payload, port_id, apply_actions = pktOut in + let output_payload = from_payload output_payload in + let port_id = Core_kernel.Option.map port_id from_portId in + let apply_actions = from_par port_id [apply_actions] in + { output_payload; port_id; apply_actions } + + let port_status_template reason portId : OF10.PortStatus.t = { + reason = reason ; desc = port_description_template portId + } + + let from_port_stats (prl : portStats) : OF10.portStats = + { port_no = Int.of_int64_exn prl.port_no + ; rx_packets = prl.port_rx_packets ; tx_packets = prl.port_tx_packets + ; rx_bytes = prl.port_rx_bytes ; tx_bytes = prl.port_tx_bytes + ; rx_dropped = prl.port_rx_dropped + ; tx_dropped = prl.port_tx_dropped ; rx_errors = prl.port_rx_errors + ; tx_errors = prl.port_tx_errors ; rx_frame_err = prl.port_rx_frame_err + ; rx_over_err = prl.port_rx_over_err ; rx_crc_err = prl.port_rx_crc_err + ; collisions = prl.port_collisions + } + + let from_flow_stats (ifs: flowStats) : OF10.individualStats = + { table_id = Int.of_int64_exn ifs.flow_table_id; + of_match = from_pattern ifs.flow_pattern; + actions = List.map ifs.flow_actions ~f:(fun act -> from_action None act); + duration_sec = Int32.of_int64_exn ifs.flow_duration_sec; + duration_nsec = Int32.of_int64_exn ifs.flow_duration_nsec; + priority = Int.of_int64_exn ifs.flow_priority; + idle_timeout = Int.of_int64_exn ifs.flow_idle_timeout; + hard_timeout = Int.of_int64_exn ifs.flow_hard_timeout; + packet_count = ifs.flow_packet_count; + byte_count = ifs.flow_byte_count; + cookie = 0L + } + + let from_payload (pl : payload) : OF10.payload = + match pl with + | Buffered (bufferId, data) -> Buffered (bufferId, data) + | NotBuffered data -> NotBuffered data + + let message_from_event event : (switchId * OF10.Message.t) option = + match event with + | PortUp (sw, portId) -> + Some (sw, PortStatusMsg (port_status_template Add portId)) + | PortDown (sw, portId) -> + Some (sw, PortStatusMsg (port_status_template Delete portId)) + | PacketIn (pipe, swId, portId, payload, total_len, reason) -> + let _reason = from_packet_in_reason reason in + Some (swId, PacketInMsg { + input_payload = from_payload payload + ; total_len = total_len + ; port = Int32.to_int_exn portId + ; reason = _reason + }) + | PortStats (swId, pr) -> + Some (swId, StatsReplyMsg (PortRep ([from_port_stats pr ]))) + | FlowStats (swId, ifr) -> + Some (swId, StatsReplyMsg (IndividualFlowRep ([from_flow_stats ifr ]))) + (* SwitchUp and SwitchDown have no analogues in OF 1.0, so drop *) + | SwitchUp _ | SwitchDown _ -> None +end + +module From0x01 = struct + + let from_switchId (swId: OF10.switchId) : switchId = + swId + + let from_portId (pport_id : OF10.portId) : portId option = + (* OVS returns the local interface as 65534, but we don't want that *) + if pport_id > 0xff00 then (* pport_id <= OFPP_MAX *) + None + else + Int.to_int32 pport_id + + let from_payload (pl : OF10.payload) : payload = + match pl with + | Buffered (bufferId, data) -> Buffered (bufferId, data) + | NotBuffered data -> NotBuffered data + + let from_switch_features (feats : OF10.SwitchFeatures.t) = + let sp = List.filter_map feats.ports ~f:(fun pd -> from_portId pd.port_no) in + { switch_id = from_switchId feats.switch_id; switch_ports = sp} + + let from_port_stats (prl : OF10.portStats) = + { port_no = Int64.of_int prl.port_no + ; port_rx_packets = prl.rx_packets ; port_tx_packets = prl.tx_packets + ; port_rx_bytes = prl.rx_bytes ; port_tx_bytes = prl.tx_bytes ; port_rx_dropped = prl.rx_dropped + ; port_tx_dropped = prl.tx_dropped ; port_rx_errors = prl.rx_errors + ; port_tx_errors = prl.tx_errors ; port_rx_frame_err = prl.rx_frame_err + ; port_rx_over_err = prl.rx_over_err ; port_rx_crc_err = prl.rx_crc_err + ; port_collisions = prl.collisions + } + + let from_pattern (pat : OF10.pattern) : Pattern.t = + { dlSrc = pat.dlSrc + ; dlDst = pat.dlDst + ; dlTyp = pat.dlTyp + ; dlVlan = (match pat.dlVlan with + | None -> None + | Some None -> Some (0xffff) + | Some (Some x) -> Some (x) + ) + ; dlVlanPcp = pat.dlVlanPcp + ; nwSrc = (match pat.nwSrc with + | None -> None + | Some { m_value = p; m_mask = mo } -> + let mask = match mo with + | None -> 0l + | Some m -> Int32.(32l - m) in + Some (p,mask) + ) + ; nwDst = (match pat.nwDst with + | None -> None + | Some { m_value = p; m_mask = mo } -> + let mask = match mo with + | None -> 0l + | Some m -> Int32.(32l - m) in + Some (p,mask) + ) + ; nwProto = pat.nwProto + ; tpSrc = pat.tpSrc + ; tpDst = pat.tpDst + ; inPort = match pat.inPort with | None -> None | Some x -> Int.to_int32 x + } + + let from_output (pp : OF10.pseudoPort) : pseudoport = + match pp with + | InPort -> InPort + | Table -> Table + | Normal -> Normal + | Flood -> Flood + | AllPorts -> All + | PhysicalPort pport_id -> Physical (Int.to_int32_exn pport_id) + | Controller n -> Controller n + | Local -> Local + + let from_action (act : OF10.action) : action = + match act with + | Output pseudoport -> Output (from_output pseudoport) + | Enqueue (PhysicalPort pport_id, queue_id) -> + Enqueue ((Int.to_int32_exn pport_id), queue_id) + | Enqueue _ -> assert false + | SetDlSrc dlAddr -> Modify (SetEthSrc dlAddr) + | SetDlDst dlAddr -> Modify (SetEthDst dlAddr) + | SetDlVlan vl -> + Modify (SetVlan begin match vl with + | None -> Some(0xffff) + | Some n -> Some n + end) + | SetDlVlanPcp pcp -> Modify (SetVlanPcp pcp) + | SetNwSrc nwAddr -> Modify (SetIP4Src nwAddr) + | SetNwDst nwAddr -> Modify (SetIP4Dst nwAddr) + | SetTpSrc tp -> Modify (SetTCPSrcPort tp) + | SetTpDst tp -> Modify (SetTCPDstPort tp) + | SetNwTos _ -> assert false + + let from_individual_stats (ifs: OF10.individualStats ) = + { flow_table_id = Int64.of_int ifs.table_id; + flow_pattern = from_pattern ifs.of_match; + flow_actions = List.map ifs.actions ~f:from_action; + flow_duration_sec = Int64.of_int32 ifs.duration_sec; + flow_duration_nsec = Int64.of_int32 ifs.duration_nsec; + flow_priority = Int64.of_int ifs.priority; + flow_idle_timeout = Int64.of_int ifs.idle_timeout; + flow_hard_timeout = Int64.of_int ifs.hard_timeout; + flow_packet_count = ifs.packet_count; + flow_byte_count = ifs.byte_count + } + + let from_packet_in_reason (pir : OF10.packetInReason) : packetInReason = + match pir with + | NoMatch -> NoMatch + | ExplicitSend -> ExplicitSend + + let event_from_message (swId:OF10.switchId) (msg:OF10.Message.t) = + let _swId = from_switchId swId in + match msg with + | PortStatusMsg ps -> + let _portId = from_portId ps.desc.port_no in + (match _portId with + | Some _portId -> + (match ps.reason with + | Add -> Some (PortUp (_swId, _portId)) + | Delete -> Some (PortDown (_swId, _portId)) + | _ -> None (* We ignore port modifications *) + ) + | None -> None + ) + | PacketInMsg pi -> + let _portId = from_portId pi.port in + let _reason = from_packet_in_reason pi.reason in + let _payload = from_payload pi.input_payload in + (match _portId with + | Some _portId -> Some (PacketIn ("", _swId, _portId, _payload, pi.total_len, _reason)) + | None -> None + ) + | StatsReplyMsg sr -> + (match sr with + | PortRep prl -> + (* We only get one port stat row with Frenetic, so just grab the first *) + Some (PortStats (_swId, from_port_stats (List.hd_exn prl))) + | IndividualFlowRep ifrl -> + Some (FlowStats (_swId, from_individual_stats (List.hd_exn ifrl))) + | _ -> None + ) + | _ -> None + + end diff --git a/lib/Frenetic_OpenFlow.mli b/lib/Frenetic_OpenFlow.mli index 1da6aca70..0f8cdffce 100644 --- a/lib/Frenetic_OpenFlow.mli +++ b/lib/Frenetic_OpenFlow.mli @@ -20,19 +20,15 @@ supply the entire flow table at once and cannot add and remove flow table entries individually *) +open Frenetic_Packet + (** {1 OpenFlow Identifier Types} OpenFlow requires identifiers for switches, ports, transaction numbers, etc. The representation of these identifiers varies across different versions of OpenFlow, which is why they are abstract. - - *) -open Frenetic_Packet - -module OF10 = Frenetic_OpenFlow0x01 - type switchId = int64 [@@deriving sexp, compare, eq] type portId = int32 [@@deriving sexp, compare, eq] type queueId = int32 [@@deriving sexp, compare, eq] @@ -40,6 +36,31 @@ type bufferId = int32 [@@deriving sexp, compare, eq] exception Unsupported of string +(** {1 Packet Types } *) + +(** Packet payloads *) +type payload = + | Buffered of bufferId * Cstruct.t + (** [Buffered (id, buf)] is a packet buffered on a switch *) + | NotBuffered of Cstruct.t +[@@deriving sexp] + +(** [payload_bytes payload] returns the bytes for the given payload *) +val payload_bytes : payload -> Cstruct.t + +type packetInReason = + | NoMatch + | ExplicitSend +[@@deriving sexp] + +(** {1 Switch Configuaration } *) + +(** A simplification of the _switch features_ message from OpenFlow *) +type switchFeatures = { + switch_id : switchId; + switch_ports : portId list +} [@@deriving sexp] + (** {1 Packet Forwarding} *) module Pattern : sig @@ -163,57 +184,57 @@ type flow = { (** Priorities are implicit *) type flowTable = flow list [@@deriving sexp] -(** {1 Controller Packet Processing} *) - -(** The payload for [packetIn] and [packetOut] messages *) -type payload = - | Buffered of bufferId * Cstruct.t - (** [Buffered (id, buf)] is a packet buffered on a switch *) - | NotBuffered of Cstruct.t -[@@deriving sexp] - - -(** [payload_bytes payload] returns the bytes for the given payload *) -val payload_bytes : payload -> Cstruct.t - -type packetInReason = - | NoMatch - | ExplicitSend - [@@deriving sexp] - -(** [(payload, total_length, in_port, reason)] *) -type pktIn = payload * int * portId * packetInReason [@@deriving sexp] - -(** [(payload, in_port option, action list)] *) -type pktOut = payload * (portId option) * (action list) [@@deriving sexp] - -(* {1 Switch Configuration} *) +(* {1 Errors} *) -(** A simplification of the _switch features_ message from OpenFlow *) -type switchFeatures = { - switch_id : switchId; - switch_ports : portId list -} [@@deriving sexp] +(* TODO: FILL *) (* {1 Statistics} *) (** The body of a reply to an individual flow statistics request *) type flowStats = { - flow_table_id : int8; (** ID of table flow came from *) + flow_table_id : int64; flow_pattern : Pattern.t; - flow_duration_sec: int32; - flow_duration_nsec: int32; - flow_priority: int16; - flow_idle_timeout: int16; - flow_hard_timeout: int16; flow_actions: action list; + flow_duration_sec: int64; + flow_duration_nsec: int64; + flow_priority: int64; + flow_idle_timeout: int64; + flow_hard_timeout: int64; flow_packet_count: int64; flow_byte_count: int64 } [@@deriving sexp] -(* {1 Errors} *) +type portStats = + { port_no : int64 + ; port_rx_packets : int64 + ; port_tx_packets : int64 + ; port_rx_bytes : int64 + ; port_tx_bytes : int64 + ; port_rx_dropped : int64 + ; port_tx_dropped : int64 + ; port_rx_errors : int64 + ; port_tx_errors : int64 + ; port_rx_frame_err : int64 + ; port_rx_over_err : int64 + ; port_rx_crc_err : int64 + ; port_collisions : int64 +} [@@deriving sexp] -(* TODO: FILL *) +(* {1 Events, switch-to-controller messages} *) + +type event = + | SwitchUp of switchId * portId list + | SwitchDown of switchId + | PortUp of switchId * portId + | PortDown of switchId * portId + | PacketIn of string * switchId * portId * payload * int * packetInReason + | PortStats of switchId * portStats + | FlowStats of switchId * flowStats + +(* {1 Commands, controller-to-switch messages} *) + +(* TODO: Temporary *) +type pktOut = payload * (portId option) * (action list) [@@deriving sexp] (* {1 Pretty-printing } *) @@ -229,11 +250,25 @@ val string_of_action : action -> string val string_of_seq : seq -> string val string_of_par : par -> string val string_of_flow : flow -> string +val string_of_group : group -> string val string_of_flowTable : ?label:string -> flowTable -> string +val string_of_event : event -> string +module OF10 = Frenetic_OpenFlow0x01 module To0x01 : sig val from_pattern : Pattern.t -> OF10.pattern + val from_action : OF10.portId option -> action -> OF10.action val from_flow : int -> flow -> OF10.flowMod + val from_switch_features : switchFeatures -> OF10.SwitchFeatures.t val from_payload : payload -> OF10.payload - val from_packetOut : pktOut -> OF10.packetOut + val from_packet_in_reason : packetInReason -> OF10.packetInReason + val from_packetOut : pktOut -> OF10.packetOut + val message_from_event : event -> (OF10.switchId * OF10.Message.t) option +end +module From0x01 : sig + val from_action : OF10.action -> action + val from_switch_features : OF10.SwitchFeatures.t -> switchFeatures + val event_from_message : OF10.switchId -> OF10.Message.t -> event option + val from_port_stats : OF10.portStats -> portStats + val from_individual_stats: OF10.individualStats -> flowStats end diff --git a/lib/Frenetic_OpenFlow0x01.ml b/lib/Frenetic_OpenFlow0x01.ml index bbc07c0c0..61fcc834a 100644 --- a/lib/Frenetic_OpenFlow0x01.ml +++ b/lib/Frenetic_OpenFlow0x01.ml @@ -3111,3 +3111,5 @@ module Message = struct marshal_body msg (Cstruct.shift buf Header.size); Cstruct.to_string buf end + + diff --git a/lib/Frenetic_OpenFlow0x01.mli b/lib/Frenetic_OpenFlow0x01.mli index 6f2a223b8..40647c686 100644 --- a/lib/Frenetic_OpenFlow0x01.mli +++ b/lib/Frenetic_OpenFlow0x01.mli @@ -264,6 +264,7 @@ type portDescription = ; peer : portFeatures } [@@deriving sexp] + module Wildcards : sig val to_string : wildcards -> string val marshal : wildcards -> int32 @@ -729,3 +730,4 @@ val delete_all_flows : flowMod val packetIn_to_string : packetIn -> string val reply_to_string : reply -> string + diff --git a/lib/frenetic.mldylib b/lib/frenetic.mldylib index ddec4db7c..761ba49b5 100644 --- a/lib/frenetic.mldylib +++ b/lib/frenetic.mldylib @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 772ad83fcc47410513d0cbfd65275bc6) +# DO NOT EDIT (digest: e998a30caa8cba2db62891ca8169cb60) Frenetic_Hashcons Frenetic_Bits Frenetic_Fdd @@ -14,7 +14,6 @@ Frenetic_NetKAT_Virtual_Compiler Frenetic_NetKAT_Net Frenetic_NetKAT_Parser Frenetic_NetKAT_Pretty -Frenetic_NetKAT_SDN_Json Frenetic_NetKAT_Semantics Frenetic_Network Frenetic_OpenFlow diff --git a/lib/frenetic.mllib b/lib/frenetic.mllib index ddec4db7c..761ba49b5 100644 --- a/lib/frenetic.mllib +++ b/lib/frenetic.mllib @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 772ad83fcc47410513d0cbfd65275bc6) +# DO NOT EDIT (digest: e998a30caa8cba2db62891ca8169cb60) Frenetic_Hashcons Frenetic_Bits Frenetic_Fdd @@ -14,7 +14,6 @@ Frenetic_NetKAT_Virtual_Compiler Frenetic_NetKAT_Net Frenetic_NetKAT_Parser Frenetic_NetKAT_Pretty -Frenetic_NetKAT_SDN_Json Frenetic_NetKAT_Semantics Frenetic_Network Frenetic_OpenFlow diff --git a/lib/frenetic.odocl b/lib/frenetic.odocl index ddec4db7c..a5f366227 100644 --- a/lib/frenetic.odocl +++ b/lib/frenetic.odocl @@ -1,5 +1,4 @@ -# OASIS_START -# DO NOT EDIT (digest: 772ad83fcc47410513d0cbfd65275bc6) +# DO NOT EDIT (digest: e998a30caa8cba2db62891ca8169cb60) Frenetic_Hashcons Frenetic_Bits Frenetic_Fdd @@ -14,7 +13,6 @@ Frenetic_NetKAT_Virtual_Compiler Frenetic_NetKAT_Net Frenetic_NetKAT_Parser Frenetic_NetKAT_Pretty -Frenetic_NetKAT_SDN_Json Frenetic_NetKAT_Semantics Frenetic_Network Frenetic_OpenFlow diff --git a/lib_test/Test.ml b/lib_test/Test.ml index 1f401b6ca..9dceab46e 100644 --- a/lib_test/Test.ml +++ b/lib_test/Test.ml @@ -14,7 +14,6 @@ open Test_Frenetic_OpenFlow open Test_Frenetic_OpenFlow0x01 open Test_Frenetic_OpenFlow0x04 open Test_Frenetic_OpenFlow_Header -open Test_Frenetic_NetKAT_SDN_Json open Test_Frenetic_Util open Test_Frenetic_Vlr diff --git a/lib_test/Test_Frenetic_NetKAT_Json.ml b/lib_test/Test_Frenetic_NetKAT_Json.ml index 4a6110a8f..720b62f98 100644 --- a/lib_test/Test_Frenetic_NetKAT_Json.ml +++ b/lib_test/Test_Frenetic_NetKAT_Json.ml @@ -22,129 +22,95 @@ let%test "policy_to_json serializes a NetKAT policy like example1.kat" = let example1_json = from_string (In_channel.read_all "lib_test/data/example1.json") in (to_string example1_json) = (to_string (policy_to_json nk_policy)) -let%test "event_to_json serializes an OpenFlow Packet In event with a format like pkt_in.json" = - let pktin_event = Frenetic_NetKAT.PacketIn( +let%test "event_to_json_string serializes an OpenFlow Packet In event with a format like pkt_in.json" = + let pktin_event = Frenetic_OpenFlow.PacketIn( "learning_switch", 0x871234L, 99l, Frenetic_OpenFlow.Buffered(0l, Cstruct.of_string "Hi mom!"), - 1024 + 1024, + ExplicitSend ) in - let pkt_in_json = from_string (In_channel.read_all "lib_test/data/pkt_in.json") in - event_to_json pktin_event = pkt_in_json - -let%test "event_to_json serializes an OpenFlow Query event with a format like query.json" = - let query_event = Frenetic_NetKAT.Query( - "ignored", - 9823745L, - 982734578L - ) in - let query_json = from_string (In_channel.read_all "lib_test/data/query.json") in - event_to_json query_event = query_json + let pkt_in_json = In_channel.read_all "lib_test/data/pkt_in.json" in + event_to_json_string pktin_event = pkt_in_json -let%test "event_to_json serializes an OpenFlow Switch Up event with a format like switch_up.json" = - let switch_up_event = Frenetic_NetKAT.SwitchUp( +let%test "event_to_json_string serializes an OpenFlow Switch Up event with a format like switch_up.json" = + let switch_up_event = Frenetic_OpenFlow.SwitchUp( 0x9878abcL, [1l; 2l; 38l] ) in - let switch_up_json = from_string (In_channel.read_all "lib_test/data/switch_up.json") in - event_to_json switch_up_event = switch_up_json + let switch_up_json = In_channel.read_all "lib_test/data/switch_up.json" in + event_to_json_string switch_up_event = switch_up_json -let%test "event_to_json serializes an OpenFlow Switch Down event with a format like switch_down.json" = - let switch_down_event = Frenetic_NetKAT.SwitchDown( +let%test "event_to_json_string serializes an OpenFlow Switch Down event with a format like switch_down.json" = + let switch_down_event = Frenetic_OpenFlow.SwitchDown( 0x9878abcL ) in - let switch_down_json = from_string (In_channel.read_all "lib_test/data/switch_down.json") in - event_to_json switch_down_event = switch_down_json + let switch_down_json = In_channel.read_all "lib_test/data/switch_down.json" in + event_to_json_string switch_down_event = switch_down_json -let%test "event_to_json serializes an OpenFlow Port Up event with a format like port_up.json" = - let port_up_event = Frenetic_NetKAT.PortUp( +let%test "event_to_json_string serializes an OpenFlow Port Up event with a format like port_up.json" = + let port_up_event = Frenetic_OpenFlow.PortUp( 0x9878abcL, 1l ) in - let port_up_json = from_string (In_channel.read_all "lib_test/data/port_up.json") in - event_to_json port_up_event = port_up_json + let port_up_json = In_channel.read_all "lib_test/data/port_up.json" in + event_to_json_string port_up_event = port_up_json -let%test "event_to_json serializes an OpenFlow Port Down event with a format like port_down.json" = - let port_down_event = Frenetic_NetKAT.PortDown( +let%test "event_to_json_string serializes an OpenFlow Port Down event with a format like port_down.json" = + let port_down_event = Frenetic_OpenFlow.PortDown( 0x9878abdL, 6l ) in - let port_down_json = from_string (In_channel.read_all "lib_test/data/port_down.json") in - event_to_json port_down_event = port_down_json - -(* Note: Link Up/Down and Host Up/Down are not OpenFlow events, but are synthesized through other events *) -let%test "event_to_json serializes a Link Up event with a format like link_up.json" = - let link_up_event = Frenetic_NetKAT.LinkUp( - (0x9878abdL, 6l), - (0xabd9878L, 1l) - ) in - let link_up_json = from_string (In_channel.read_all "lib_test/data/link_up.json") in - event_to_json link_up_event = link_up_json - -let%test "event_to_json serializes a Link Down event with a format like link_down.json" = - let link_down_event = Frenetic_NetKAT.LinkDown( - (0xabd9878L, 1l), - (0x9878abdL, 6l) - ) in - let link_down_json = from_string (In_channel.read_all "lib_test/data/link_down.json") in - event_to_json link_down_event = link_down_json - -let%test "event_to_json serializes a Host Up event with a format like host_up.json" = - let host_up_event = Frenetic_NetKAT.HostUp( - (0xabd9878L, 1l), - (0x786ab8979873L, 0x12345678l) - ) in - let host_up_json = from_string (In_channel.read_all "lib_test/data/host_up.json") in - event_to_json host_up_event = host_up_json + let port_down_json = In_channel.read_all "lib_test/data/port_down.json" in + event_to_json_string port_down_event = port_down_json -let%test "event_to_json serializes a Host Down event with a format like host_up.json" = - let host_down_event = Frenetic_NetKAT.HostDown( - (0xabd9878L, 1l), - (0x786ab8979873L, 0x12345678l) - ) in - let host_down_json = from_string (In_channel.read_all "lib_test/data/host_down.json") in - event_to_json host_down_event = host_down_json - -let%test "stats_to_json serializes an OpenFlow stats response like stats.json" = +let%test "stats_to_json_string serializes an OpenFlow stats response like stats.json" = let stats_response = (0xaceL, 0xace45L) in - let stats_json = from_string (In_channel.read_all "lib_test/data/stats.json") in - stats_to_json stats_response = stats_json + let stats_json = In_channel.read_all "lib_test/data/stats.json" in + stats_to_json_string stats_response = stats_json let sample_port_stats_response = - let open Frenetic_OpenFlow0x01 in - [ { - port_no = 1000 - ; rx_packets = 2000000000L - ; tx_packets = 3000000000L - ; rx_bytes = 4000000000L - ; tx_bytes = 5000000000L - ; rx_dropped = 6000000000L - ; tx_dropped = 7000000000L - ; rx_errors = 8000000000L - ; tx_errors = 9000000000L - ; rx_frame_err = 10000000000L - ; rx_over_err = 11000000000L - ; rx_crc_err = 12000000000L - ; collisions = 13000000000L - }] + let open Frenetic_OpenFlow in + { + port_no = 1000L + ; port_rx_packets = 2000000000L + ; port_tx_packets = 3000000000L + ; port_rx_bytes = 4000000000L + ; port_tx_bytes = 5000000000L + ; port_rx_dropped = 6000000000L + ; port_tx_dropped = 7000000000L + ; port_rx_errors = 8000000000L + ; port_tx_errors = 9000000000L + ; port_rx_frame_err = 10000000000L + ; port_rx_over_err = 11000000000L + ; port_rx_crc_err = 12000000000L + ; port_collisions = 13000000000L + } + +let sample_flow_stats_response = + let open Frenetic_OpenFlow in { + flow_table_id = 66L; flow_pattern = Pattern.match_all; + flow_actions = []; flow_duration_sec = 200L; flow_duration_nsec = 300L; + flow_priority = 400L; flow_idle_timeout = 500L; flow_hard_timeout = 600L; + flow_packet_count = 700L; flow_byte_count = 800L + } let%test "port_stats_to_json serializes an OpenFlow stats response like port_stats.json" = - let port_stats_json = from_string (In_channel.read_all "lib_test/data/port_stats.json") in - port_stats_to_json sample_port_stats_response = port_stats_json + let port_stats_json = In_channel.read_all "lib_test/data/port_stats.json" in + port_stat_to_json_string sample_port_stats_response = port_stats_json let%test "policy_of_json_string deserializes a NetKAT-Json string from example1 into a NetKAT policy" = let nk_policy = Frenetic_NetKAT_Parser.policy_of_string (In_channel.read_all "examples/example1.kat") in let example1_json_str = In_channel.read_all "lib_test/data/example1_reversed.json" in policy_of_json_string example1_json_str = nk_policy -let%test "event_to_json_string serializes an OpenFlow Query event with a format like query.json" = - let query_event = Frenetic_NetKAT.Query( - "ignored", - 9823745L, - 982734578L +let%test "event_to_json_string serializes an OpenFlow FlowStats event with a format like flow_stats.json" = + let query_event = Frenetic_OpenFlow.FlowStats( + 0x9878abcL, + sample_flow_stats_response ) in - let query_json_str = In_channel.read_all "lib_test/data/query.json" in + let query_json_str = In_channel.read_all "lib_test/data/flow_stats.json" in event_to_json_string query_event = query_json_str let%test "policy_to_json_string serializes a NetKAT policy like example1.kat" = @@ -159,5 +125,52 @@ let%test "stats_to_json_string serializes an OpenFlow stats response like stats. let%test "port_stats_to_json_string serializes an OpenFlow stats response like port_stats.json" = let port_stats_json_str = In_channel.read_all "lib_test/data/port_stats.json" in - port_stats_to_json_string sample_port_stats_response = port_stats_json_str - + port_stat_to_json_string sample_port_stats_response = port_stats_json_str + + +let%test "pseudoport_to_json serializes a physical port in json format" = + let phys_port = Frenetic_OpenFlow.Physical 6325l in + to_string (pseudoport_to_json phys_port) = "{\"type\":\"physical\",\"port\":6325}" + +let%test "pseudoport_to_json serializes a controller port in json format" = + let controller_port = Frenetic_OpenFlow.Controller 5236 in + to_string (pseudoport_to_json controller_port) = "{\"type\":\"controller\",\"bytes\":5236}" + +let%test "pseudoport_from_json parses a physical port from json format" = + let phys_port_json_str = from_string "{\"type\":\"physical\",\"port\":6325}" in + (pseudoport_from_json phys_port_json_str) = Physical 6325l + +let%test "pseudoport_to_json serializes a controller port in json format" = + let controller_port_json_str = from_string "{\"type\":\"controller\",\"bytes\":5236}" in + (pseudoport_from_json controller_port_json_str) = Controller 5236 + +let%test "pkt_out returns switch and abstract Packet Out message from Json format" = + let sample_packet_out_str = In_channel.read_all "lib_test/data/pkt_out_multiple_ports.json" in + let sample_packet_out = pkt_out_from_json (from_string sample_packet_out_str) in + sample_packet_out = ( + 843509872345L, + Some 20l, + (NotBuffered (Cstruct.of_string "Hi mom!")), + [ Mod(Location(Physical 1l)); Mod(Location(Physical 2l)) ] + ) + +let%test "pkt_out handles buffered data Json format" = + let sample_packet_out_str = In_channel.read_all "lib_test/data/pkt_out_buffered.json" in + let sample_packet_out = pkt_out_from_json (from_string sample_packet_out_str) in + sample_packet_out = ( + 843509872345L, + None, + Buffered (8192374l, Cstruct.of_string ""), + [ Mod(Location(Pipe "pipe")) ] + ) + +let%test "flowTable_to_json serializes a flow table in Json format" = + let ft = Test_Frenetic_OpenFlow.nightmare_pattern_table in + to_string (flowTable_to_json ft) = (In_channel.read_all "lib_test/data/flow_table_nightmare_pattern.json") + +let%test "flowTable_to_json doesn't handle multiple actions" = + let ft = Test_Frenetic_OpenFlow.sample_flow_table in + Exn.does_raise (fun () -> + to_string (flowTable_to_json ft) = "" + ) + \ No newline at end of file diff --git a/lib_test/Test_Frenetic_NetKAT_SDN_Json.ml b/lib_test/Test_Frenetic_NetKAT_SDN_Json.ml deleted file mode 100644 index 8d83ec89f..000000000 --- a/lib_test/Test_Frenetic_NetKAT_SDN_Json.ml +++ /dev/null @@ -1,53 +0,0 @@ -open Core.Std -open Frenetic_OpenFlow -open Frenetic_NetKAT_SDN_Json -open Yojson.Basic - -let%test "pseudoport_to_json serializes a physical port in json format" = - let phys_port = Physical 6325l in - to_string (pseudoport_to_json phys_port) = "{\"type\":\"physical\",\"port\":6325}" - -let%test "pseudoport_to_json serializes a controller port in json format" = - let controller_port = Controller 5236 in - to_string (pseudoport_to_json controller_port) = "{\"type\":\"controller\",\"bytes\":5236}" - -let%test "pseudoport_from_json parses a physical port from json format" = - let phys_port_json_str = from_string "{\"type\":\"physical\",\"port\":6325}" in - (pseudoport_from_json phys_port_json_str) = Physical 6325l - -let%test "pseudoport_to_json serializes a controller port in json format" = - let controller_port_json_str = from_string "{\"type\":\"controller\",\"bytes\":5236}" in - (pseudoport_from_json controller_port_json_str) = Controller 5236 - -let%test "pkt_out returns switch and abstract Packet Out message from Json format" = - let sample_packet_out_str = In_channel.read_all "lib_test/data/pkt_out_multiple_ports.json" in - let sample_packet_out = pkt_out_from_json (from_string sample_packet_out_str) in - sample_packet_out = ( - 843509872345L, - (NotBuffered (Cstruct.of_string "Hi mom!"), Some 20l, [ Output(Physical 1l); Output(Physical 2l) ]) - ) - -let%test "pkt_out handles buffered data Json format" = - let sample_packet_out_str = In_channel.read_all "lib_test/data/pkt_out_buffered.json" in - let sample_packet_out = pkt_out_from_json (from_string sample_packet_out_str) in - sample_packet_out = ( - 843509872345L, - (Buffered (8192374l, Cstruct.of_string ""), None, [ Output(Controller 1024) ]) - ) - -let%test "pkt_out doesn't support modify action" = - let sample_packet_out_modify_json = from_string "{ \"actions\": [ {\"type\": \"modify\"} ] }" in - Exn.does_raise (fun () -> - (pkt_out_from_json sample_packet_out_modify_json) = (0L, (NotBuffered (Cstruct.of_string ""), None, [])) - ) - -let%test "flowTable_to_json serializes a flow table in Json format" = - let ft = Test_Frenetic_OpenFlow.nightmare_pattern_table in - to_string (flowTable_to_json ft) = (In_channel.read_all "lib_test/data/flow_table_nightmare_pattern.json") - -let%test "flowTable_to_json doesn't handle multiple actions" = - let ft = Test_Frenetic_OpenFlow.sample_flow_table in - Exn.does_raise (fun () -> - to_string (flowTable_to_json ft) = "" - ) - \ No newline at end of file diff --git a/lib_test/data/flow_stats.json b/lib_test/data/flow_stats.json new file mode 100644 index 000000000..4af48b8fa --- /dev/null +++ b/lib_test/data/flow_stats.json @@ -0,0 +1 @@ +{"packets":700,"bytes":800} \ No newline at end of file diff --git a/lib_test/data/pkt_out_buffered.json b/lib_test/data/pkt_out_buffered.json index 64b984b03..a8d0cb396 100644 --- a/lib_test/data/pkt_out_buffered.json +++ b/lib_test/data/pkt_out_buffered.json @@ -1,6 +1,6 @@ { - "actions": [ - { "type": "output", "pseudoport": { "type":"controller", "bytes":1024 } } + "policies": [ + { "type": "mod", "header":"location", "value": { "type":"pipe", "name":"pipe" } } ], "switch": 843509872345, "payload": { diff --git a/lib_test/data/pkt_out_multiple_ports.json b/lib_test/data/pkt_out_multiple_ports.json index e81fe7f19..a5ae6373d 100644 --- a/lib_test/data/pkt_out_multiple_ports.json +++ b/lib_test/data/pkt_out_multiple_ports.json @@ -1,7 +1,7 @@ { - "actions": [ - { "type": "output", "pseudoport": { "type":"physical", "port":1 } }, - { "type": "output", "pseudoport": { "type":"physical", "port":2 } } + "policies": [ + { "type": "mod", "header":"location", "value": { "type":"physical", "port":1 } }, + { "type": "mod", "header":"location", "value": { "type":"physical", "port":2 } } ], "in_port": 20, "switch": 843509872345, diff --git a/lib_test/data/port_stats.json b/lib_test/data/port_stats.json index 04748b7e0..13172a250 100644 --- a/lib_test/data/port_stats.json +++ b/lib_test/data/port_stats.json @@ -1 +1 @@ -[{"port_no":1000,"rx_packets":2000000000,"tx_packets":3000000000,"rx_bytes":4000000000,"tx_bytes":5000000000,"rx_dropped":6000000000,"tx_dropped":7000000000,"rx_errors":8000000000,"tx_errors":9000000000,"rx_fram_err":10000000000,"rx_over_err":11000000000,"rx_crc_err":12000000000,"collisions":13000000000}] \ No newline at end of file +{"port_no":1000,"rx_packets":2000000000,"tx_packets":3000000000,"rx_bytes":4000000000,"tx_bytes":5000000000,"rx_dropped":6000000000,"tx_dropped":7000000000,"rx_errors":8000000000,"tx_errors":9000000000,"rx_fram_err":10000000000,"rx_over_err":11000000000,"rx_crc_err":12000000000,"collisions":13000000000} \ No newline at end of file diff --git a/lib_test/data/query.json b/lib_test/data/query.json deleted file mode 100644 index f9756b049..000000000 --- a/lib_test/data/query.json +++ /dev/null @@ -1 +0,0 @@ -{"type":"query","packet_count":9823745,"byte_count":982734578} \ No newline at end of file diff --git a/setup.ml b/setup.ml index 61116f4a4..e747400c5 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ -(* setup.ml generated for the first time by OASIS v0.4.5 *) +(* setup.ml generated for the first time by OASIS v0.4.6 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 4c333c3ed9fc2e028fac0ab665ec82de) *) +(* DO NOT EDIT (digest: 2199ee8c8591b8a10a103774b1d0d7e9) *) (* Regenerated by OASIS v0.4.6 Visit http://oasis.forge.ocamlcore.org for more information and @@ -7045,7 +7045,6 @@ let setup_t = "Frenetic_NetKAT_Net"; "Frenetic_NetKAT_Parser"; "Frenetic_NetKAT_Pretty"; - "Frenetic_NetKAT_SDN_Json"; "Frenetic_NetKAT_Semantics"; "Frenetic_Network"; "Frenetic_OpenFlow"; @@ -7104,9 +7103,8 @@ let setup_t = "Frenetic_Compile_Server"; "Frenetic_Log"; "Frenetic_Http_Controller"; - "Frenetic_OpenFlow0x01_Controller"; + "Frenetic_OpenFlow0x01_Plugin"; "Frenetic_NetKAT_Controller"; - "Frenetic_NetKAT_Updates"; "Frenetic_Ox" ]; lib_pack = false; @@ -7415,7 +7413,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.6"; - oasis_digest = Some "\154\222\148\162r?\\\173\163H\158\007\014\190;x"; + oasis_digest = Some "\146\226'z\196]} ~\231\007\211\238;\193j"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7423,6 +7421,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7427 "setup.ml" +# 7425 "setup.ml" (* OASIS_STOP *) let () = setup ();;