From 08790ec1dadb06931947ff989a41966c06033c8f Mon Sep 17 00:00:00 2001 From: Nate Foster Date: Fri, 24 Jun 2016 14:22:57 -0700 Subject: [PATCH] Porting Ox to new version of Frenetic --- INSTALL.txt | 5 +- _oasis | 5 +- _tags | 7 +- lib/META | 4 +- lib/OxPlatform.ml | 4 +- lib/OxPlatform.mli | 2 +- lib/OxShared.ml | 10 +-- lib/OxStart.ml | 30 ++++---- lib/OxStart.mli | 6 +- myocamlbuild.ml | 174 +++++++++++++++++++++++++++++++++++++++++++-- setup.ml | 74 ++++++++++++------- 11 files changed, 251 insertions(+), 70 deletions(-) diff --git a/INSTALL.txt b/INSTALL.txt index f828f7d..856764d 100644 --- a/INSTALL.txt +++ b/INSTALL.txt @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: e4ae9e88b0cee5cb9aef1898181ef22f) *) +(* DO NOT EDIT (digest: 35200b916d368e4d386e9e1449f146fd) *) This is the INSTALL file for the ox distribution. @@ -15,8 +15,7 @@ In order to compile this package, you will need: * findlib * core * async -* packet -* openflow +* frenetic Installing ========== diff --git a/_oasis b/_oasis index 7e0d0bb..8be918e 100644 --- a/_oasis +++ b/_oasis @@ -17,9 +17,8 @@ Library ox BuildDepends: core, async, - packet, - openflow, - openflow.async, + frenetic, + frenetic.async, threads InternalModules: OxShared diff --git a/_tags b/_tags index e330a7e..754138e 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: e34aa0ffc9f1beb9d8a2c71f6dc4ec01) +# DO NOT EDIT (digest: be6f5fd087e4c9140e58480195f1c16d) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -18,8 +18,7 @@ true: annot, bin_annot "lib/ox.cmxs": use_ox : pkg_async : pkg_core -: pkg_openflow -: pkg_openflow.async -: pkg_packet +: pkg_frenetic +: pkg_frenetic.async : pkg_threads # OASIS_STOP diff --git a/lib/META b/lib/META index 27c4a2d..27e031e 100644 --- a/lib/META +++ b/lib/META @@ -1,8 +1,8 @@ # OASIS_START -# DO NOT EDIT (digest: 9d36368bbed2bf00c465d0675c615221) +# DO NOT EDIT (digest: e17cb1c19adcec895aed2b17343b25db) version = "1.1.1" description = "A platform for writing OpenFlow controllers" -requires = "core async packet openflow openflow.async threads" +requires = "core async frenetic frenetic.async threads" archive(byte) = "ox.cma" archive(byte, plugin) = "ox.cma" archive(native) = "ox.cmxa" diff --git a/lib/OxPlatform.ml b/lib/OxPlatform.ml index 0e7b983..e024ec6 100644 --- a/lib/OxPlatform.ml +++ b/lib/OxPlatform.ml @@ -1,8 +1,8 @@ open Async.Std open Printf -open Packet -open OpenFlow0x01 +open Frenetic_Packet +open Frenetic_OpenFlow0x01 open Message open OxShared diff --git a/lib/OxPlatform.mli b/lib/OxPlatform.mli index 1a831f2..7ce54bd 100644 --- a/lib/OxPlatform.mli +++ b/lib/OxPlatform.mli @@ -1,5 +1,5 @@ (** Functions that an Ox controller can use to send OpenFlow messages. *) -open OpenFlow0x01 +open Frenetic_OpenFlow0x01 (** [send_packet_out sw xid pkt] sends a [packetOut] message with transaction ID [xid] to switch [sw]. *) diff --git a/lib/OxShared.ml b/lib/OxShared.ml index 4951452..e39b3eb 100644 --- a/lib/OxShared.ml +++ b/lib/OxShared.ml @@ -1,8 +1,8 @@ open Core.Std open Async.Std -open Packet -open OpenFlow0x01 +open Frenetic_Packet +open Frenetic_OpenFlow0x01 type to_sw = switchId * xid * Message.t @@ -19,6 +19,6 @@ let munge_exns thk = | Ok () -> () | Error exn -> - Printf.eprintf - "unhandled exception raised by a callback\n%s" - (Exn.to_string exn) + eprintf + "unhandled exception raised by a callback\n%s" + (Exn.to_string exn) diff --git a/lib/OxStart.ml b/lib/OxStart.ml index b2615fa..b7a3230 100644 --- a/lib/OxStart.ml +++ b/lib/OxStart.ml @@ -1,13 +1,13 @@ open Printf -open Packet -open OpenFlow0x01 +open Frenetic_Packet +open Frenetic_OpenFlow0x01 open OxShared -open OpenFlow_Header +open Frenetic_OpenFlow_Header -module Controller = Async_OpenFlow0x01_Controller +module Controller = Frenetic_OpenFlow0x01_Controller module type OXMODULE = sig - val switch_connected : switchId -> OpenFlow0x01.SwitchFeatures.t -> unit + val switch_connected : switchId -> SwitchFeatures.t -> unit val switch_disconnected : switchId -> unit val packet_in : switchId -> xid -> packetIn -> unit val barrier_reply : switchId -> xid -> unit @@ -37,7 +37,7 @@ module Make (Handlers:OXMODULE) = struct open Core.Std let send_pkt_out ((sw, xid, msg) : switchId * xid * Message.t) : unit Deferred.t = - match Controller.send sw xid msg with + Controller.send sw xid msg >>= function | `Ok -> return () | `Eof -> @@ -48,14 +48,16 @@ module Make (Handlers:OXMODULE) = struct match event with | `Connect (sw, feats) -> begin - match - Controller.send sw 0l (FlowModMsg delete_all_flows), - Controller.send sw 1l BarrierRequest - with - | `Ok, `Ok -> - return (Handlers.switch_connected sw feats) - | _ -> - return () + Controller.send sw 0l (FlowModMsg delete_all_flows) >>= function + | `Ok -> + begin Controller.send sw 1l BarrierRequest >>= function + | `Ok -> + return (Handlers.switch_connected sw feats) + | `Eof -> + return () + end + | `Eof -> + return () end | `Message (sw, hdr, msg) -> let xid = hdr.xid in diff --git a/lib/OxStart.mli b/lib/OxStart.mli index ca481fd..8ceca4e 100644 --- a/lib/OxStart.mli +++ b/lib/OxStart.mli @@ -1,5 +1,5 @@ (** Launches an Ox application. *) -open OpenFlow0x01 +open Frenetic_OpenFlow0x01 (** Provides default implementations for some advanced event handlers, reducing clutter in simple controllers. @@ -7,7 +7,7 @@ open OpenFlow0x01 These event handlers simply ignore the messages they receive. *) module DefaultTutorialHandlers : sig - val switch_connected : switchId -> OpenFlow0x01.SwitchFeatures.t -> unit + val switch_connected : switchId -> SwitchFeatures.t -> unit val switch_disconnected : switchId -> unit val barrier_reply : switchId -> xid -> unit val stats_reply : switchId -> xid -> reply -> unit @@ -22,7 +22,7 @@ module type OXMODULE = sig (** [switch_connected sw] is a callback invoked with [sw] when a switch with identifer [sw] connects to the controller. *) - val switch_connected : switchId -> OpenFlow0x01.SwitchFeatures.t -> unit + val switch_connected : switchId -> SwitchFeatures.t -> unit (** [switch_disconnected sw] is a callback invoked with [sw] when a switch with identifer [sw] disconnects from the controller. *) diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 7394402..a4d82c6 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: 1c0c7f056bc2cccbbf191e545d3c59a0) *) +(* DO NOT EDIT (digest: 32c3737ffaeac89985cc6bd468f30065) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -29,6 +29,166 @@ module OASISGettext = struct end +module OASISString = struct +(* # 22 "src/oasis/OASISString.ml" *) + + + (** Various string utilities. + + Mostly inspired by extlib and batteries ExtString and BatString libraries. + + @author Sylvain Le Gall + *) + + + let nsplitf str f = + if str = "" then + [] + else + let buf = Buffer.create 13 in + let lst = ref [] in + let push () = + lst := Buffer.contents buf :: !lst; + Buffer.clear buf + in + let str_len = String.length str in + for i = 0 to str_len - 1 do + if f str.[i] then + push () + else + Buffer.add_char buf str.[i] + done; + push (); + List.rev !lst + + + (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the + separator. + *) + let nsplit str c = + nsplitf str ((=) c) + + + let find ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + while !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + what_idx := 0; + incr str_idx + done; + if !what_idx <> String.length what then + raise Not_found + else + !str_idx - !what_idx + + + let sub_start str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str len (str_len - len) + + + let sub_end ?(offset=0) str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str 0 (str_len - len) + + + let starts_with ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + let ok = ref true in + while !ok && + !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + ok := false; + incr str_idx + done; + if !what_idx = String.length what then + true + else + false + + + let strip_starts_with ~what str = + if starts_with ~what str then + sub_start str (String.length what) + else + raise Not_found + + + let ends_with ~what ?(offset=0) str = + let what_idx = ref ((String.length what) - 1) in + let str_idx = ref ((String.length str) - 1) in + let ok = ref true in + while !ok && + offset <= !str_idx && + 0 <= !what_idx do + if str.[!str_idx] = what.[!what_idx] then + decr what_idx + else + ok := false; + decr str_idx + done; + if !what_idx = -1 then + true + else + false + + + let strip_ends_with ~what str = + if ends_with ~what str then + sub_end str (String.length what) + else + raise Not_found + + + let replace_chars f s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> Buffer.add_char buf (f c)) s; + Buffer.contents buf + + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + +end + module OASISExpr = struct (* # 22 "src/oasis/OASISExpr.ml" *) @@ -129,7 +289,7 @@ module OASISExpr = struct end -# 132 "myocamlbuild.ml" +# 292 "myocamlbuild.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -234,7 +394,7 @@ module BaseEnvLight = struct end -# 237 "myocamlbuild.ml" +# 397 "myocamlbuild.ml" module MyOCamlbuildFindlib = struct (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) @@ -516,7 +676,7 @@ module MyOCamlbuildBase = struct | nm, [], intf_modules -> ocaml_lib nm; let cmis = - List.map (fun m -> (String.uncapitalize m) ^ ".cmi") + List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis | nm, dir :: tl, intf_modules -> @@ -529,7 +689,7 @@ module MyOCamlbuildBase = struct ["compile"; "infer_interface"; "doc"]) tl; let cmis = - List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") + List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] cmis) @@ -603,7 +763,7 @@ module MyOCamlbuildBase = struct end -# 606 "myocamlbuild.ml" +# 766 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { @@ -618,6 +778,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 622 "myocamlbuild.ml" +# 782 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml index e81a186..bb3395c 100644 --- a/setup.ml +++ b/setup.ml @@ -1,9 +1,9 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: e705d655505900a9a938004ce14f23ac) *) +(* DO NOT EDIT (digest: b6d2c2d987d81c9cfe01439defb48758) *) (* - Regenerated by OASIS v0.4.5 + Regenerated by OASIS v0.4.6 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -246,6 +246,33 @@ module OASISString = struct String.iter (fun c -> Buffer.add_char buf (f c)) s; Buffer.contents buf + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s end @@ -315,19 +342,15 @@ module OASISUtils = struct let compare_csl s1 s2 = - String.compare (String.lowercase s1) (String.lowercase s2) + String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) module HashStringCsl = Hashtbl.Make (struct type t = string - - let equal s1 s2 = - (String.lowercase s1) = (String.lowercase s2) - - let hash s = - Hashtbl.hash (String.lowercase s) + let equal s1 s2 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) end) module SetStringCsl = @@ -365,7 +388,7 @@ module OASISUtils = struct else buf in - String.lowercase buf + OASISString.lowercase_ascii buf end @@ -471,7 +494,7 @@ module PropList = struct order = Queue.create (); name_norm = (if case_insensitive then - String.lowercase + OASISString.lowercase_ascii else fun s -> s); } @@ -1822,13 +1845,13 @@ module OASISUnixPath = struct let capitalize_file f = let dir = dirname f in let base = basename f in - concat dir (String.capitalize base) + concat dir (OASISString.capitalize_ascii base) let uncapitalize_file f = let dir = dirname f in let base = basename f in - concat dir (String.uncapitalize base) + concat dir (OASISString.uncapitalize_ascii base) end @@ -2890,7 +2913,7 @@ module OASISFileUtil = struct end -# 2893 "setup.ml" +# 2916 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -2995,7 +3018,7 @@ module BaseEnvLight = struct end -# 2998 "setup.ml" +# 3021 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5406,7 +5429,7 @@ module BaseSetup = struct end -# 5409 "setup.ml" +# 5432 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -5845,8 +5868,8 @@ module InternalInstallPlugin = struct let make_fnames modul sufx = List.fold_right begin fun sufx accu -> - (String.capitalize modul ^ sufx) :: - (String.uncapitalize modul ^ sufx) :: + (OASISString.capitalize_ascii modul ^ sufx) :: + (OASISString.uncapitalize_ascii modul ^ sufx) :: accu end sufx @@ -6270,7 +6293,7 @@ module InternalInstallPlugin = struct end -# 6273 "setup.ml" +# 6296 "setup.ml" module OCamlbuildCommon = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) @@ -6648,7 +6671,7 @@ module OCamlbuildDocPlugin = struct end -# 6651 "setup.ml" +# 6674 "setup.ml" open OASISTypes;; let setup_t = @@ -6757,9 +6780,8 @@ let setup_t = [ FindlibPackage ("core", None); FindlibPackage ("async", None); - FindlibPackage ("packet", None); - FindlibPackage ("openflow", None); - FindlibPackage ("openflow.async", None); + FindlibPackage ("frenetic", None); + FindlibPackage ("frenetic.async", None); FindlibPackage ("threads", None) ]; bs_build_tools = @@ -6821,8 +6843,8 @@ let setup_t = plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.5"; - oasis_digest = Some "ª\003\030pÇ\148hÐ{Î\015áy\003&×"; + oasis_version = "0.4.6"; + oasis_digest = Some ")\246\133\161g\0113[K*p\139\014\230\012\\"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -6830,6 +6852,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 6834 "setup.ml" +# 6856 "setup.ml" (* OASIS_STOP *) let () = setup ();;