diff --git a/_oasis b/_oasis index abc1205..0df8be6 100644 --- a/_oasis +++ b/_oasis @@ -41,6 +41,8 @@ Library openflow OpenFlow0x01_Stats, OpenFlow0x04, OpenFlow0x04_Core, + OpenFlow0x05, + OpenFlow0x05_Core, SDN_OpenFlow0x01, SDN_OpenFlow0x04, GroupTable0x04, @@ -83,6 +85,7 @@ Library quickcheck Arbitrary_OpenFlow, Arbitrary_OpenFlow0x01, Arbitrary_OpenFlow0x04, + Arbitrary_OpenFlow0x05, Arbitrary_SDN_Types Executable testtool diff --git a/lib/OpenFlow0x04.ml b/lib/OpenFlow0x04.ml index 6a98e69..67d47ad 100644 --- a/lib/OpenFlow0x04.ml +++ b/lib/OpenFlow0x04.ml @@ -2358,6 +2358,8 @@ end module Action = struct + type t = action + type sequence = OpenFlow0x04_Core.actionSequence let sizeof (act : action) : int = match act with @@ -2976,6 +2978,8 @@ end module Instruction = struct + type t = instruction + let to_string ins = match ins with | GotoTable t -> Format.sprintf "Go to Table = %u" t @@ -3095,6 +3099,8 @@ end module Instructions = struct + type t = instruction list + let sizeof (inss : instruction list) : int = sum (map Instruction.sizeof inss) diff --git a/lib/OpenFlow0x04.mli b/lib/OpenFlow0x04.mli index c5820b9..d822f06 100644 --- a/lib/OpenFlow0x04.mli +++ b/lib/OpenFlow0x04.mli @@ -124,6 +124,8 @@ end module Action : sig + type t = action + type sequence = OpenFlow0x04_Core.actionSequence val sizeof : action -> int @@ -221,25 +223,29 @@ end module Instruction : sig - val to_string : instruction -> string + type t = instruction - val sizeof : instruction -> int + val to_string : t -> string - val marshal : Cstruct.t -> instruction -> int + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int - val parse : Cstruct.t -> instruction + val parse : Cstruct.t -> t end module Instructions : sig - val sizeof : instruction list -> int + type t = instruction list - val marshal : Cstruct.t -> instruction list -> int + val sizeof : t -> int - val to_string : instruction list -> string + val marshal : Cstruct.t -> t -> int - val parse : Cstruct.t -> instruction list + val to_string : t -> string + + val parse : Cstruct.t -> t end diff --git a/lib/OpenFlow0x05.ml b/lib/OpenFlow0x05.ml new file mode 100644 index 0000000..6c8291d --- /dev/null +++ b/lib/OpenFlow0x05.ml @@ -0,0 +1,2644 @@ +(** OpenFlow 1.4 (protocol version 0x05) *) + +open Printf +open Cstruct +open Cstruct.BE + +open OpenFlow0x05_Core +open List +open Packet + +exception Unparsable of string +let sym_num = ref 0 + +let sum (lst : int list) = List.fold_left (fun x y -> x + y) 0 lst + +type uint128 = int64*int64 +type uint48 = uint64 +type uint24 = int32 +type uint12 = uint16 +type switchId = OpenFlow0x05_Core.switchId + +let ofpp_in_port = 0xfffffff8l +let ofpp_flood = 0xfffffffbl +let ofpp_all = 0xfffffffcl +let ofpp_controller = 0xfffffffdl +let ofpp_any = 0xffffffffl + +let ofp_no_buffer = 0xffffffffl + +(* Not in the spec, comes from C headers. :rolleyes: *) +let ofpg_all = 0xfffffffcl +let ofpg_any = 0xffffffffl +let ofp_eth_alen = 6 (* Bytes in an Ethernet address. *) + +let rec marshal_fields (buf: Cstruct.t) (fields : 'a list) (marshal_func : Cstruct.t -> 'a -> int ): int = + if (fields = []) then 0 + else let size = marshal_func buf (List.hd fields) in + size + (marshal_fields (Cstruct.shift buf size) (List.tl fields) marshal_func) + +let parse_fields (bits : Cstruct.t) (parse_func : Cstruct.t -> 'a) (length_func : Cstruct.t -> int option) :'a list = + let iter = + Cstruct.iter + length_func + parse_func + bits in + List.rev (Cstruct.fold (fun acc bits -> bits :: acc) iter []) + +let pad_to_64bits (n : int) : int = + if n land 0x7 <> 0 then + n + (8 - (n land 0x7)) + else + n + +cstruct ofp_uint8 { + uint8_t value +} as big_endian + +cstruct ofp_uint16 { + uint16_t value +} as big_endian + +cstruct ofp_uint24 { + uint16_t high; + uint8_t low +} as big_endian + +cstruct ofp_uint32 { + uint32_t value +} as big_endian + +cstruct ofp_uint48 { + uint32_t high; + uint16_t low +} as big_endian + +cstruct ofp_uint64 { + uint64_t value +} as big_endian + +cstruct ofp_uint128 { + uint64_t high; + uint64_t low +} as big_endian + +let max_uint32 = 4294967296L (* = 2^32*) + +let compare_uint32 a b = +(* val compare_uint32 : uint32 -> uint32 -> bool ; return a < b, for a, b uint32 *) + let a' = if a < 0l then + Int64.sub max_uint32 (Int64.of_int32 (Int32.abs a)) + else Int64.of_int32 a in + let b' = if b < 0l then + Int64.sub max_uint32 (Int64.of_int32 (Int32.abs b)) + else Int64.of_int32 b in + a' <= b' + +let set_ofp_uint48_value (buf : Cstruct.t) (value : uint48) = + let high = Int64.to_int32 (Int64.shift_right_logical value 16) in + let low = ((Int64.to_int value) land 0xffff) in + set_ofp_uint48_high buf high; + set_ofp_uint48_low buf low + +let get_ofp_uint48_value (buf : Cstruct.t) : uint48 = + let highBits = get_ofp_uint48_high buf in + let high = Int64.shift_left ( + if highBits < 0l then + Int64.sub max_uint32 (Int64.of_int32 (Int32.abs highBits)) + else + Int64.of_int32 highBits) 16 in + let low = Int64.of_int (get_ofp_uint48_low buf) in + Int64.logor low high + +let get_ofp_uint24_value (buf : Cstruct.t) : uint24 = + let high = Int32.shift_left (Int32.of_int (get_ofp_uint24_high buf)) 8 in + let low = Int32.of_int (get_ofp_uint24_low buf )in + Int32.logor high low + +let set_ofp_uint24_value (buf : Cstruct.t) (value : uint24) = + let high = (Int32.to_int value) lsr 8 in + let low = (Int32.to_int value) land 0xff in + set_ofp_uint24_high buf high; + set_ofp_uint24_low buf low + +let set_ofp_uint128_value (buf : Cstruct.t) ((h,l) : uint128) = + set_ofp_uint128_high buf h; + set_ofp_uint128_low buf l + +let get_ofp_uint128_value (buf : Cstruct.t) : uint128 = + (get_ofp_uint128_high buf, get_ofp_uint128_low buf) + +let rec pad_with_zeros (buf : Cstruct.t) (pad : int) : int = + if pad = 0 then 0 + else begin set_ofp_uint8_value buf 0; + 1 + pad_with_zeros (Cstruct.shift buf 1) (pad - 1) end + +let test_bit16 (n:int) (x:int) : bool = + (x lsr n) land 1 = 1 + +cenum msg_code { + HELLO = 0; + ERROR = 1; + ECHO_REQ = 2; + ECHO_RESP = 3; + EXPERIMENTER = 4; + FEATURES_REQ = 5; + FEATURES_RESP = 6; + GET_CONFIG_REQ = 7; + GET_CONFIG_RESP = 8; + SET_CONFIG = 9; + PACKET_IN = 10; + FLOW_REMOVED = 11; + PORT_STATUS = 12; + PACKET_OUT = 13; + FLOW_MOD = 14; + GROUP_MOD = 15; + PORT_MOD = 16; + TABLE_MOD = 17; + MULTIPART_REQ = 18; + MULTIPART_RESP = 19; + BARRIER_REQ = 20; + BARRIER_RESP = 21; + ROLE_REQ = 24; + ROLE_RESP = 25; + GET_ASYNC_REQ = 26; + GET_ASYNC_REP = 27; + SET_ASYNC = 28; + METER_MOD = 29; + ROLE_STATUS = 30; + TABLE_STATUS = 31; + REQUEST_FORWARD = 32; + BUNDLE_CONTROL = 33; + BUNDLE_ADD_MESSAGE = 34 +} as uint8_t + +(* Common Structures *) +module PortDesc = struct + + cstruct ofp_port { + uint32_t port_no; + uint16_t length; + uint16_t pad; + uint8_t hw_addr[6]; + uint16_t pad2; + uint8_t name[16]; (* OFP_MAX_PORT_NAME_LEN, Null-terminated *) + uint32_t config; (* Bitmap of OFPPC_* flags. *) + uint32_t state; (* Bitmap of OFPPS_* flags. *) + } as big_endian + + module Config = struct + + type t = portConfig + + let config_to_int (config : portConfig) : int32 = + Int32.logor (if config.port_down then (Int32.shift_left 1l 0) else 0l) + (Int32.logor (if config.no_recv then (Int32.shift_left 1l 2) else 0l) + (Int32.logor (if config.no_fwd then (Int32.shift_left 1l 5) else 0l) + (if config.no_packet_in then (Int32.shift_left 1l 6) else 0l))) + + let marshal (pc : portConfig) : int32 = config_to_int pc + + let parse bits : portConfig = + { port_down = Bits.test_bit 0 bits; + no_recv = Bits.test_bit 2 bits; + no_fwd = Bits.test_bit 5 bits; + no_packet_in = Bits.test_bit 6 bits + } + + let to_string (config : portConfig) = + Format.sprintf "{ port_down = %b; no_recv = %b; no_fwd = %b; no_packet_in = %b }" + config.port_down + config.no_recv + config.no_fwd + config.no_packet_in + end + + module State = struct + + type t = portState + + let state_to_int (state : portState) : int32 = + Int32.logor (if state.link_down then (Int32.shift_left 1l 0) else 0l) + (Int32.logor (if state.blocked then (Int32.shift_left 1l 1) else 0l) + (if state.live then (Int32.shift_left 1l 2) else 0l)) + + let marshal (ps : portState) : int32 = state_to_int ps + + let parse bits : portState = + { link_down = Bits.test_bit 0 bits; + blocked = Bits.test_bit 1 bits; + live = Bits.test_bit 2 bits + } + + let to_string (state : portState) = + Format.sprintf "{ link_down = %B; blocked = %B; live = %B }" + state.link_down + state.blocked + state.live + end + + module Properties = struct + + module EthFeatures = struct + + type t = ethFeatures + + let features_to_int (features : ethFeatures) : int32 = + Int32.logor (if features.rate_10mb_hd then (Int32.shift_left 1l 0) else 0l) + (Int32.logor (if features.rate_10mb_fd then (Int32.shift_left 1l 1) else 0l) + (Int32.logor (if features.rate_100mb_hd then (Int32.shift_left 1l 2) else 0l) + (Int32.logor (if features.rate_100mb_fd then (Int32.shift_left 1l 3) else 0l) + (Int32.logor (if features.rate_1gb_hd then (Int32.shift_left 1l 4) else 0l) + (Int32.logor (if features.rate_1gb_fd then (Int32.shift_left 1l 5) else 0l) + (Int32.logor (if features.rate_10gb_fd then (Int32.shift_left 1l 6) else 0l) + (Int32.logor (if features.rate_40gb_fd then (Int32.shift_left 1l 7) else 0l) + (Int32.logor (if features.rate_100gb_fd then (Int32.shift_left 1l 8) else 0l) + (Int32.logor (if features.rate_1tb_fd then (Int32.shift_left 1l 9) else 0l) + (Int32.logor (if features.other then (Int32.shift_left 1l 10) else 0l) + (Int32.logor (if features.copper then (Int32.shift_left 1l 11) else 0l) + (Int32.logor (if features.fiber then (Int32.shift_left 1l 12) else 0l) + (Int32.logor (if features.autoneg then (Int32.shift_left 1l 13) else 0l) + (Int32.logor (if features.pause then (Int32.shift_left 1l 14) else 0l) + (if features.pause_asym then (Int32.shift_left 1l 15) else 0l))))))))))))))) + + let marshal (pf : ethFeatures) : int32 = features_to_int pf + + let parse bits : ethFeatures = + { rate_10mb_hd = Bits.test_bit 0 bits; + rate_10mb_fd = Bits.test_bit 1 bits; + rate_100mb_hd = Bits.test_bit 2 bits; + rate_100mb_fd = Bits.test_bit 3 bits; + rate_1gb_hd = Bits.test_bit 4 bits; + rate_1gb_fd = Bits.test_bit 5 bits; + rate_10gb_fd = Bits.test_bit 6 bits; + rate_40gb_fd = Bits.test_bit 7 bits; + rate_100gb_fd = Bits.test_bit 8 bits; + rate_1tb_fd = Bits.test_bit 9 bits; + other = Bits.test_bit 10 bits; + copper = Bits.test_bit 11 bits; + fiber = Bits.test_bit 12 bits; + autoneg = Bits.test_bit 13 bits; + pause = Bits.test_bit 14 bits; + pause_asym = Bits.test_bit 15 bits + } + + let to_string (feat : ethFeatures) = + Format.sprintf + "{ 10mhd = %B; 10mfd = %B; 100mhd = %B; 100mfd = %B; 1ghd%B\ + 1gfd = %B; 10gfd = %B; 40gfd = %B; 100gfd = %B; 1tfd = %B; \ + other = %B; copper = %B; fiber = %B; autoneg = %B; pause = %B; \ + pause_asym = %B }" + feat.rate_10mb_hd + feat.rate_10mb_fd + feat.rate_100mb_hd + feat.rate_100mb_fd + feat.rate_1gb_hd + feat.rate_1gb_fd + feat.rate_10gb_fd + feat.rate_40gb_fd + feat.rate_100gb_fd + feat.rate_1tb_fd + feat.other + feat.copper + feat.fiber + feat.autoneg + feat.pause + feat.pause_asym + + end + + module OptFeatures = struct + + type t = opticalFeatures + + let marshal (optFeat : opticalFeatures) : int32 = + Int32.logor (if optFeat.rx_tune then (Int32.shift_left 1l 0) else 0l) + (Int32.logor (if optFeat.tx_tune then (Int32.shift_left 1l 1) else 0l) + (Int32.logor (if optFeat.tx_pwr then (Int32.shift_left 1l 2) else 0l) + (if optFeat.use_freq then (Int32.shift_left 1l 3) else 0l))) + + let parse bits : opticalFeatures = + { rx_tune = Bits.test_bit 0 bits + ; tx_tune = Bits.test_bit 1 bits + ; tx_pwr = Bits.test_bit 2 bits + ; use_freq = Bits.test_bit 3 bits } + + let to_string (optFeat : opticalFeatures) : string = + Format.sprintf "{ rx_tune : %B; tx_tune : %B; tx_pwr : %B; use_freq : %B }" + optFeat.rx_tune + optFeat.tx_tune + optFeat.tx_pwr + optFeat.use_freq + + end + + cstruct ofp_port_desc_prop_header { + uint16_t typ; + uint16_t len + } as big_endian + + cstruct ofp_port_desc_prop_ethernet { + uint16_t typ; + uint16_t len; + uint8_t pad[4]; + uint32_t curr; + uint32_t advertised; + uint32_t supported; + uint32_t peer; + uint32_t curr_speed; + uint32_t max_speed + } as big_endian + + cstruct ofp_port_desc_prop_optical { + uint16_t typ; + uint16_t len; + uint8_t pad[4]; + uint32_t supported; + uint32_t tx_min_freq_lmda; + uint32_t tx_max_freq_lmda; + uint32_t tx_grid_freq_lmda; + uint32_t rx_min_freq_lmda; + uint32_t rx_max_freq_lmda; + uint32_t rx_grid_freq_lmda; + uint16_t tx_pwr_min; + uint16_t tx_pwr_max + } as big_endian + + cstruct ofp_port_desc_prop_experimenter { + uint16_t typ; + uint16_t len; + uint32_t experimenter; + uint32_t exp_typ + } as big_endian + + cenum ofp_port_desc_prop_type { + OFPPDPT_ETHERNET = 0; + OFPPDPT_OPTICAL = 1; + OFPPDPT_EXPERIMENTER = 0xFFFF + } as uint16_t + + type t = portProp + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_port_desc_prop_header then None + else Some (get_ofp_port_desc_prop_header_len buf) + + let sizeof (prop : t) : int = + match prop with + | PropEthernet _ -> 32 + | PropOptical _ -> 40 + | PropExp _ -> 12 + + let to_string (prop : t) : string = + match prop with + | PropEthernet p -> + Format.sprintf "Ethernet { curr = %s; advertised = %s; \ + supported = %s; peer = %s; \ + curr_speed = %lu; max_speed = %lu }" + (EthFeatures.to_string p.curr) + (EthFeatures.to_string p.advertised) + (EthFeatures.to_string p.supported) + (EthFeatures.to_string p.peer) + p.curr_speed + p.max_speed + | PropOptical p -> + Format.sprintf "Optical { supported : %s; tx_min_freq_lmda : %lu; tx_max_freq_lmda : %lu; \ + tx_grid_freq_lmda : %lu; rx_min_freq_lmda : %lu; rx_max_freq_lmda : %lu; \ + rx_grid_freq_lmda : %lu; tx_pwr_min : %u; tx_pwr_max : %u }" + (OptFeatures.to_string p.supported) + p.tx_min_freq_lmda + p.tx_max_freq_lmda + p.tx_grid_freq_lmda + p.rx_min_freq_lmda + p.rx_max_freq_lmda + p.rx_grid_freq_lmda + p.tx_pwr_min + p.tx_pwr_max + | PropExp p -> + Format.sprintf "Experimenter { experimenter : %lu; exp_typ : %lu }" + p.experimenter + p.exp_typ + + let marshal (buf : Cstruct.t) (prop : t) : int = + match prop with + | PropEthernet p -> + set_ofp_port_desc_prop_ethernet_typ buf (ofp_port_desc_prop_type_to_int OFPPDPT_ETHERNET); + set_ofp_port_desc_prop_ethernet_len buf (sizeof prop); + set_ofp_port_desc_prop_ethernet_curr buf (EthFeatures.marshal p.curr); + set_ofp_port_desc_prop_ethernet_advertised buf (EthFeatures.marshal p.advertised); + set_ofp_port_desc_prop_ethernet_supported buf (EthFeatures.marshal p.supported); + set_ofp_port_desc_prop_ethernet_peer buf (EthFeatures.marshal p.peer); + set_ofp_port_desc_prop_ethernet_curr_speed buf p.curr_speed; + set_ofp_port_desc_prop_ethernet_max_speed buf p.max_speed; + sizeof prop + | PropOptical p -> + set_ofp_port_desc_prop_optical_typ buf (ofp_port_desc_prop_type_to_int OFPPDPT_OPTICAL); + set_ofp_port_desc_prop_optical_len buf (sizeof prop); + set_ofp_port_desc_prop_optical_supported buf (OptFeatures.marshal p.supported); + set_ofp_port_desc_prop_optical_tx_min_freq_lmda buf p.tx_min_freq_lmda; + set_ofp_port_desc_prop_optical_tx_max_freq_lmda buf p.tx_max_freq_lmda; + set_ofp_port_desc_prop_optical_tx_grid_freq_lmda buf p.tx_grid_freq_lmda; + set_ofp_port_desc_prop_optical_rx_min_freq_lmda buf p.rx_min_freq_lmda; + set_ofp_port_desc_prop_optical_rx_max_freq_lmda buf p.rx_max_freq_lmda; + set_ofp_port_desc_prop_optical_rx_grid_freq_lmda buf p.rx_grid_freq_lmda; + set_ofp_port_desc_prop_optical_tx_pwr_min buf p.tx_pwr_min; + set_ofp_port_desc_prop_optical_tx_pwr_max buf p.tx_pwr_max; + sizeof prop + | PropExp p -> + set_ofp_port_desc_prop_experimenter_typ buf (ofp_port_desc_prop_type_to_int OFPPDPT_EXPERIMENTER); + set_ofp_port_desc_prop_experimenter_len buf (sizeof prop); + set_ofp_port_desc_prop_experimenter_experimenter buf p.experimenter; + set_ofp_port_desc_prop_experimenter_exp_typ buf p.exp_typ; + sizeof prop + + let parse (bits : Cstruct.t) : t = + let typ = match int_to_ofp_port_desc_prop_type (get_ofp_port_desc_prop_header_typ bits) with + | Some v -> v + | None -> raise (Unparsable (sprintf "malformed prop typ")) in + match typ with + | OFPPDPT_ETHERNET -> PropEthernet { curr = EthFeatures.parse (get_ofp_port_desc_prop_ethernet_curr bits) + ; advertised = EthFeatures.parse (get_ofp_port_desc_prop_ethernet_advertised bits) + ; supported = EthFeatures.parse (get_ofp_port_desc_prop_ethernet_supported bits) + ; peer = EthFeatures.parse (get_ofp_port_desc_prop_ethernet_peer bits) + ; curr_speed = get_ofp_port_desc_prop_ethernet_curr_speed bits + ; max_speed = get_ofp_port_desc_prop_ethernet_max_speed bits} + | OFPPDPT_OPTICAL -> PropOptical { supported = OptFeatures.parse (get_ofp_port_desc_prop_optical_supported bits) + ; tx_min_freq_lmda = get_ofp_port_desc_prop_optical_tx_min_freq_lmda bits + ; tx_max_freq_lmda = get_ofp_port_desc_prop_optical_tx_max_freq_lmda bits + ; tx_grid_freq_lmda = get_ofp_port_desc_prop_optical_tx_grid_freq_lmda bits + ; rx_min_freq_lmda = get_ofp_port_desc_prop_optical_rx_min_freq_lmda bits + ; rx_max_freq_lmda = get_ofp_port_desc_prop_optical_rx_max_freq_lmda bits + ; rx_grid_freq_lmda = get_ofp_port_desc_prop_optical_rx_grid_freq_lmda bits + ; tx_pwr_min = get_ofp_port_desc_prop_optical_tx_pwr_min bits + ; tx_pwr_max = get_ofp_port_desc_prop_optical_tx_pwr_max bits } + | OFPPDPT_EXPERIMENTER -> PropExp { experimenter = get_ofp_port_desc_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_port_desc_prop_experimenter_exp_typ bits} + end + + type t = portDesc + + let sizeof (p : portDesc) = + sizeof_ofp_port + sum (map Properties.sizeof p.properties) + + let marshal (buf : Cstruct.t) (desc : portDesc) : int = + let size = sizeof desc in + set_ofp_port_port_no buf desc.port_no; + set_ofp_port_length buf size; + set_ofp_port_pad buf 0; + set_ofp_port_hw_addr (bytes_of_mac desc.hw_addr) 0 buf; + set_ofp_port_pad2 buf 0; + set_ofp_port_name desc.name 0 buf; + set_ofp_port_config buf (Config.marshal desc.config); + set_ofp_port_state buf (State.marshal desc.state); + sizeof_ofp_port + marshal_fields (Cstruct.shift buf sizeof_ofp_port) desc.properties Properties.marshal + + + let parse (bits : Cstruct.t) : portDesc = + let port_no = get_ofp_port_port_no bits in + let hw_addr = mac_of_bytes (copy_ofp_port_hw_addr bits) in + let name = copy_ofp_port_name bits in + let state = State.parse (get_ofp_port_state bits) in + let config = Config.parse (get_ofp_port_config bits) in + let properties = parse_fields (Cstruct.shift bits sizeof_ofp_port) Properties.parse Properties.length_func in + { port_no; + hw_addr; + name; + config; + state; + properties} + + let to_string (port : portDesc) = + Format.sprintf " { port_no : %lu; hw_addr : %s; name : %s; config : %s; \ + state : %s; properties : %s }" + port.port_no + (string_of_mac port.hw_addr) + port.name + (Config.to_string port.config) + (State.to_string port.state) + ("[ " ^ (String.concat "; " (map Properties.to_string port.properties)) ^ " ]") + + + let length_func = (fun buf -> Some sizeof_ofp_port) +end + +cstruct ofp_oxm { + uint16_t oxm_class; + uint8_t oxm_field_and_hashmask; + uint8_t oxm_length +} as big_endian + +module Oxm = struct + + cenum ofp_oxm_class { + OFPXMC_NXM_0 = 0x0000; (* Backward compatibility with NXM *) + OFPXMC_NXM_1 = 0x0001; (* Backward compatibility with NXM *) + OFPXMC_OPENFLOW_BASIC = 0x8000; (* Basic class for OpenFlow *) + OFPXMC_EXPERIMENTER = 0xFFFF (* Experimenter class *) + } as uint16_t + + cenum oxm_ofb_match_fields { + OFPXMT_OFB_IN_PORT = 0; (* Switch input port. *) + OFPXMT_OFB_IN_PHY_PORT = 1; (* Switch physical input port. *) + OFPXMT_OFB_METADATA = 2; (* Metadata passed between tables. *) + OFPXMT_OFB_ETH_DST = 3; (* Ethernet destination address. *) + OFPXMT_OFB_ETH_SRC = 4; (* Ethernet source address. *) + OFPXMT_OFB_ETH_TYPE = 5; (* Ethernet frame type. *) + OFPXMT_OFB_VLAN_VID = 6; (* VLAN id. *) + OFPXMT_OFB_VLAN_PCP = 7; (* VLAN priority. *) + OFPXMT_OFB_IP_DSCP = 8; (* IP DSCP (6 bits in ToS field). *) + OFPXMT_OFB_IP_ECN = 9; (* IP ECN (2 bits in ToS field). *) + OFPXMT_OFB_IP_PROTO = 10; (* IP protocol. *) + OFPXMT_OFB_IPV4_SRC = 11; (* IPv4 source address. *) + OFPXMT_OFB_IPV4_DST = 12; (* IPv4 destination address. *) + OFPXMT_OFB_TCP_SRC = 13; (* TCP source port. *) + OFPXMT_OFB_TCP_DST = 14; (* TCP destination port. *) + OFPXMT_OFB_UDP_SRC = 15; (* UDP source port. *) + OFPXMT_OFB_UDP_DST = 16; (* UDP destination port. *) + OFPXMT_OFB_SCTP_SRC = 17; (* SCTP source port. *) + OFPXMT_OFB_SCTP_DST = 18; (* SCTP destination port. *) + OFPXMT_OFB_ICMPV4_TYPE = 19; (* ICMP type. *) + OFPXMT_OFB_ICMPV4_CODE = 20; (* ICMP code. *) + OFPXMT_OFB_ARP_OP = 21; (* ARP opcode. *) + OFPXMT_OFB_ARP_SPA = 22; (* ARP source IPv4 address. *) + OFPXMT_OFB_ARP_TPA = 23; (* ARP target IPv4 address. *) + OFPXMT_OFB_ARP_SHA = 24; (* ARP source hardware address. *) + OFPXMT_OFB_ARP_THA = 25; (* ARP target hardware address. *) + OFPXMT_OFB_IPV6_SRC = 26; (* IPv6 source address. *) + OFPXMT_OFB_IPV6_DST = 27; (* IPv6 destination address. *) + OFPXMT_OFB_IPV6_FLABEL = 28; (* IPv6 Flow Label *) + OFPXMT_OFB_ICMPV6_TYPE = 29; (* ICMPv6 type. *) + OFPXMT_OFB_ICMPV6_CODE = 30; (* ICMPv6 code. *) + OFPXMT_OFB_IPV6_ND_TARGET = 31; (* Target address for ND. *) + OFPXMT_OFB_IPV6_ND_SLL = 32; (* Source link-layer for ND. *) + OFPXMT_OFB_IPV6_ND_TLL = 33; (* Target link-layer for ND. *) + OFPXMT_OFB_MPLS_LABEL = 34; (* MPLS label. *) + OFPXMT_OFB_MPLS_TC = 35; (* MPLS TC. *) + OFPXMT_OFP_MPLS_BOS = 36; (* MPLS BoS bit. *) + OFPXMT_OFB_PBB_ISID = 37; (* PBB I-SID. *) + OFPXMT_OFB_TUNNEL_ID = 38; (* Logical Port Metadata. *) + OFPXMT_OFB_IPV6_EXTHDR = 39; (* IPv6 Extension Header pseudo-field *) + OFPXMT_OFB_PBB_UCA = 41 (* PBB UCA header field *) + } as uint8_t + + module IPv6ExtHdr = struct + + type t = oxmIPv6ExtHdr + + let marshal (hdr : t) : int16 = + (if hdr.noext then 1 lsl 0 else 0) lor + (if hdr.esp then 1 lsl 1 else 0) lor + (if hdr.auth then 1 lsl 2 else 0) lor + (if hdr.dest then 1 lsl 3 else 0) lor + (if hdr.frac then 1 lsl 4 else 0) lor + (if hdr.router then 1 lsl 5 else 0) lor + (if hdr.hop then 1 lsl 6 else 0) lor + (if hdr.unrep then 1 lsl 7 else 0) lor + (if hdr.unseq then 1 lsl 8 else 0) + + let parse bits : t = + { noext = test_bit16 0 bits + ; esp = test_bit16 1 bits + ; auth = test_bit16 2 bits + ; dest = test_bit16 3 bits + ; frac = test_bit16 4 bits + ; router = test_bit16 5 bits + ; hop = test_bit16 6 bits + ; unrep = test_bit16 7 bits + ; unseq = test_bit16 8 bits} + + let to_string (t : t) : string = + Format.sprintf "{ noext = %B; esp = %B; auth = %B; dest = %B; frac = %B; router = %B; \ + hop = %B; unrep = %B; unseq = %B }" + t.noext + t.esp + t.auth + t.dest + t.frac + t.router + t.hop + t.unrep + t.unseq + end + + type t = oxm + + let field_length (oxm : oxm) : int = match oxm with + | OxmInPort _ -> 4 + | OxmInPhyPort _ -> 4 + | OxmEthType _ -> 2 + | OxmEthDst ethaddr -> + (match ethaddr.m_mask with + | None -> 6 + | Some _ -> 12) + | OxmEthSrc ethaddr -> + (match ethaddr.m_mask with + | None -> 6 + | Some _ -> 12) + | OxmVlanVId vid -> + (match vid.m_mask with + | None -> 2 + | Some _ -> 4) + | OxmVlanPcp _ -> 1 + | OxmIP4Src ipaddr -> + (match ipaddr.m_mask with + | None -> 4 + | Some _ -> 8) + | OxmIP4Dst ipaddr -> + (match ipaddr.m_mask with + | None -> 4 + | Some _ -> 8) + | OxmTCPSrc _ -> 2 + | OxmTCPDst _ -> 2 + | OxmARPOp _ -> 2 + | OxmARPSpa t-> + (match t.m_mask with + | None -> 4 + | Some _ -> 8) + | OxmARPTpa t-> + (match t.m_mask with + | None -> 4 + | Some _ -> 8) + | OxmARPSha t-> + (match t.m_mask with + | None -> 6 + | Some _ -> 12) + | OxmARPTha t-> + (match t.m_mask with + | None -> 6 + | Some _ -> 12) + | OxmMPLSLabel _ -> 4 + | OxmMPLSTc _ -> 1 + | OxmMetadata t -> + (match t.m_mask with + | None -> 8 + | Some _ -> 16) + | OxmIPProto _ -> 1 + | OxmIPDscp _ -> 1 + | OxmIPEcn _ -> 1 + | OxmICMPType _ -> 1 + | OxmICMPCode _ -> 1 + | OxmTunnelId t -> + (match t.m_mask with + | None -> 8 + | Some _ -> 16) + | OxmUDPSrc _ -> 2 + | OxmUDPDst _ -> 2 + | OxmSCTPSrc _ -> 2 + | OxmSCTPDst _ -> 2 + | OxmIPv6Src t -> + (match t.m_mask with + | None -> 16 + | Some _ -> 32) + | OxmIPv6Dst t -> + (match t.m_mask with + | None -> 16 + | Some _ -> 32) + | OxmIPv6FLabel t -> + (match t.m_mask with + | None -> 4 + | Some _ -> 8) + | OxmICMPv6Type _ -> 1 + | OxmICMPv6Code _ -> 1 + | OxmIPv6NDTarget t -> + (match t.m_mask with + | None -> 16 + | Some _ -> 32) + | OxmIPv6NDSll _ -> 6 + | OxmIPv6NDTll _ -> 6 + | OxmMPLSBos _ -> 1 + | OxmPBBIsid t -> + (match t.m_mask with + | None -> 3 + | Some _ -> 6) + | OxmIPv6ExtHdr t -> + (match t.m_mask with + | None -> 2 + | Some _ -> 4) + | OxmPBBUCA _ -> 1 + + let field_name (oxm : oxm) : string = match oxm with + | OxmInPort _ -> "InPort" + | OxmInPhyPort _ -> "InPhyPort" + | OxmEthType _ -> "EthType" + | OxmEthDst ethaddr -> + (match ethaddr.m_mask with + | None -> "EthDst" + | Some _ -> "EthDst/mask") + | OxmEthSrc ethaddr -> + (match ethaddr.m_mask with + | None -> "EthSrc" + | Some _ -> "EthSrc/mask") + | OxmVlanVId vid -> + (match vid.m_mask with + | None -> "VlanVId" + | Some _ -> "VlanVId/mask") + | OxmVlanPcp _ -> "VlanPcp" + | OxmIP4Src ipaddr -> + (match ipaddr.m_mask with + | None -> "IPSrc" + | Some _ -> "IPSrc/mask") + | OxmIP4Dst ipaddr -> + (match ipaddr.m_mask with + | None -> "IPDst" + | Some _ -> "IPDst/mask") + | OxmTCPSrc _ -> "TCPSrc" + | OxmTCPDst _ -> "TCPDst" + | OxmARPOp _ -> "ARPOp" + | OxmARPSpa t-> + (match t.m_mask with + | None -> "ARPSpa" + | Some _ -> "ARPSpa/mask") + | OxmARPTpa t-> + (match t.m_mask with + | None -> "ARPTpa" + | Some _ -> "ARPTpa/mask") + | OxmARPSha t-> + (match t.m_mask with + | None -> "ARPSha" + | Some _ -> "ARPSha/mask") + | OxmARPTha t-> + (match t.m_mask with + | None -> "ARPTha" + | Some _ -> "ARPTha/mask") + | OxmMPLSLabel _ -> "MPLSLabel" + | OxmMPLSTc _ -> "MplsTc" + | OxmMetadata t -> + (match t.m_mask with + | None -> "Metadata" + | Some _ -> "Metadata/mask") + | OxmIPProto _ -> "IPProto" + | OxmIPDscp _ -> "IPDscp" + | OxmIPEcn _ -> "IPEcn" + | OxmICMPType _ -> "ICMP Type" + | OxmICMPCode _ -> "ICMP Code" + | OxmTunnelId t -> + (match t.m_mask with + | None -> "Tunnel ID" + | Some _ -> "Tunnel ID/mask") + | OxmUDPSrc _ -> "UDPSrc" + | OxmUDPDst _ -> "UDPDst" + | OxmSCTPSrc _ -> "SCTPSrc" + | OxmSCTPDst _ -> "SCTPDst" + | OxmIPv6Src t -> + (match t.m_mask with + | None -> "IPv6Src" + | Some _ -> "IPv6Src/mask") + | OxmIPv6Dst t -> + (match t.m_mask with + | None -> "IPv6Dst" + | Some _ -> "IPv6Dst/mask") + | OxmIPv6FLabel t -> + (match t.m_mask with + | None -> "IPv6FlowLabel" + | Some _ -> "IPv6FlowLabel/mask") + | OxmICMPv6Type _ -> "ICMPv6Type" + | OxmICMPv6Code _ -> "IPCMPv6Code" + | OxmIPv6NDTarget t -> + (match t.m_mask with + | None -> "IPv6NeighborDiscoveryTarget" + | Some _ -> "IPv6NeighborDiscoveryTarget/mask") + | OxmIPv6NDSll _ -> "IPv6NeighborDiscoverySourceLink" + | OxmIPv6NDTll _ -> "IPv6NeighborDiscoveryTargetLink" + | OxmMPLSBos _ -> "MPLSBoS" + | OxmPBBIsid t -> + (match t.m_mask with + | None -> "PBBIsid" + | Some _ -> "PBBIsid/mask") + | OxmIPv6ExtHdr t -> + (match t.m_mask with + | None -> "IPv6ExtHdr" + | Some _ -> "IPv6ExtHdr/mask") + | OxmPBBUCA _ -> "PBBUCA" + + let sizeof (oxm : oxm) : int = + sizeof_ofp_oxm + field_length oxm + + let sizeof_headers (oxml : oxm list) : int = + (List.length oxml) * sizeof_ofp_oxm (* OXM Header, without payload*) + + let to_string oxm = + match oxm with + | OxmInPort p -> Format.sprintf "InPort = %lu " p + | OxmInPhyPort p -> Format.sprintf "InPhyPort = %lu " p + | OxmEthType e -> Format.sprintf "EthType = %X " e + | OxmEthDst ethaddr -> + (match ethaddr.m_mask with + | None -> Format.sprintf "EthDst = %s" (string_of_mac ethaddr.m_value) + | Some m -> Format.sprintf "EthDst = %s/%s" (string_of_mac ethaddr.m_value) (string_of_mac m)) + | OxmEthSrc ethaddr -> + (match ethaddr.m_mask with + | None -> Format.sprintf "EthSrc = %s" (string_of_mac ethaddr.m_value) + | Some m -> Format.sprintf "EthSrc = %s/%s" (string_of_mac ethaddr.m_value) (string_of_mac m)) + | OxmVlanVId vid -> + (match vid.m_mask with + | None -> Format.sprintf "VlanVId = %u" vid.m_value + | Some m -> Format.sprintf "VlanVId = %u/%u" vid.m_value m) + | OxmVlanPcp vid -> Format.sprintf "VlanPcp = %u" vid + | OxmIP4Src ipaddr -> + (match ipaddr.m_mask with + | None -> Format.sprintf "IPSrc = %s" (string_of_ip ipaddr.m_value) + | Some m -> Format.sprintf "IPSrc = %s/%s" (string_of_ip ipaddr.m_value) (string_of_ip m)) + | OxmIP4Dst ipaddr -> + (match ipaddr.m_mask with + | None -> Format.sprintf "IPDst = %s" (string_of_ip ipaddr.m_value) + | Some m -> Format.sprintf "IPDst = %s/%s" (string_of_ip ipaddr.m_value) (string_of_ip m)) + | OxmTCPSrc v -> Format.sprintf "TCPSrc = %u" v + | OxmTCPDst v -> Format.sprintf "TCPDst = %u" v + | OxmMPLSLabel v -> Format.sprintf "MPLSLabel = %lu" v + | OxmMPLSTc v -> Format.sprintf "MplsTc = %u" v + | OxmMetadata v -> + (match v.m_mask with + | None -> Format.sprintf "Metadata = %Lu" v.m_value + | Some m -> Format.sprintf "Metadata = %Lu/%Lu" v.m_value m) + | OxmIPProto v -> Format.sprintf "IPProto = %u" v + | OxmIPDscp v -> Format.sprintf "IPDscp = %u" v + | OxmIPEcn v -> Format.sprintf "IPEcn = %u" v + | OxmARPOp v -> Format.sprintf "ARPOp = %u" v + | OxmARPSpa v -> + (match v.m_mask with + | None -> Format.sprintf "ARPSpa = %lu" v.m_value + | Some m -> Format.sprintf "ARPSpa = %lu/%lu" v.m_value m) + | OxmARPTpa v -> + (match v.m_mask with + | None -> Format.sprintf "ARPTpa = %lu" v.m_value + | Some m -> Format.sprintf "ARPTpa = %lu/%lu" v.m_value m) + | OxmARPSha v -> + (match v.m_mask with + | None -> Format.sprintf "ARPSha = %Lu" v.m_value + | Some m -> Format.sprintf "ARPSha = %Lu/%Lu" v.m_value m) + | OxmARPTha v -> + (match v.m_mask with + | None -> Format.sprintf "ARPTha = %Lu" v.m_value + | Some m -> Format.sprintf "ARPTha = %Lu/%Lu" v.m_value m) + | OxmICMPType v -> Format.sprintf "ICMPType = %u" v + | OxmICMPCode v -> Format.sprintf "ICMPCode = %u" v + | OxmTunnelId v -> + (match v.m_mask with + | None -> Format.sprintf "TunnelID = %Lu" v.m_value + | Some m -> Format.sprintf "TunnelID = %Lu/%Lu" v.m_value m) + | OxmUDPSrc v -> Format.sprintf "UDPSrc = %u" v + | OxmUDPDst v -> Format.sprintf "UDPDst = %u" v + | OxmSCTPSrc v -> Format.sprintf "SCTPSrc = %u" v + | OxmSCTPDst v -> Format.sprintf "SCTPDst = %u" v + | OxmIPv6Src t -> + (match t.m_mask with + | None -> Format.sprintf "IPv6Src = %s" (string_of_ipv6 t.m_value) + | Some m -> Format.sprintf "IPv6Src = %s/%s" (string_of_ipv6 t.m_value) (string_of_ipv6 m)) + | OxmIPv6Dst t -> + (match t.m_mask with + | None -> Format.sprintf "IPv6Dst = %s" (string_of_ipv6 t.m_value) + | Some m -> Format.sprintf "IPv6Dst = %s/%s" (string_of_ipv6 t.m_value) (string_of_ipv6 m)) + | OxmIPv6FLabel t -> + (match t.m_mask with + | None -> Format.sprintf "IPv6FlowLabel = %lu" t.m_value + | Some m -> Format.sprintf "IPv6FlowLabel = %lu/%lu" t.m_value m) + | OxmICMPv6Type v -> Format.sprintf "ICMPv6Type = %u" v + | OxmICMPv6Code v -> Format.sprintf "IPCMPv6Code = %u" v + | OxmIPv6NDTarget t -> + (match t.m_mask with + | None -> Format.sprintf "IPv6NeighborDiscoveryTarget = %s" (string_of_ipv6 t.m_value) + | Some m -> Format.sprintf "IPv6NeighborDiscoveryTarget = %s/%s" (string_of_ipv6 t.m_value) (string_of_ipv6 m)) + | OxmIPv6NDSll v -> Format.sprintf "IPv6NeighborDiscoverySourceLink = %Lu" v + | OxmIPv6NDTll v -> Format.sprintf "IPv6NeighborDiscoveryTargetLink = %Lu" v + | OxmMPLSBos v -> Format.sprintf "MPLSBoS = %B" v + | OxmPBBIsid t -> + (match t.m_mask with + | None -> Format.sprintf "PBBIsid = %lu" t.m_value + | Some m -> Format.sprintf "PBBIsid = %lu/%lu" t.m_value m) + | OxmIPv6ExtHdr t -> + (match t.m_mask with + | None -> Format.sprintf "IPv6ExtHdr = %s" (IPv6ExtHdr.to_string t.m_value) + | Some m -> Format.sprintf "IPv6ExtHdr = %s/%s" (IPv6ExtHdr.to_string t.m_value) (IPv6ExtHdr.to_string m)) + | OxmPBBUCA v -> Format.sprintf "PBBUCA = %B" v + + let set_ofp_oxm (buf : Cstruct.t) (c : ofp_oxm_class) (f : oxm_ofb_match_fields) (hm : int) (l : int) = + let value = (0x7f land (oxm_ofb_match_fields_to_int f)) lsl 1 in + let value = value lor (0x1 land hm) in + set_ofp_oxm_oxm_class buf (ofp_oxm_class_to_int c); + set_ofp_oxm_oxm_field_and_hashmask buf value; + set_ofp_oxm_oxm_length buf l + + + let marshal (buf : Cstruct.t) (oxm : oxm) : int = + let l = field_length oxm in + let ofc = OFPXMC_OPENFLOW_BASIC in + let buf2 = Cstruct.shift buf sizeof_ofp_oxm in + match oxm with + | OxmInPort pid -> + set_ofp_oxm buf ofc OFPXMT_OFB_IN_PORT 0 l; + set_ofp_uint32_value buf2 pid; + sizeof_ofp_oxm + l + | OxmInPhyPort pid -> + set_ofp_oxm buf ofc OFPXMT_OFB_IN_PHY_PORT 0 l; + set_ofp_uint32_value buf2 pid; + sizeof_ofp_oxm + l + | OxmEthType ethtype -> + set_ofp_oxm buf ofc OFPXMT_OFB_ETH_TYPE 0 l; + set_ofp_uint16_value buf2 ethtype; + sizeof_ofp_oxm + l + | OxmEthDst ethaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_ETH_DST (match ethaddr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint48_value buf2 ethaddr.m_value; + begin match ethaddr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint48_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmEthSrc ethaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_ETH_SRC (match ethaddr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint48_value buf2 ethaddr.m_value; + begin match ethaddr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint48_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIP4Src ipaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV4_SRC (match ipaddr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint32_value buf2 ipaddr.m_value; + begin match ipaddr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint32_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIP4Dst ipaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV4_DST (match ipaddr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint32_value buf2 ipaddr.m_value; + begin match ipaddr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint32_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmVlanVId vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_VLAN_VID (match vid.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint16_value buf2 vid.m_value; + begin match vid.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint16_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmVlanPcp vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_VLAN_PCP 0 l; + set_ofp_uint8_value buf2 vid; + sizeof_ofp_oxm + l + | OxmMPLSLabel vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_MPLS_LABEL 0 l; + set_ofp_uint32_value buf2 vid; + sizeof_ofp_oxm + l + | OxmMPLSTc vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_MPLS_TC 0 l; + set_ofp_uint8_value buf2 vid; + sizeof_ofp_oxm + l + | OxmMetadata meta -> + set_ofp_oxm buf ofc OFPXMT_OFB_METADATA (match meta.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint64_value buf2 meta.m_value; + begin match meta.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint64_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIPProto ipproto -> + set_ofp_oxm buf ofc OFPXMT_OFB_IP_PROTO 0 l; + set_ofp_uint8_value buf2 ipproto; + sizeof_ofp_oxm + l + | OxmIPDscp ipdscp -> + set_ofp_oxm buf ofc OFPXMT_OFB_IP_DSCP 0 l; + set_ofp_uint8_value buf2 ipdscp; + sizeof_ofp_oxm + l + | OxmIPEcn ipecn -> + set_ofp_oxm buf ofc OFPXMT_OFB_IP_ECN 0 l; + set_ofp_uint8_value buf2 ipecn; + sizeof_ofp_oxm + l + | OxmTCPSrc port -> + set_ofp_oxm buf ofc OFPXMT_OFB_TCP_SRC 0 l; + set_ofp_uint16_value buf2 port; + sizeof_ofp_oxm + l + | OxmTCPDst port -> + set_ofp_oxm buf ofc OFPXMT_OFB_TCP_DST 0 l; + set_ofp_uint16_value buf2 port; + sizeof_ofp_oxm + l + | OxmARPOp arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_OP 0 l; + set_ofp_uint16_value buf2 arp; + sizeof_ofp_oxm + l + | OxmARPSpa arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_SPA (match arp.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint32_value buf2 arp.m_value; + begin match arp.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint32_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmARPTpa arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_TPA (match arp.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint32_value buf2 arp.m_value; + begin match arp.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint32_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmARPSha arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_SHA (match arp.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint48_value buf2 arp.m_value; + begin match arp.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint48_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmARPTha arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_THA (match arp.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint48_value buf2 arp.m_value; + begin match arp.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint48_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmICMPType t -> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV4_TYPE 0 l; + set_ofp_uint8_value buf2 t; + sizeof_ofp_oxm + l + | OxmICMPCode c-> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV4_CODE 0 l; + set_ofp_uint8_value buf2 c; + sizeof_ofp_oxm + l + | OxmTunnelId tun -> + set_ofp_oxm buf ofc OFPXMT_OFB_TUNNEL_ID (match tun.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint64_value buf2 tun.m_value; + begin match tun.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint64_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmUDPSrc port -> + set_ofp_oxm buf ofc OFPXMT_OFB_UDP_SRC 0 l; + set_ofp_uint16_value buf2 port; + sizeof_ofp_oxm + l + | OxmUDPDst port -> + set_ofp_oxm buf ofc OFPXMT_OFB_UDP_DST 0 l; + set_ofp_uint16_value buf2 port; + sizeof_ofp_oxm + l + | OxmSCTPSrc port -> + set_ofp_oxm buf ofc OFPXMT_OFB_SCTP_SRC 0 l; + set_ofp_uint16_value buf2 port; + sizeof_ofp_oxm + l + | OxmSCTPDst port -> + set_ofp_oxm buf ofc OFPXMT_OFB_SCTP_DST 0 l; + set_ofp_uint16_value buf2 port; + sizeof_ofp_oxm + l + | OxmIPv6Src addr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_SRC (match addr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint128_value buf2 addr.m_value; + begin match addr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint128_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIPv6Dst addr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_DST (match addr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint128_value buf2 addr.m_value; + begin match addr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint128_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIPv6FLabel label -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_FLABEL (match label.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint32_value buf2 label.m_value; + begin match label.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint32_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmICMPv6Type typ -> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV6_TYPE 0 l; + set_ofp_uint8_value buf2 typ; + sizeof_ofp_oxm + l + | OxmICMPv6Code cod -> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV6_CODE 0 l; + set_ofp_uint8_value buf2 cod; + sizeof_ofp_oxm + l + | OxmIPv6NDTarget addr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_ND_TARGET (match addr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint128_value buf2 addr.m_value; + begin match addr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint128_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIPv6NDSll sll -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_ND_SLL 0 l; + set_ofp_uint48_value buf2 sll; + sizeof_ofp_oxm + l + | OxmIPv6NDTll tll -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_ND_TLL 0 l; + set_ofp_uint48_value buf2 tll; + sizeof_ofp_oxm + l + | OxmMPLSBos boS -> + set_ofp_oxm buf ofc OFPXMT_OFP_MPLS_BOS 0 l; + (match boS with + | true -> set_ofp_uint8_value buf2 1 + | false -> set_ofp_uint8_value buf2 0); + sizeof_ofp_oxm + l + | OxmPBBIsid sid -> + set_ofp_oxm buf ofc OFPXMT_OFB_PBB_ISID (match sid.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint24_value buf2 sid.m_value; + begin match sid.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint24_value buf3 mask; + sizeof_ofp_oxm + l + end + | OxmIPv6ExtHdr hdr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_EXTHDR (match hdr.m_mask with None -> 0 | _ -> 1) l; + set_ofp_uint16_value buf2 (IPv6ExtHdr.marshal hdr.m_value); + begin match hdr.m_mask with + | None -> + sizeof_ofp_oxm + l + | Some mask -> + let buf3 = Cstruct.shift buf2 (l/2) in + set_ofp_uint16_value buf3 (IPv6ExtHdr.marshal mask); + sizeof_ofp_oxm + l + end + | OxmPBBUCA uca -> + set_ofp_oxm buf ofc OFPXMT_OFB_PBB_UCA 0 l; + (match uca with + | true -> set_ofp_uint8_value buf2 1 + | false -> set_ofp_uint8_value buf2 0); + sizeof_ofp_oxm + l + + let marshal_header (buf : Cstruct.t) (oxm : oxm) : int = + (* Same as marshal, but without the payload *) + let l = field_length oxm in + let ofc = OFPXMC_OPENFLOW_BASIC in + match oxm with + | OxmInPort _ -> + set_ofp_oxm buf ofc OFPXMT_OFB_IN_PORT 0 l; + sizeof_ofp_oxm + | OxmInPhyPort _ -> + set_ofp_oxm buf ofc OFPXMT_OFB_IN_PHY_PORT 0 l; + sizeof_ofp_oxm + | OxmEthType _ -> + set_ofp_oxm buf ofc OFPXMT_OFB_ETH_TYPE 0 l; + sizeof_ofp_oxm + | OxmEthDst ethaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_ETH_DST (match ethaddr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmEthSrc ethaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_ETH_SRC (match ethaddr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIP4Src ipaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV4_SRC (match ipaddr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIP4Dst ipaddr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV4_DST (match ipaddr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmVlanVId vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_VLAN_VID (match vid.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmVlanPcp vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_VLAN_PCP 0 l; + sizeof_ofp_oxm + | OxmMPLSLabel vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_MPLS_LABEL 0 l; + sizeof_ofp_oxm + | OxmMPLSTc vid -> + set_ofp_oxm buf ofc OFPXMT_OFB_MPLS_TC 0 l; + sizeof_ofp_oxm + | OxmMetadata meta -> + set_ofp_oxm buf ofc OFPXMT_OFB_METADATA (match meta.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIPProto ipproto -> + set_ofp_oxm buf ofc OFPXMT_OFB_IP_PROTO 0 l; + sizeof_ofp_oxm + | OxmIPDscp ipdscp -> + set_ofp_oxm buf ofc OFPXMT_OFB_IP_DSCP 0 l; + sizeof_ofp_oxm + | OxmIPEcn ipecn -> + set_ofp_oxm buf ofc OFPXMT_OFB_IP_ECN 0 l; + sizeof_ofp_oxm + | OxmTCPSrc port -> + set_ofp_oxm buf ofc OFPXMT_OFB_TCP_SRC 0 l; + sizeof_ofp_oxm + | OxmTCPDst port -> + set_ofp_oxm buf ofc OFPXMT_OFB_TCP_DST 0 l; + sizeof_ofp_oxm + | OxmARPOp arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_OP 0 l; + sizeof_ofp_oxm + | OxmARPSpa arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_SPA (match arp.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmARPTpa arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_TPA (match arp.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmARPSha arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_SHA (match arp.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmARPTha arp -> + set_ofp_oxm buf ofc OFPXMT_OFB_ARP_THA (match arp.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmICMPType t -> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV4_TYPE 0 l; + sizeof_ofp_oxm + | OxmICMPCode c-> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV4_CODE 0 l; + sizeof_ofp_oxm + | OxmTunnelId tun -> + set_ofp_oxm buf ofc OFPXMT_OFB_TUNNEL_ID (match tun.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmUDPSrc port -> + set_ofp_oxm buf ofc OFPXMT_OFB_UDP_SRC 0 l; + sizeof_ofp_oxm + | OxmUDPDst port -> + set_ofp_oxm buf ofc OFPXMT_OFB_UDP_DST 0 l; + sizeof_ofp_oxm + | OxmSCTPSrc port -> + set_ofp_oxm buf ofc OFPXMT_OFB_SCTP_SRC 0 l; + sizeof_ofp_oxm + | OxmSCTPDst port -> + set_ofp_oxm buf ofc OFPXMT_OFB_SCTP_DST 0 l; + sizeof_ofp_oxm + | OxmIPv6Src addr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_SRC (match addr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIPv6Dst addr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_DST (match addr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIPv6FLabel label -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_FLABEL (match label.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmICMPv6Type typ -> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV6_TYPE 0 l; + sizeof_ofp_oxm + | OxmICMPv6Code cod -> + set_ofp_oxm buf ofc OFPXMT_OFB_ICMPV6_CODE 0 l; + sizeof_ofp_oxm + | OxmIPv6NDTarget addr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_ND_TARGET (match addr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIPv6NDSll sll -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_ND_SLL 0 l; + sizeof_ofp_oxm + | OxmIPv6NDTll tll -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_ND_TLL 0 l; + sizeof_ofp_oxm + | OxmMPLSBos boS -> + set_ofp_oxm buf ofc OFPXMT_OFP_MPLS_BOS 0 l; + sizeof_ofp_oxm + | OxmPBBIsid sid -> + set_ofp_oxm buf ofc OFPXMT_OFB_PBB_ISID (match sid.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmIPv6ExtHdr hdr -> + set_ofp_oxm buf ofc OFPXMT_OFB_IPV6_EXTHDR (match hdr.m_mask with None -> 0 | _ -> 1) l; + sizeof_ofp_oxm + | OxmPBBUCA _ -> + set_ofp_oxm buf ofc OFPXMT_OFB_PBB_UCA 0 l; + sizeof_ofp_oxm + + + + let parse (bits : Cstruct.t) : oxm * Cstruct.t = + (* printf "class= %d\n" (get_ofp_oxm_oxm_class bits); *) + (* let c = match int_to_ofp_oxm_class (get_ofp_oxm_oxm_class bits) with *) + (* | Some n -> n *) + (* | None -> *) + (* raise (Unparsable (sprintf "malformed class in oxm")) in *) + (* TODO: assert c is OFPXMC_OPENFLOW_BASIC *) + let value = get_ofp_oxm_oxm_field_and_hashmask bits in + let f = match int_to_oxm_ofb_match_fields (value lsr 1) with + | Some n -> n + | None -> + raise (Unparsable (sprintf "malformed field in oxm %d" (value lsr 1))) in + let hm = value land 0x1 in + let oxm_length = get_ofp_oxm_oxm_length bits in + let bits = Cstruct.shift bits sizeof_ofp_oxm in + let bits2 = Cstruct.shift bits oxm_length in + match f with + | OFPXMT_OFB_IN_PORT -> + let pid = get_ofp_uint32_value bits in + (OxmInPort pid, bits2) + | OFPXMT_OFB_IN_PHY_PORT -> + let pid = get_ofp_uint32_value bits in + (OxmInPhyPort pid, bits2) + | OFPXMT_OFB_METADATA -> + let value = get_ofp_uint64_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 8 in + let mask = get_ofp_uint64_value bits in + (OxmMetadata {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmMetadata {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_TUNNEL_ID -> + let value = get_ofp_uint64_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 8 in + let mask = get_ofp_uint64_value bits in + (OxmTunnelId {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmTunnelId {m_value = value; m_mask = None}, bits2) + (* Ethernet destination address. *) + | OFPXMT_OFB_ETH_DST -> + let value = get_ofp_uint48_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 6 in + let mask = get_ofp_uint48_value bits in + (OxmEthDst {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmEthDst {m_value = value; m_mask = None}, bits2) + (* Ethernet source address. *) + | OFPXMT_OFB_ETH_SRC -> + let value = get_ofp_uint48_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 6 in + let mask = get_ofp_uint48_value bits in + (OxmEthSrc {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmEthSrc {m_value = value; m_mask = None}, bits2) + (* Ethernet frame type. *) + | OFPXMT_OFB_ETH_TYPE -> + let value = get_ofp_uint16_value bits in + (OxmEthType value, bits2) + (* IP protocol. *) + | OFPXMT_OFB_IP_PROTO -> + let value = get_ofp_uint8_value bits in + (OxmIPProto value, bits2) + (* IP DSCP (6 bits in ToS field). *) + | OFPXMT_OFB_IP_DSCP -> + let value = get_ofp_uint8_value bits in + (OxmIPDscp (value land 63), bits2) + (* IP ECN (2 bits in ToS field). *) + | OFPXMT_OFB_IP_ECN -> + let value = get_ofp_uint8_value bits in + (OxmIPEcn (value land 3), bits2) + (* IPv4 source address. *) + | OFPXMT_OFB_IPV4_SRC -> + let value = get_ofp_uint32_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 4 in + let mask = get_ofp_uint32_value bits in + (OxmIP4Src {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIP4Src {m_value = value; m_mask = None}, bits2) + (* IPv4 destination address. *) + | OFPXMT_OFB_IPV4_DST -> + let value = get_ofp_uint32_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 4 in + let mask = get_ofp_uint32_value bits in + (OxmIP4Dst {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIP4Dst {m_value = value; m_mask = None}, bits2) + (* ARP opcode. *) + | OFPXMT_OFB_ARP_OP -> + let value = get_ofp_uint16_value bits in + (OxmARPOp value, bits2) + (* ARP source IPv4 address. *) + | OFPXMT_OFB_ARP_SPA -> + let value = get_ofp_uint32_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 4 in + let mask = get_ofp_uint32_value bits in + (OxmARPSpa {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmARPSpa {m_value = value; m_mask = None}, bits2) + (* ARP target IPv4 address. *) + | OFPXMT_OFB_ARP_TPA -> + let value = get_ofp_uint32_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 4 in + let mask = get_ofp_uint32_value bits in + (OxmARPTpa {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmARPTpa {m_value = value; m_mask = None}, bits2) + (* ARP source hardware address. *) + | OFPXMT_OFB_ARP_SHA -> + let value = get_ofp_uint48_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 6 in + let mask = get_ofp_uint48_value bits in + (OxmARPSha {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmARPSha {m_value = value; m_mask = None}, bits2) + (* ARP target hardware address. *) + | OFPXMT_OFB_ARP_THA -> + let value = get_ofp_uint48_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 6 in + let mask = get_ofp_uint48_value bits in + (OxmARPTha {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmARPTha {m_value = value; m_mask = None}, bits2) + (* ICMP Type *) + | OFPXMT_OFB_ICMPV4_TYPE -> + let value = get_ofp_uint8_value bits in + (OxmICMPType value, bits2) + (* ICMP code. *) + | OFPXMT_OFB_ICMPV4_CODE -> + let value = get_ofp_uint8_value bits in + (OxmICMPCode value, bits2) + | OFPXMT_OFB_TCP_DST -> + let value = get_ofp_uint16_value bits in + (OxmTCPDst value, bits2) + | OFPXMT_OFB_TCP_SRC -> + let value = get_ofp_uint16_value bits in + (OxmTCPSrc value, bits2) + | OFPXMT_OFB_MPLS_LABEL -> + let value = get_ofp_uint32_value bits in + (OxmMPLSLabel value, bits2) + | OFPXMT_OFB_VLAN_PCP -> + let value = get_ofp_uint8_value bits in + (OxmVlanPcp value, bits2) + | OFPXMT_OFB_VLAN_VID -> + let value = get_ofp_uint16_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 2 in + let mask = get_ofp_uint16_value bits in + (OxmVlanVId {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmVlanVId {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_MPLS_TC -> + let value = get_ofp_uint8_value bits in + (OxmMPLSTc value, bits2) + | OFPXMT_OFB_UDP_SRC -> + let value = get_ofp_uint16_value bits in + (OxmUDPSrc value, bits2) + | OFPXMT_OFB_UDP_DST -> + let value = get_ofp_uint16_value bits in + (OxmUDPDst value, bits2) + | OFPXMT_OFB_SCTP_SRC -> + let value = get_ofp_uint16_value bits in + (OxmSCTPSrc value, bits2) + | OFPXMT_OFB_SCTP_DST -> + let value = get_ofp_uint16_value bits in + (OxmSCTPDst value, bits2) + | OFPXMT_OFB_IPV6_SRC -> + let value = get_ofp_uint128_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 16 in + let mask = get_ofp_uint128_value bits in + (OxmIPv6Src {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIPv6Src {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_DST -> + let value = get_ofp_uint128_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 16 in + let mask = get_ofp_uint128_value bits in + (OxmIPv6Dst {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIPv6Dst {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_FLABEL -> + let value = get_ofp_uint32_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 4 in + let mask = get_ofp_uint32_value bits in + (OxmIPv6FLabel {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIPv6FLabel {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_ICMPV6_TYPE -> + let value = get_ofp_uint8_value bits in + (OxmICMPv6Type value, bits2) + | OFPXMT_OFB_ICMPV6_CODE -> + let value = get_ofp_uint8_value bits in + (OxmICMPv6Code value, bits2) + | OFPXMT_OFB_IPV6_ND_TARGET -> + let value = get_ofp_uint128_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 16 in + let mask = get_ofp_uint128_value bits in + (OxmIPv6NDTarget {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIPv6NDTarget {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_ND_SLL -> + let value = get_ofp_uint48_value bits in + (OxmIPv6NDSll value, bits2) + | OFPXMT_OFB_IPV6_ND_TLL -> + let value = get_ofp_uint48_value bits in + (OxmIPv6NDTll value, bits2) + | OFPXMT_OFP_MPLS_BOS -> + let value = get_ofp_uint8_value bits in + (OxmMPLSBos ((value land 1) = 1), bits2) + | OFPXMT_OFB_PBB_ISID -> + let value = get_ofp_uint24_value bits in + if hm = 1 then + let bits = Cstruct.shift bits 3 in + let mask = get_ofp_uint24_value bits in + (OxmPBBIsid {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmPBBIsid {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_EXTHDR -> + let value = IPv6ExtHdr.parse (get_ofp_uint16_value bits) in + if hm = 1 then + let bits = Cstruct.shift bits 2 in + let mask = IPv6ExtHdr.parse (get_ofp_uint16_value bits) in + (OxmIPv6ExtHdr {m_value = value; m_mask = (Some mask)}, bits2) + else + (OxmIPv6ExtHdr {m_value = value; m_mask = None}, bits2) + | OFPXMT_OFB_PBB_UCA -> + let value = get_ofp_uint8_value bits in + (OxmPBBUCA ((value land 1) = 1), bits2) + + let parse_header (bits : Cstruct.t) : oxm * Cstruct.t = + (* parse Oxm header function for TableFeatureProp. Similar to parse, but without + parsing the payload *) + let value = get_ofp_oxm_oxm_field_and_hashmask bits in + let f = match int_to_oxm_ofb_match_fields (value lsr 1) with + | Some n -> n + | None -> raise (Unparsable (sprintf "malformed field in oxm %d" (value lsr 1))) in + let hm = value land 0x1 in + let bits2 = Cstruct.shift bits sizeof_ofp_oxm in + match f with + | OFPXMT_OFB_IN_PORT -> + (OxmInPort 0l, bits2) + | OFPXMT_OFB_IN_PHY_PORT -> + (OxmInPhyPort 0l, bits2) + | OFPXMT_OFB_METADATA -> + if hm = 1 then + (OxmMetadata {m_value = 0L; m_mask = (Some 0L)}, bits2) + else + (OxmMetadata {m_value = 0L; m_mask = None}, bits2) + | OFPXMT_OFB_TUNNEL_ID -> + if hm = 1 then + (OxmTunnelId {m_value = 0L; m_mask = (Some 0L)}, bits2) + else + (OxmTunnelId {m_value = 0L; m_mask = None}, bits2) + (* Ethernet destination address. *) + | OFPXMT_OFB_ETH_DST -> + if hm = 1 then + (OxmEthDst {m_value = 0L; m_mask = (Some 0L)}, bits2) + else + (OxmEthDst {m_value = 0L; m_mask = None}, bits2) + (* Ethernet source address. *) + | OFPXMT_OFB_ETH_SRC -> + if hm = 1 then + (OxmEthSrc {m_value = 0L; m_mask = (Some 0L)}, bits2) + else + (OxmEthSrc {m_value = 0L; m_mask = None}, bits2) + (* Ethernet frame type. *) + | OFPXMT_OFB_ETH_TYPE -> + (OxmEthType 0, bits2) + (* IP protocol. *) + | OFPXMT_OFB_IP_PROTO -> + (OxmIPProto 0, bits2) + (* IP DSCP (6 bits in ToS field). *) + | OFPXMT_OFB_IP_DSCP -> + (OxmIPDscp (0 land 63), bits2) + (* IP ECN (2 bits in ToS field). *) + | OFPXMT_OFB_IP_ECN -> + (OxmIPEcn (0 land 3), bits2) + (* IPv4 source address. *) + | OFPXMT_OFB_IPV4_SRC -> + if hm = 1 then + (OxmIP4Src {m_value = 0l; m_mask = (Some 0l)}, bits2) + else + (OxmIP4Src {m_value = 0l; m_mask = None}, bits2) + (* IPv4 destination address. *) + | OFPXMT_OFB_IPV4_DST -> + if hm = 1 then + (OxmIP4Dst {m_value = 0l; m_mask = (Some 0l)}, bits2) + else + (OxmIP4Dst {m_value = 0l; m_mask = None}, bits2) + (* ARP opcode. *) + | OFPXMT_OFB_ARP_OP -> + (OxmARPOp 0, bits2) + (* ARP source IPv4 address. *) + | OFPXMT_OFB_ARP_SPA -> + if hm = 1 then + (OxmARPSpa {m_value = 0l; m_mask = (Some 0l)}, bits2) + else + (OxmARPSpa {m_value = 0l; m_mask = None}, bits2) + (* ARP target IPv4 address. *) + | OFPXMT_OFB_ARP_TPA -> + if hm = 1 then + (OxmARPTpa {m_value = 0l; m_mask = (Some 0l)}, bits2) + else + (OxmARPTpa {m_value = 0l; m_mask = None}, bits2) + (* ARP source hardware address. *) + | OFPXMT_OFB_ARP_SHA -> + if hm = 1 then + (OxmARPSha {m_value = 0L; m_mask = (Some 0L)}, bits2) + else + (OxmARPSha {m_value = 0L; m_mask = None}, bits2) + (* ARP target hardware address. *) + | OFPXMT_OFB_ARP_THA -> + if hm = 1 then + (OxmARPTha {m_value = 0L; m_mask = (Some 0L)}, bits2) + else + (OxmARPTha {m_value = 0L; m_mask = None}, bits2) + (* ICMP Type *) + | OFPXMT_OFB_ICMPV4_TYPE -> + (OxmICMPType 0, bits2) + (* ICMP code. *) + | OFPXMT_OFB_ICMPV4_CODE -> + (OxmICMPCode 0, bits2) + | OFPXMT_OFB_TCP_DST -> + (OxmTCPDst 0, bits2) + | OFPXMT_OFB_TCP_SRC -> + (OxmTCPSrc 0, bits2) + | OFPXMT_OFB_MPLS_LABEL -> + (OxmMPLSLabel 0l, bits2) + | OFPXMT_OFB_VLAN_PCP -> + (OxmVlanPcp 0, bits2) + | OFPXMT_OFB_VLAN_VID -> + if hm = 1 then + (OxmVlanVId {m_value = 0; m_mask = (Some 0)}, bits2) + else + (OxmVlanVId {m_value = 0; m_mask = None}, bits2) + | OFPXMT_OFB_MPLS_TC -> + (OxmMPLSTc 0, bits2) + | OFPXMT_OFB_UDP_SRC -> + (OxmUDPSrc 0, bits2) + | OFPXMT_OFB_UDP_DST -> + (OxmUDPDst 0, bits2) + | OFPXMT_OFB_SCTP_SRC -> + (OxmSCTPSrc 0, bits2) + | OFPXMT_OFB_SCTP_DST -> + (OxmSCTPDst 0, bits2) + | OFPXMT_OFB_IPV6_SRC -> + if hm = 1 then + (OxmIPv6Src {m_value = (0L,0L); m_mask = (Some (0L,0L))}, bits2) + else + (OxmIPv6Src {m_value = (0L,0L); m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_DST -> + if hm = 1 then + (OxmIPv6Dst {m_value = (0L,0L); m_mask = (Some (0L,0L))}, bits2) + else + (OxmIPv6Dst {m_value = (0L,0L); m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_FLABEL -> + if hm = 1 then + (OxmIPv6FLabel {m_value = 0l; m_mask = (Some 0l)}, bits2) + else + (OxmIPv6FLabel {m_value = 0l; m_mask = None}, bits2) + | OFPXMT_OFB_ICMPV6_TYPE -> + (OxmICMPv6Type 0, bits2) + | OFPXMT_OFB_ICMPV6_CODE -> + (OxmICMPv6Code 0, bits2) + | OFPXMT_OFB_IPV6_ND_TARGET -> + if hm = 1 then + (OxmIPv6NDTarget {m_value = (0L,0L); m_mask = (Some (0L,0L))}, bits2) + else + (OxmIPv6NDTarget {m_value = (0L,0L); m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_ND_SLL -> + (OxmIPv6NDSll 0L, bits2) + | OFPXMT_OFB_IPV6_ND_TLL -> + (OxmIPv6NDTll 0L, bits2) + | OFPXMT_OFP_MPLS_BOS -> + (OxmMPLSBos false, bits2) + | OFPXMT_OFB_PBB_ISID -> + if hm = 1 then + (OxmPBBIsid {m_value = 0l; m_mask = (Some 0l)}, bits2) + else + (OxmPBBIsid {m_value = 0l; m_mask = None}, bits2) + | OFPXMT_OFB_IPV6_EXTHDR -> + let nul = {noext = false; esp = false; auth = false; dest = false; frac = false; router = false; hop = false; unrep = false; unseq = false } in + if hm = 1 then + (OxmIPv6ExtHdr {m_value = nul; m_mask = (Some nul)}, bits2) + else + (OxmIPv6ExtHdr {m_value = nul; m_mask = None}, bits2) + | OFPXMT_OFB_PBB_UCA -> + (OxmPBBUCA false, bits2) + + let rec parse_headers (bits : Cstruct.t) : oxmMatch*Cstruct.t = + if Cstruct.len bits < sizeof_ofp_oxm then ([], bits) + else let field, bits2 = parse_header bits in + let fields, bits3 = parse_headers bits2 in + (List.append [field] fields, bits3) + +end + +module OfpMatch = struct + + cstruct ofp_match { + uint16_t typ; + uint16_t length + } as big_endian + + type t = oxmMatch + + let sizeof (om : oxmMatch) : int = + let n = sizeof_ofp_match + sum (map Oxm.sizeof om) in + pad_to_64bits n + + let to_string om = + "[ " ^ (String.concat "; " (map Oxm.to_string om)) ^ " ]" + + let marshal (buf : Cstruct.t) (om : oxmMatch) : int = + let size = sizeof om in + set_ofp_match_typ buf 1; (* OXPMT_OXM *) + set_ofp_match_length buf (sizeof_ofp_match + sum (map Oxm.sizeof om)); (* Length of ofp_match (excluding padding) *) + let buf = Cstruct.shift buf sizeof_ofp_match in + let oxm_size = marshal_fields buf om Oxm.marshal in + let pad = size - (sizeof_ofp_match + oxm_size) in + if pad > 0 then + let buf = Cstruct.shift buf oxm_size in + let _ = pad_with_zeros buf pad in + size + else size + + let rec parse_fields (bits : Cstruct.t) : oxmMatch * Cstruct.t = + if Cstruct.len bits <= sizeof_ofp_oxm then ([], bits) + else let field, bits2 = Oxm.parse bits in + let fields, bits3 = parse_fields bits2 in + (List.append [field] fields, bits3) + + let parse (bits : Cstruct.t) : oxmMatch * Cstruct.t = + let length = get_ofp_match_length bits in + let oxm_bits = Cstruct.sub bits sizeof_ofp_match (length - sizeof_ofp_match) in + let fields, _ = parse_fields oxm_bits in + let bits = Cstruct.shift bits (pad_to_64bits length) in + (fields, bits) + +end + +module PseudoPort = OpenFlow0x04.PseudoPort + + +module Action = OpenFlow0x04.Action + +module Instruction = OpenFlow0x04.Instruction + +module Instructions = OpenFlow0x04.Instructions + +module Experimenter = struct + + cstruct ofp_experimenter_structure { + uint32_t experimenter; + uint32_t exp_typ + } as big_endian + + type t = experimenter + + let sizeof (_ : experimenter) : int = + sizeof_ofp_experimenter_structure + + let to_string (exp : experimenter) : string = + Format.sprintf "{ experimenter = %lu; exp_typ = %lu }" + exp.experimenter + exp.exp_typ + + let marshal (buf : Cstruct.t) (exp : t) : int = + set_ofp_experimenter_structure_experimenter buf exp.experimenter; + set_ofp_experimenter_structure_exp_typ buf exp.exp_typ; + sizeof_ofp_experimenter_structure + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_experimenter_structure_experimenter bits + ; exp_typ = get_ofp_experimenter_structure_exp_typ bits } + +end + +(* Controller to switch message *) + +module SwitchFeatures = OpenFlow0x04.SwitchFeatures + +module SwitchConfig = OpenFlow0x04.SwitchConfig + +module TableMod = struct + + module Properties = struct + + cstruct ofp_table_mod_prop_header { + uint16_t typ; + uint16_t len + } as big_endian + + cenum ofp_table_mod_prop_type { + OFPTMPT_EVICTION = 0x2; + OFPTMPT_VACANCY = 0x3; + OFPTMPT_EXPERIMENTER = 0xffff + } as uint16_t + + module Eviction = struct + + cstruct ofp_table_mod_prop_eviction { + uint16_t typ; + uint16_t len; + uint32_t flags + } as big_endian + + module Flags = struct + + type t = tableEviction + + let marshal (t : t) : int32 = + Int32.logor (if t.other then (Int32.shift_left 1l 0) else 0l) + (Int32.logor (if t.importance then (Int32.shift_left 1l 1) else 0l) + (if t.lifetime then (Int32.shift_left 1l 2) else 0l)) + + let parse (bits : int32) : t = + { other = Bits.test_bit 0 bits + ; importance = Bits.test_bit 1 bits + ; lifetime = Bits.test_bit 2 bits } + + end + + type t = tableEviction + + let sizeof (_ : t) : int = + sizeof_ofp_table_mod_prop_eviction + + let to_string (t : t) : string = + Format.sprintf "{ other = %B; importance = %B; lifetime = %B }" + t.other + t.importance + t.lifetime + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_table_mod_prop_eviction_typ buf (ofp_table_mod_prop_type_to_int OFPTMPT_EVICTION); + set_ofp_table_mod_prop_eviction_len buf (sizeof t); + set_ofp_table_mod_prop_eviction_flags buf (Flags.marshal t); + sizeof_ofp_table_mod_prop_eviction + + let parse (bits : Cstruct.t) : t = + Flags.parse (get_ofp_table_mod_prop_eviction_flags bits) + + end + + module Vacancy = struct + + cstruct ofp_table_mod_prop_vacancy { + uint16_t typ; + uint16_t len; + uint8_t vacancy_down; + uint8_t vacancy_up; + uint8_t vacancy; + uint8_t pad + } as big_endian + + type t = tableVacancy + + let sizeof (_ : t) : int = + sizeof_ofp_table_mod_prop_vacancy + + let to_string (t : t) : string = + Format.sprintf "{ vacancy_down = %u; vacancy_up = %u; vacancy = %u }" + t.vacancy_down + t.vacancy_up + t.vacancy + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_table_mod_prop_vacancy_typ buf (ofp_table_mod_prop_type_to_int OFPTMPT_VACANCY); + set_ofp_table_mod_prop_vacancy_len buf (sizeof t); + set_ofp_table_mod_prop_vacancy_vacancy_down buf t.vacancy_down; + set_ofp_table_mod_prop_vacancy_vacancy_up buf t.vacancy_up; + set_ofp_table_mod_prop_vacancy_vacancy buf t.vacancy; + sizeof_ofp_table_mod_prop_vacancy + + let parse (bits : Cstruct.t) : t = + { vacancy_down = get_ofp_table_mod_prop_vacancy_vacancy_down bits + ; vacancy_up = get_ofp_table_mod_prop_vacancy_vacancy_up bits + ; vacancy = get_ofp_table_mod_prop_vacancy_vacancy bits} + + end + + module Experimenter = struct + + cstruct ofp_table_mod_prop_experimenter { + uint16_t typ; + uint16_t len; + uint32_t experimenter; + uint32_t exp_typ + } as big_endian + + type t = experimenter + + let sizeof (_ : t) : int = + sizeof_ofp_table_mod_prop_experimenter + + let to_string (t : t) : string = + Format.sprintf "{ experimenter = %lu; exp_typ = %lu}" + t.experimenter + t.exp_typ + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_table_mod_prop_experimenter_typ buf (ofp_table_mod_prop_type_to_int OFPTMPT_EXPERIMENTER); + set_ofp_table_mod_prop_experimenter_len buf (sizeof t); + set_ofp_table_mod_prop_experimenter_experimenter buf t.experimenter; + set_ofp_table_mod_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_table_mod_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_table_mod_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_table_mod_prop_experimenter_exp_typ bits} + end + + type t = tableProperties + + let sizeof (t : t) : int = + match t with + | Eviction e -> Eviction.sizeof e + | Vacancy v -> Vacancy.sizeof v + | Experimenter e -> Experimenter.sizeof e + + let to_string (t : t) : string = + match t with + | Eviction e -> Format.sprintf "Eviction = %s " (Eviction.to_string e) + | Vacancy e -> Format.sprintf "Vacancy = %s " (Vacancy.to_string e) + | Experimenter e -> Format.sprintf "Experimenter = %s " (Experimenter.to_string e) + + let marshal (buf : Cstruct.t) (t : t) : int = + match t with + | Eviction e -> Eviction.marshal buf e + | Vacancy v -> Vacancy.marshal buf v + | Experimenter e -> Experimenter.marshal buf e + + let parse (bits : Cstruct.t) : t = + match int_to_ofp_table_mod_prop_type (get_ofp_table_mod_prop_header_typ bits) with + | Some OFPTMPT_EVICTION -> Eviction (Eviction.parse bits) + | Some OFPTMPT_VACANCY -> Vacancy (Vacancy.parse bits) + | Some OFPTMPT_EXPERIMENTER -> Experimenter (Experimenter.parse bits) + | None -> raise (Unparsable (sprintf "Malformed table mod prop type")) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_table_mod_prop_header then None + else Some (get_ofp_table_mod_prop_header_len buf) + end + + module TableConfig = struct + + type t = tableConfig + + let marshal (t : t) : int32 = + Int32.logor (if t.eviction then (Int32.shift_left 1l 2) else 0l) + (if t.vacancyEvent then (Int32.shift_left 1l 3) else 0l) + + (* don't care about deprecated bits (0 and 1) *) + let parse (bits : int32) : t = + { eviction = Bits.test_bit 2 bits + ; vacancyEvent = Bits.test_bit 3 bits } + + let to_string tc = + Format.sprintf "{ eviction = %B; vacancyEvent = %B }" + tc.eviction + tc.vacancyEvent + + end + + cstruct ofp_table_mod { + uint8_t table_id; + uint8_t pad[3]; + uint32_t config + } as big_endian + + type t = tableMod + + let sizeof (tab : tableMod) : int = + sizeof_ofp_table_mod + sum (map Properties.sizeof tab.properties) + + let to_string (tab : tableMod) : string = + Format.sprintf "{ tabled_id = %u; config = %s; properties = %s }" + tab.table_id + (TableConfig.to_string tab.config) + ("[ " ^ (String.concat "; " (map Properties.to_string tab.properties))^ " ]") + + let marshal (buf : Cstruct.t) (tab : tableMod) : int = + set_ofp_table_mod_table_id buf tab.table_id; + set_ofp_table_mod_config buf (TableConfig.marshal tab.config); + sizeof_ofp_table_mod + (marshal_fields (Cstruct.shift buf sizeof_ofp_table_mod) tab.properties Properties.marshal) + + let parse (bits : Cstruct.t) : tableMod = + let table_id = get_ofp_table_mod_table_id bits in + let config = TableConfig.parse (get_ofp_table_mod_config bits) in + let properties = parse_fields (Cstruct.shift bits sizeof_ofp_table_mod) Properties.parse Properties.length_func in + { table_id; config; properties } + +end + +module FlowMod = struct + cstruct ofp_flow_mod { + uint64_t cookie; (* Opaque controller-issued identifier. *) + uint64_t cookie_mask; (* Mask used to restrict the cookie bits + that must match when the command is + OFPFC_MODIFY* or OFPFC_DELETE*. A value + of 0 indicates no restriction. *) + + (* Flow actions. *) + uint8_t table_id; (* ID of the table to put the flow in. + For OFPFC_DELETE_* commands, OFPTT_ALL + can also be used to delete matching + flows from all tables. *) + uint8_t command; (* One of OFPFC_*. *) + uint16_t idle_timeout; (* Idle time before discarding (seconds). *) + uint16_t hard_timeout; (* Max time before discarding (seconds). *) + uint16_t priority; (* Priority level of flow entry. *) + uint32_t buffer_id; (* Buffered packet to apply to, or + OFP_NO_BUFFER. + Not meaningful for OFPFC_DELETE*. *) + uint32_t out_port; (* For OFPFC_DELETE* commands, require + matching entries to include this as an + output port. A value of OFPP_ANY + indicates no restriction. *) + uint32_t out_group; (* For OFPFC_DELETE* commands, require + matching entries to include this as an + output group. A value of OFPG_ANY + indicates no restriction. *) + uint16_t flags; (* One of OFPFF_*. *) + uint16_t importance + } as big_endian + + module FlowModCommand = struct + cenum ofp_flow_mod_command { + OFPFC_ADD = 0; (* New flow. *) + OFPFC_MODIFY = 1; (* Modify all matching flows. *) + OFPFC_MODIFY_STRICT = 2; (* Modify entry strictly matching wildcards and + priority. *) + OFPFC_DELETE = 3; (* Delete all matching flows. *) + OFPFC_DELETE_STRICT = 4 (* Delete entry strictly matching wildcards and + priority. *) + } as uint8_t + + type t = flowModCommand + + let n = ref 0L + + let sizeof _ = 1 + + let marshal (t : t) : int = match t with + | AddFlow -> n := Int64.succ !n; ofp_flow_mod_command_to_int OFPFC_ADD + | ModFlow -> ofp_flow_mod_command_to_int OFPFC_MODIFY + | ModStrictFlow -> ofp_flow_mod_command_to_int OFPFC_MODIFY_STRICT + | DeleteFlow -> ofp_flow_mod_command_to_int OFPFC_DELETE + | DeleteStrictFlow -> ofp_flow_mod_command_to_int OFPFC_DELETE_STRICT + + let parse bits : flowModCommand = + match (int_to_ofp_flow_mod_command bits) with + | Some OFPFC_ADD -> AddFlow + | Some OFPFC_MODIFY -> ModFlow + | Some OFPFC_MODIFY_STRICT -> ModStrictFlow + | Some OFPFC_DELETE -> DeleteFlow + | Some OFPFC_DELETE_STRICT -> DeleteStrictFlow + | None -> raise (Unparsable (sprintf "malformed command")) + + let to_string t = + match t with + | AddFlow -> "Add" + | ModFlow -> "Modify" + | ModStrictFlow -> "ModifyStrict" + | DeleteFlow -> "Delete" + | DeleteStrictFlow -> "DeleteStrict" + end + + type t = flowMod + + let sizeof (fm : flowMod) = + sizeof_ofp_flow_mod + (OfpMatch.sizeof fm.mfOfp_match) + (Instructions.sizeof fm.mfInstructions) + + module Flags = struct + + let marshal (f : flowModFlags) = + (if f.fmf_send_flow_rem then 1 lsl 0 else 0) lor + (if f.fmf_check_overlap then 1 lsl 1 else 0) lor + (if f.fmf_reset_counts then 1 lsl 2 else 0) lor + (if f.fmf_no_pkt_counts then 1 lsl 3 else 0) lor + (if f.fmf_no_byt_counts then 1 lsl 4 else 0) + + let parse bits : flowModFlags = + { fmf_send_flow_rem = test_bit16 0 bits + ; fmf_check_overlap = test_bit16 1 bits + ; fmf_reset_counts = test_bit16 2 bits + ; fmf_no_pkt_counts = test_bit16 3 bits + ; fmf_no_byt_counts = test_bit16 4 bits + } + + let to_string f = + Format.sprintf "{ send_flow_rem = %B; check_overlap = %B; reset_counts = %B; \ + no_pkt_counts = %B; no_byt_counts = %B }" + f.fmf_send_flow_rem + f.fmf_check_overlap + f.fmf_reset_counts + f.fmf_no_pkt_counts + f.fmf_no_byt_counts + + end + + let marshal (buf : Cstruct.t) (fm : flowMod) : int = + set_ofp_flow_mod_cookie buf fm.mfCookie.m_value; + set_ofp_flow_mod_cookie_mask buf ( + match fm.mfCookie.m_mask with + | None -> 0L + | Some mask -> mask); + set_ofp_flow_mod_table_id buf fm.mfTable_id; + set_ofp_flow_mod_command buf (FlowModCommand.marshal fm.mfCommand); + set_ofp_flow_mod_idle_timeout buf + (match fm.mfIdle_timeout with + | Permanent -> 0 + | ExpiresAfter value -> value); + set_ofp_flow_mod_hard_timeout buf + (match fm.mfHard_timeout with + | Permanent -> 0 + | ExpiresAfter value -> value); + set_ofp_flow_mod_priority buf fm.mfPriority; + set_ofp_flow_mod_buffer_id buf + (match fm.mfBuffer_id with + | None -> ofp_no_buffer + | Some bid -> bid); + set_ofp_flow_mod_out_port buf + (match fm.mfOut_port with + | None -> 0l + | Some port -> PseudoPort.marshal port); + set_ofp_flow_mod_out_group buf + (match fm.mfOut_group with + | None -> 0l + | Some gid -> gid); + set_ofp_flow_mod_flags buf (Flags.marshal fm.mfFlags); + set_ofp_flow_mod_importance buf fm.mfImportance; + let size = sizeof_ofp_flow_mod + + OfpMatch.marshal + (Cstruct.sub buf sizeof_ofp_flow_mod (OfpMatch.sizeof fm.mfOfp_match)) + fm.mfOfp_match in + size + Instructions.marshal (Cstruct.shift buf size) fm.mfInstructions + + let parse (bits : Cstruct.t) : flowMod = + let mfMask = get_ofp_flow_mod_cookie_mask bits in + let mfCookie = + if mfMask <> 0L then + {m_value = get_ofp_flow_mod_cookie bits; + m_mask = (Some (get_ofp_flow_mod_cookie_mask bits))} + else {m_value = get_ofp_flow_mod_cookie bits; + m_mask = None} + in + let mfTable_id = get_ofp_flow_mod_table_id bits in + let mfCommand = FlowModCommand.parse (get_ofp_flow_mod_command bits) in + let mfIdle_timeout = match (get_ofp_flow_mod_idle_timeout bits) with + | 0 -> Permanent + | n -> ExpiresAfter n in + let mfHard_timeout = match (get_ofp_flow_mod_hard_timeout bits) with + | 0 -> Permanent + | n -> ExpiresAfter n in + let mfPriority = get_ofp_flow_mod_priority bits in + let mfBuffer_id = match (get_ofp_flow_mod_buffer_id bits) with + | 0xffffffffl -> None + | n -> Some n in + let mfOut_port = match (get_ofp_flow_mod_out_port bits) with + | 0l -> None + | _ -> Some (PseudoPort.make (get_ofp_flow_mod_out_port bits) 0) in + let mfOut_group = match (get_ofp_flow_mod_out_group bits) with + | 0l -> None + | n -> Some n in + let mfFlags = Flags.parse (get_ofp_flow_mod_flags bits) in + let mfImportance = get_ofp_flow_mod_importance bits in + let mfOfp_match,instructionsBits = OfpMatch.parse (Cstruct.shift bits sizeof_ofp_flow_mod) in + let mfInstructions = Instructions.parse instructionsBits in + { mfCookie; mfTable_id; + mfCommand; mfIdle_timeout; + mfHard_timeout; mfPriority; + mfBuffer_id; + mfOut_port; + mfOut_group; mfFlags; mfImportance; + mfOfp_match; mfInstructions} + + let to_string (flow : flowMod) = + Format.sprintf "{ cookie = %s; table = %u; command = %s; idle_timeout = %s; \ + hard_timeout = %s; priority = %u; bufferId = %s; out_port = %s; \ + out_group = %s; flags = %s; importance = %u; match = %s; instructions = %s }" + (match flow.mfCookie.m_mask with + | None -> Int64.to_string flow.mfCookie.m_value + | Some m -> Format.sprintf "%LX/%LX" flow.mfCookie.m_value m) + flow.mfTable_id + (FlowModCommand.to_string flow.mfCommand) + (match flow.mfIdle_timeout with + | Permanent -> "Permanent" + | ExpiresAfter t-> string_of_int t) + (match flow.mfHard_timeout with + | Permanent -> "Permanent" + | ExpiresAfter t-> string_of_int t) + flow.mfPriority + (match flow.mfBuffer_id with + | None -> "None" + | Some t -> Int32.to_string t) + (match flow.mfOut_port with + | None -> "None" + | Some t -> PseudoPort.to_string t) + (match flow.mfOut_group with + | None -> "None" + | Some t -> Int32.to_string t) + (Flags.to_string flow.mfFlags) + flow.mfImportance + (OfpMatch.to_string flow.mfOfp_match) + (Instructions.to_string flow.mfInstructions) +end + +module Bucket = OpenFlow0x04.Bucket + +module GroupMod = OpenFlow0x04.GroupMod + +module PortMod = struct + + cstruct ofp_port_mod { + uint32_t port_no; + uint8_t pad[4]; + uint8_t hw_addr[6]; + uint8_t pad2[2]; + uint32_t config; + uint32_t mask; + } as big_endian + + module Properties = struct + + cenum ofp_port_mod_prop_type { + OFPPMPT_ETHERNET = 0; + OFPPMPT_OPTICAL = 1; + OFPPMPT_EXPERIMENTER = 0xffff + } as uint16_t + + module Ethernet = struct + cstruct ofp_port_mod_prop_ethernet { + uint16_t typ; + uint16_t len; + uint32_t advertise + } as big_endian + + type t = portModPropEthernet + + let to_string = PortDesc.State.to_string + + let sizeof (t : portState) = + sizeof_ofp_port_mod_prop_ethernet + + let marshal (buf : Cstruct.t) (t : portState) : int = + set_ofp_port_mod_prop_ethernet_typ buf (ofp_port_mod_prop_type_to_int OFPPMPT_ETHERNET); + set_ofp_port_mod_prop_ethernet_len buf sizeof_ofp_port_mod_prop_ethernet; + set_ofp_port_mod_prop_ethernet_advertise buf (PortDesc.State.marshal t); + sizeof_ofp_port_mod_prop_ethernet + + let parse (bits : Cstruct.t) : t = + PortDesc.State.parse (get_ofp_port_mod_prop_ethernet_advertise bits) + + end + + module Optical = struct + cstruct ofp_port_mod_prop_optical { + uint16_t typ; + uint16_t len; + uint32_t configure; + uint32_t freq_lmda; + int32_t fl_offset; + uint32_t grid_span; + uint32_t tx_pwr + } as big_endian + + type t = portModPropOptical + + let sizeof (_ : t) = + sizeof_ofp_port_mod_prop_optical + + let to_string (t : t) = + Format.sprintf "{ configure = %s; freq_lmda = %lu; fl_offset = %lu; + grid_span = %lu; tx_pwr = %lu }" + (PortDesc.Properties.OptFeatures.to_string t.configure) + t.freq_lmda + t.fl_offset + t.grid_span + t.tx_pwr + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_port_mod_prop_optical_typ buf (ofp_port_mod_prop_type_to_int OFPPMPT_OPTICAL); + set_ofp_port_mod_prop_optical_len buf sizeof_ofp_port_mod_prop_optical; + set_ofp_port_mod_prop_optical_configure buf (PortDesc.Properties.OptFeatures.marshal t.configure); + set_ofp_port_mod_prop_optical_freq_lmda buf t.freq_lmda; + set_ofp_port_mod_prop_optical_fl_offset buf t.fl_offset; + set_ofp_port_mod_prop_optical_grid_span buf t.grid_span; + set_ofp_port_mod_prop_optical_tx_pwr buf t.tx_pwr; + sizeof_ofp_port_mod_prop_optical + + let parse (bits : Cstruct.t) : t = + { configure = PortDesc.Properties.OptFeatures.parse (get_ofp_port_mod_prop_optical_configure bits) + ; freq_lmda = get_ofp_port_mod_prop_optical_freq_lmda bits + ; fl_offset = get_ofp_port_mod_prop_optical_fl_offset bits + ; grid_span = get_ofp_port_mod_prop_optical_grid_span bits + ; tx_pwr = get_ofp_port_mod_prop_optical_tx_pwr bits } + + end + + module Experimenter = struct + + cstruct ofp_port_mod_prop_experimenter { + uint16_t typ; + uint16_t len; + uint32_t experimenter; + uint32_t exp_typ + } as big_endian + + type t = experimenter + + let to_string (t : t) : string = + Format.sprintf "{ experimenter : %lu; exp_typ : %lu }" + t.experimenter + t.exp_typ + + let sizeof ( _ : t ) = + sizeof_ofp_port_mod_prop_experimenter + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_port_mod_prop_experimenter_typ buf (ofp_port_mod_prop_type_to_int OFPPMPT_EXPERIMENTER); + set_ofp_port_mod_prop_experimenter_len buf sizeof_ofp_port_mod_prop_experimenter; + set_ofp_port_mod_prop_experimenter_experimenter buf t.experimenter; + set_ofp_port_mod_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_port_mod_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_port_mod_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_port_mod_prop_experimenter_exp_typ bits} + + end + + cstruct ofp_port_mod_prop_header { + uint16_t typ; + uint16_t len; + } as big_endian + + type t = portModPropt + + let sizeof (t : t) : int = + match t with + | PortModPropEthernet p -> Ethernet.sizeof p + | PortModPropOptical p -> Optical.sizeof p + | PortModPropExperiment p -> Experimenter.sizeof p + + let to_string (t : t) : string = + match t with + | PortModPropEthernet p -> Format.sprintf "Ethernet : %s" (Ethernet.to_string p) + | PortModPropOptical p -> Format.sprintf "Optical : %s" (Optical.to_string p) + | PortModPropExperiment p -> Format.sprintf "Experimenter : %s" (Experimenter.to_string p) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_port_mod_prop_header then None + else Some (get_ofp_port_mod_prop_header_len buf) + + let marshal (buf : Cstruct.t) (t : t) = + match t with + | PortModPropEthernet p -> Ethernet.marshal buf p + | PortModPropOptical p -> Optical.marshal buf p + | PortModPropExperiment p -> Experimenter.marshal buf p + + let parse (bits : Cstruct.t) : t = + let typ = match int_to_ofp_port_mod_prop_type (get_ofp_port_mod_prop_header_typ bits) with + | Some v -> v + | None -> raise (Unparsable (sprintf "malformed prop typ")) in + match typ with + | OFPPMPT_ETHERNET -> PortModPropEthernet (Ethernet.parse bits) + | OFPPMPT_OPTICAL -> PortModPropOptical (Optical.parse bits) + | OFPPMPT_EXPERIMENTER -> PortModPropExperiment (Experimenter.parse bits) + + + end + + type t = portMod + + let sizeof pm : int = + sizeof_ofp_port_mod + sum (map Properties.sizeof pm.mpProp) + + let to_string (pm : t) : string = + Format.sprintf "{ port_no = %lu; hw_addr = %s; config = %s; mask = %s; properties = %s }" + pm.mpPortNo + (string_of_mac pm.mpHw_addr) + (PortDesc.Config.to_string pm.mpConfig) + (PortDesc.Config.to_string pm.mpMask) + ("[ " ^ (String.concat "; " (map Properties.to_string pm.mpProp)) ^ " ]") + + let marshal (buf : Cstruct.t) (pm : t) : int = + set_ofp_port_mod_port_no buf pm.mpPortNo; + set_ofp_port_mod_hw_addr (bytes_of_mac pm.mpHw_addr) 0 buf; + set_ofp_port_mod_config buf (PortDesc.Config.marshal pm.mpConfig); + set_ofp_port_mod_mask buf (PortDesc.Config.marshal pm.mpMask); + sizeof_ofp_port_mod + marshal_fields (Cstruct.shift buf sizeof_ofp_port_mod) pm.mpProp Properties.marshal + + let parse (bits : Cstruct.t) : t = + let mpPortNo = get_ofp_port_mod_port_no bits in + let mpHw_addr = mac_of_bytes (copy_ofp_port_mod_hw_addr bits) in + let mpConfig = PortDesc.Config.parse (get_ofp_port_mod_config bits) in + let mpMask = PortDesc.Config.parse (get_ofp_port_mod_mask bits) in + let mpProp = parse_fields (Cstruct.shift bits sizeof_ofp_port_mod) Properties.parse Properties.length_func in + { mpPortNo; mpHw_addr; mpConfig; mpMask; mpProp} + +end + +module MeterMod = OpenFlow0x04.MeterMod + +module Message = struct + + type t = + | Hello + | EchoRequest of bytes + | EchoReply of bytes + | Experimenter of Experimenter.t + | FeaturesRequest + | FeaturesReply of SwitchFeatures.t + | GetConfigRequestMsg of SwitchConfig.t + | GetConfigReplyMsg of SwitchConfig.t + | SetConfigMsg of SwitchConfig.t + | FlowModMsg of FlowMod.t + | GroupModMsg of GroupMod.t + | TableModMsg of TableMod.t + | PortModMsg of PortMod.t + | MeterModMsg of MeterMod.t + + let string_of_msg_code (msg : msg_code) : string = match msg with + | HELLO -> "HELLO" + | ECHO_REQ -> "ECHO_REQ" + | ECHO_RESP -> "ECHO_RESP" + | FEATURES_REQ -> "FEATURES_REQ" + | FEATURES_RESP -> "FEATURES_RESP" + | FLOW_MOD -> "FLOW_MOD" + | GROUP_MOD -> "GROUP_MOD" + | PACKET_IN -> "PACKET_IN" + | PACKET_OUT -> "PACKET_OUT" + | PORT_STATUS -> "PORT_STATUS" + | MULTIPART_REQ -> "MULTIPART_REQ" + | MULTIPART_RESP -> "MULTIPART_RESP" + | BARRIER_REQ -> "BARRIER_REQ" + | BARRIER_RESP -> "BARRIER_RESP" + | ERROR -> "ERROR" + | EXPERIMENTER -> "EXPERIMENTER" + | GET_CONFIG_REQ -> "GET_CONFIG_REQ" + | GET_CONFIG_RESP -> "GET_CONFIG_RESP" + | SET_CONFIG -> "SET_CONFIG" + | FLOW_REMOVED -> "FLOW_REMOVED" + | PORT_MOD -> "PORT_MOD" + | TABLE_MOD -> "TABLE_MOD" + | ROLE_REQ -> "ROLE_REQ" + | ROLE_RESP -> "ROLE_RESP" + | GET_ASYNC_REQ -> "GET_ASYNC_REQ" + | GET_ASYNC_REP -> "GET_ASYNC_REP" + | SET_ASYNC -> "SET_ASYNC" + | METER_MOD -> "METER_MOD" + | ROLE_STATUS -> "ROLE_STATUS" + | TABLE_STATUS -> "TABLE_STATUS" + | REQUEST_FORWARD -> "REQUEST_FORWARD" + | BUNDLE_CONTROL -> "BUNDLE_CONTROL" + | BUNDLE_ADD_MESSAGE -> "BUNDLE_ADD_MESSAGE" + + + module Header = OpenFlow_Header + + let msg_code_of_message (msg : t) : msg_code = match msg with + | Hello -> HELLO + | EchoRequest _ -> ECHO_REQ + | EchoReply _ -> ECHO_RESP + | Experimenter _ -> EXPERIMENTER + | FeaturesRequest -> FEATURES_REQ + | FeaturesReply _ -> FEATURES_RESP + | GetConfigRequestMsg _ -> GET_CONFIG_REQ + | GetConfigReplyMsg _ -> GET_CONFIG_RESP + | SetConfigMsg _ -> SET_CONFIG + | FlowModMsg _ -> FLOW_MOD + | GroupModMsg _ -> GROUP_MOD + | TableModMsg _ -> TABLE_MOD + | PortModMsg _ -> PORT_MOD + | MeterModMsg _ -> METER_MOD + + let sizeof (msg : t) : int = match msg with + | Hello -> Header.size + | EchoRequest bytes -> Header.size + (String.length (Cstruct.to_string bytes)) + | EchoReply bytes -> Header.size + (String.length (Cstruct.to_string bytes)) + | Experimenter exp -> Header.size + (Experimenter.sizeof exp) + | FeaturesRequest -> Header.size + | FeaturesReply f -> Header.size + (SwitchFeatures.sizeof f) + | GetConfigRequestMsg conf -> Header.size + SwitchConfig.sizeof conf + | GetConfigReplyMsg conf -> Header.size + SwitchConfig.sizeof conf + | SetConfigMsg conf -> Header.size + SwitchConfig.sizeof conf + | FlowModMsg flow -> Header.size + FlowMod.sizeof flow + | GroupModMsg group -> Header.size + GroupMod.sizeof group + | TableModMsg table -> Header.size + TableMod.sizeof table + | PortModMsg port -> Header.size + PortMod.sizeof port + | MeterModMsg meter -> Header.size + MeterMod.sizeof meter + + let to_string (msg : t) : string = match msg with + | Hello -> "Hello" + | EchoRequest _ -> "EchoRequest" + | EchoReply _ -> "EchoReply" + | Experimenter _ -> "Experimenter" + | FeaturesRequest -> "FeaturesRequest" + | FeaturesReply _ -> "FeaturesReply" + | GetConfigRequestMsg _ -> "GetConfigRequest" + | GetConfigReplyMsg _ -> "GetConfigReply" + | SetConfigMsg _ -> "SetConfig" + | FlowModMsg _ -> "FlowMod" + | GroupModMsg _ -> "GroupMod" + | TableModMsg _ -> "TableMod" + | PortModMsg _ -> "PortMod" + | MeterModMsg _ -> "MeterMod" + + (* let marshal (buf : Cstruct.t) (msg : message) : int = *) + (* let buf2 = (Cstruct.shift buf Header.size) in *) + (* set_ofp_header_version buf 0x05; *) + (* set_ofp_header_typ buf (msg_code_to_int (msg_code_of_message msg)); *) + (* set_ofp_header_length buf (sizeof msg); *) + + let blit_message (msg : t) (out : Cstruct.t) = + match msg with + | Hello -> + Header.size + | EchoRequest bytes + | EchoReply bytes -> + Cstruct.blit_from_string (Cstruct.to_string bytes) 0 out 0 (String.length (Cstruct.to_string bytes)); + Header.size + String.length (Cstruct.to_string bytes) + | Experimenter exp -> + Header.size + Experimenter.marshal out exp + | FeaturesRequest -> + Header.size + | FeaturesReply fr -> + Header.size + SwitchFeatures.marshal out fr + | GetConfigRequestMsg conf -> + Header.size + SwitchConfig.marshal out conf + | GetConfigReplyMsg conf -> + Header.size + SwitchConfig.marshal out conf + | SetConfigMsg conf -> + Header.size + SwitchConfig.marshal out conf + | FlowModMsg flow -> + Header.size + FlowMod.marshal out flow + | GroupModMsg group -> + Header.size + GroupMod.marshal out group + | TableModMsg table -> + Header.size + TableMod.marshal out table + | PortModMsg port -> + Header.size + PortMod.marshal out port + | MeterModMsg meter -> + Header.size + MeterMod.marshal out meter + + let header_of xid msg = + let open Header in + { version = 0x05; type_code = msg_code_to_int (msg_code_of_message msg); + length = sizeof msg; xid = xid } + + let marshal_body (msg : t) (buf : Cstruct.t) = + let _ = blit_message msg buf in + () + + let marshal (xid : xid) (msg : t) : string = + let sizeof_buf = sizeof msg in + let hdr = header_of xid msg in + let buf = Cstruct.create sizeof_buf in + Header.marshal buf hdr; + let _ = blit_message msg (Cstruct.shift buf Header.size) in + Cstruct.to_string buf + + let parse (hdr : Header.t) (body_buf : string) : (xid * t) = + let body_bits = Cstruct.of_string body_buf in + let typ = match int_to_msg_code hdr.Header.type_code with + | Some code -> code + | None -> raise (Unparsable "unknown message code") in + let msg = match typ with + | HELLO -> Hello + | ECHO_REQ -> EchoRequest body_bits + | ECHO_RESP -> EchoReply body_bits + | EXPERIMENTER -> Experimenter (Experimenter.parse body_bits) + | FEATURES_RESP -> FeaturesReply (SwitchFeatures.parse body_bits) + | GET_CONFIG_REQ -> GetConfigRequestMsg (SwitchConfig.parse body_bits) + | GET_CONFIG_RESP -> GetConfigReplyMsg (SwitchConfig.parse body_bits) + | SET_CONFIG -> SetConfigMsg (SwitchConfig.parse body_bits) + | FLOW_MOD -> FlowModMsg (FlowMod.parse body_bits) + | GROUP_MOD -> GroupModMsg (GroupMod.parse body_bits) + | TABLE_MOD -> TableModMsg (TableMod.parse body_bits) + | PORT_MOD -> PortModMsg (PortMod.parse body_bits) + | METER_MOD -> MeterModMsg (MeterMod.parse body_bits) + | code -> raise (Unparsable (Printf.sprintf "unexpected message type %s" (string_of_msg_code typ))) in + (hdr.Header.xid, msg) +end + diff --git a/lib/OpenFlow0x05.mli b/lib/OpenFlow0x05.mli new file mode 100644 index 0000000..dc407b6 --- /dev/null +++ b/lib/OpenFlow0x05.mli @@ -0,0 +1,384 @@ +open Packet +open OpenFlow0x05_Core + +type msg_code = | HELLO | ERROR | ECHO_REQ | ECHO_RESP | EXPERIMENTER | FEATURES_REQ + | FEATURES_RESP | GET_CONFIG_REQ | GET_CONFIG_RESP + | SET_CONFIG | PACKET_IN | FLOW_REMOVED | PORT_STATUS | PACKET_OUT + | FLOW_MOD | GROUP_MOD | PORT_MOD | TABLE_MOD | MULTIPART_REQ + | MULTIPART_RESP | BARRIER_REQ | BARRIER_RESP | ROLE_REQ + | ROLE_RESP | GET_ASYNC_REQ | GET_ASYNC_REP | SET_ASYNC + | METER_MOD | ROLE_STATUS | TABLE_STATUS | REQUEST_FORWARD + | BUNDLE_CONTROL | BUNDLE_ADD_MESSAGE + +module PortDesc : sig + + module Config : sig + + type t = portConfig + + val marshal : t -> int32 + + val parse : int32 -> t + + val to_string : t -> string + + end + + module State : sig + + type t = portState + + val marshal : t -> int32 + + val parse : int32 -> t + + val to_string : t -> string + + end + + module Properties : sig + + module EthFeatures : sig + + type t = ethFeatures + + val to_string : t -> string + + val marshal : t -> int32 + + val parse : int32 -> t + + end + + module OptFeatures : sig + + type t = opticalFeatures + + val to_string : t -> string + + val marshal : t -> int32 + + val parse : int32 -> t + + end + + type t = portProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + end + + type t = portDesc + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module Oxm : sig + + type t = oxm + + val field_name : t -> string + + val sizeof : t -> int + + val sizeof_headers : t list -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val marshal_header : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t * Cstruct.t + + val parse_header : Cstruct.t -> t * Cstruct.t + +end + +module OfpMatch : sig + + type t = oxmMatch + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t * Cstruct.t + +end + +module PseudoPort : sig + + type t = OpenFlow0x04_Core.pseudoPort + + val size_of : t -> int + + val to_string : t -> string + + val marshal : t -> int32 + + val make : int32 -> int16 -> t + +end + +module Action : sig + + type sequence = OpenFlow0x04_Core.actionSequence + + type t = OpenFlow0x04_Core.action + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val parse_sequence : Cstruct.t -> sequence + + val to_string : t -> string + +end + +module Instruction : sig + + type t = OpenFlow0x04_Core.instruction + + val to_string : t -> string + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module Instructions : sig + + type t = OpenFlow0x04_Core.instruction list + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val to_string : t -> string + + val parse : Cstruct.t -> t + +end + +module Experimenter : sig + + type t = experimenter + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val to_string : t -> string + + val parse : Cstruct.t -> t + +end + +module SwitchFeatures : sig + + type t = OpenFlow0x04.SwitchFeatures.t + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module SwitchConfig : sig + + type t = OpenFlow0x04_Core.switchConfig + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module TableMod : sig + + module Properties : sig + + type t = tableProperties + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + end + + type t = tableMod + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module FlowMod : sig + + module FlowModCommand : sig + + type t = flowModCommand + + val sizeof : t -> int + + val marshal : t -> int + + val parse : int -> t + + val to_string : t -> string + + end + + type t = flowMod + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val to_string : t -> string + +end + +module Bucket : sig + + type t = OpenFlow0x04_Core.bucket + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t +end + +module GroupMod : sig + + type t = OpenFlow0x04_Core.groupMod + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module PortMod : sig + + module Properties : sig + + type t = portModPropt + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + end + + type t = portMod + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module MeterMod : sig + + type t = OpenFlow0x04_Core.meterMod + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module Message : sig + + type t = + | Hello + | EchoRequest of bytes + | EchoReply of bytes + | Experimenter of Experimenter.t + | FeaturesRequest + | FeaturesReply of SwitchFeatures.t + | GetConfigRequestMsg of SwitchConfig.t + | GetConfigReplyMsg of SwitchConfig.t + | SetConfigMsg of SwitchConfig.t + | FlowModMsg of FlowMod.t + | GroupModMsg of GroupMod.t + | TableModMsg of TableMod.t + | PortModMsg of PortMod.t + | MeterModMsg of MeterMod.t + + val sizeof : t -> int + + val to_string : t -> string + + val blit_message : t -> Cstruct.t -> int + + val header_of : xid -> t -> OpenFlow_Header.t + + val marshal : xid -> t -> string + + val parse : OpenFlow_Header.t -> string -> (xid * t) + + val marshal_body : t -> Cstruct.t -> unit + +end diff --git a/lib/OpenFlow0x05_Core.ml b/lib/OpenFlow0x05_Core.ml new file mode 100644 index 0000000..0411618 --- /dev/null +++ b/lib/OpenFlow0x05_Core.ml @@ -0,0 +1,205 @@ +open Packet + +type 'a mask = { m_value : 'a; m_mask : 'a option } + +type 'a asyncMask = { m_master : 'a ; m_slave : 'a } + +type payload = + | Buffered of int32 * bytes + (** [Buffered (id, buf)] is a packet buffered on a switch. *) + | NotBuffered of bytes + +type xid = OpenFlow_Header.xid +type int12 = int16 +type int24 = int32 +type int128 = int64 * int64 + +let val_to_mask v = + { m_value = v; m_mask = None } + +let ip_to_mask (p,m) = + if m = 32l then { m_value = p; m_mask = None } + else { m_value = p; m_mask = Some m } + + +type switchId = int64 + +type groupId = int32 + +type portId = int32 + +type tableId = int8 + +type bufferId = int32 + +type pseudoPort = OpenFlow0x04_Core.pseudoPort + +type timeout = +| Permanent +| ExpiresAfter of int16 + +type experimenter = { experimenter : int32; exp_typ : int32 } + +type ethFeatures = { rate_10mb_hd : bool; rate_10mb_fd : bool; + rate_100mb_hd : bool; rate_100mb_fd : bool; + rate_1gb_hd : bool; rate_1gb_fd : bool; + rate_10gb_fd : bool; rate_40gb_fd : bool; + rate_100gb_fd : bool; rate_1tb_fd : bool; + other : bool; copper : bool; fiber : bool; + autoneg : bool; pause : bool; pause_asym : bool } + +type propEthernet = { curr : ethFeatures; + advertised : ethFeatures; + supported : ethFeatures; + peer : ethFeatures; + curr_speed : int32; + max_speed : int32} + +type opticalFeatures = { rx_tune : bool; tx_tune : bool; tx_pwr : bool; use_freq : bool} + +type propOptical = { supported : opticalFeatures; tx_min_freq_lmda : int32; + tx_max_freq_lmda : int32; tx_grid_freq_lmda : int32; + rx_min_freq_lmda : int32; rx_max_freq_lmda : int32; + rx_grid_freq_lmda : int32; tx_pwr_min : int16; tx_pwr_max : int16 } + +type portProp = + | PropEthernet of propEthernet + | PropOptical of propOptical + | PropExp of experimenter + +type portState = { link_down : bool; blocked : bool; live : bool } + +type portConfig = { port_down : bool; no_recv : bool; no_fwd : bool; + no_packet_in : bool } + +type portDesc = { port_no : portId; + hw_addr : int48; + name : string; + config : portConfig; + state : portState; + properties : portProp list + } + +type oxmIPv6ExtHdr = { noext : bool; esp : bool; auth : bool; dest : bool; frac : bool; + router : bool; hop : bool; unrep : bool; unseq : bool } + +type oxm = +| OxmInPort of portId +| OxmInPhyPort of portId +| OxmMetadata of int64 mask +| OxmEthType of int16 +| OxmEthDst of int48 mask +| OxmEthSrc of int48 mask +| OxmVlanVId of int12 mask +| OxmVlanPcp of int8 +| OxmIPProto of int8 +| OxmIPDscp of int8 +| OxmIPEcn of int8 +| OxmIP4Src of int32 mask +| OxmIP4Dst of int32 mask +| OxmTCPSrc of int16 +| OxmTCPDst of int16 +| OxmARPOp of int16 +| OxmARPSpa of int32 mask +| OxmARPTpa of int32 mask +| OxmARPSha of int48 mask +| OxmARPTha of int48 mask +| OxmICMPType of int8 +| OxmICMPCode of int8 +| OxmMPLSLabel of int32 +| OxmMPLSTc of int8 +| OxmTunnelId of int64 mask +| OxmUDPSrc of int16 +| OxmUDPDst of int16 +| OxmSCTPSrc of int16 +| OxmSCTPDst of int16 +| OxmIPv6Src of int128 mask +| OxmIPv6Dst of int128 mask +| OxmIPv6FLabel of int32 mask +| OxmICMPv6Type of int8 +| OxmICMPv6Code of int8 +| OxmIPv6NDTarget of int128 mask +| OxmIPv6NDSll of int48 +| OxmIPv6NDTll of int48 +| OxmMPLSBos of bool +| OxmPBBIsid of int24 mask +| OxmIPv6ExtHdr of oxmIPv6ExtHdr mask +| OxmPBBUCA of bool + +type oxmMatch = oxm list + +let match_all = [] + +type actionTyp = + | Output + | CopyTTLOut + | CopyTTLIn + | SetMPLSTTL + | DecMPLSTTL + | PushVLAN + | PopVLAN + | PushMPLS + | PopMPLS + | SetQueue + | Group + | SetNWTTL + | DecNWTTL + | SetField + | PushPBB + | PopPBB + | Experimenter + +type action = OpenFlow0x04_Core.action + +type instruction = OpenFlow0x04_Core.instruction + +type switchFlags = + | NormalFrag + | DropFrag + | ReasmFrag + | MaskFrag + +type tableEviction = { other : bool; importance : bool; lifetime : bool } + +type tableVacancy = { vacancy_down : int8; vacancy_up : int8; vacancy : int8 } + +type tableProperties = + | Eviction of tableEviction + | Vacancy of tableVacancy + | Experimenter of experimenter + +type tableConfig = { eviction : bool; vacancyEvent : bool } + +type tableMod = { table_id : tableId; config : tableConfig; properties : tableProperties list} + +type flowModCommand = +| AddFlow +| ModFlow +| ModStrictFlow +| DeleteFlow +| DeleteStrictFlow + +type flowModFlags = { fmf_send_flow_rem : bool; fmf_check_overlap : bool; + fmf_reset_counts : bool; fmf_no_pkt_counts : bool; + fmf_no_byt_counts : bool } + +type flowMod = { mfCookie : int64 mask; mfTable_id : tableId; + mfCommand : flowModCommand; mfIdle_timeout : timeout; + mfHard_timeout : timeout; mfPriority : int16; + mfBuffer_id : bufferId option; + mfOut_port : pseudoPort option; + mfOut_group : groupId option; mfFlags : flowModFlags; mfImportance : int16; + mfOfp_match : oxmMatch; mfInstructions : instruction list } + +type portModPropEthernet = portState + +type portModPropOptical = { configure : opticalFeatures; freq_lmda : int32; + fl_offset : int32; grid_span : int32; tx_pwr : int32 } + +type portModPropt = + | PortModPropEthernet of portModPropEthernet + | PortModPropOptical of portModPropOptical + | PortModPropExperiment of experimenter + +type portMod = { mpPortNo : portId; mpHw_addr : int48; mpConfig : portConfig; + mpMask : portConfig; mpProp : portModPropt list } \ No newline at end of file diff --git a/lib/OpenFlow0x05_Core.mli b/lib/OpenFlow0x05_Core.mli new file mode 100644 index 0000000..9100efc --- /dev/null +++ b/lib/OpenFlow0x05_Core.mli @@ -0,0 +1,202 @@ +open Packet + +type 'a mask = { m_value : 'a; m_mask : 'a option } + +type 'a asyncMask = { m_master : 'a ; m_slave : 'a } + +type payload = + | Buffered of int32 * bytes + (** [Buffered (id, buf)] is a packet buffered on a switch. *) + | NotBuffered of bytes + +type xid = OpenFlow_Header.xid +type int12 = int16 +type int24 = int32 +type int128 = int64 * int64 + + +val val_to_mask : 'a1 -> 'a1 mask + +val ip_to_mask : (nwAddr * int32) -> nwAddr mask + +type switchId = int64 + +type groupId = int32 + +type portId = int32 + +type tableId = int8 + +type bufferId = int32 + +type pseudoPort = OpenFlow0x04_Core.pseudoPort + +type timeout = +| Permanent +| ExpiresAfter of int16 + +type experimenter = { experimenter : int32; exp_typ : int32 } + +type ethFeatures = { rate_10mb_hd : bool; rate_10mb_fd : bool; + rate_100mb_hd : bool; rate_100mb_fd : bool; + rate_1gb_hd : bool; rate_1gb_fd : bool; + rate_10gb_fd : bool; rate_40gb_fd : bool; + rate_100gb_fd : bool; rate_1tb_fd : bool; + other : bool; copper : bool; fiber : bool; + autoneg : bool; pause : bool; pause_asym : bool } + +type propEthernet = { curr : ethFeatures; + advertised : ethFeatures; + supported : ethFeatures; + peer : ethFeatures; + curr_speed : int32; + max_speed : int32} + +type opticalFeatures = { rx_tune : bool; tx_tune : bool; tx_pwr : bool; use_freq : bool} + +type propOptical = { supported : opticalFeatures; tx_min_freq_lmda : int32; + tx_max_freq_lmda : int32; tx_grid_freq_lmda : int32; + rx_min_freq_lmda : int32; rx_max_freq_lmda : int32; + rx_grid_freq_lmda : int32; tx_pwr_min : int16; tx_pwr_max : int16 } + +type portProp = + | PropEthernet of propEthernet + | PropOptical of propOptical + | PropExp of experimenter + +type portState = { link_down : bool; blocked : bool; live : bool } + +type portConfig = { port_down : bool; no_recv : bool; no_fwd : bool; + no_packet_in : bool } + +type portDesc = { port_no : portId; + hw_addr : int48; + name : string; + config : portConfig; + state : portState; + properties : portProp list + } + +type oxmIPv6ExtHdr = { noext : bool; esp : bool; auth : bool; dest : bool; frac : bool; + router : bool; hop : bool; unrep : bool; unseq : bool } + +type oxm = +| OxmInPort of portId +| OxmInPhyPort of portId +| OxmMetadata of int64 mask +| OxmEthType of int16 +| OxmEthDst of int48 mask +| OxmEthSrc of int48 mask +| OxmVlanVId of int12 mask +| OxmVlanPcp of int8 +| OxmIPProto of int8 +| OxmIPDscp of int8 +| OxmIPEcn of int8 +| OxmIP4Src of int32 mask +| OxmIP4Dst of int32 mask +| OxmTCPSrc of int16 +| OxmTCPDst of int16 +| OxmARPOp of int16 +| OxmARPSpa of int32 mask +| OxmARPTpa of int32 mask +| OxmARPSha of int48 mask +| OxmARPTha of int48 mask +| OxmICMPType of int8 +| OxmICMPCode of int8 +| OxmMPLSLabel of int32 +| OxmMPLSTc of int8 +| OxmTunnelId of int64 mask +| OxmUDPSrc of int16 +| OxmUDPDst of int16 +| OxmSCTPSrc of int16 +| OxmSCTPDst of int16 +| OxmIPv6Src of int128 mask +| OxmIPv6Dst of int128 mask +| OxmIPv6FLabel of int32 mask +| OxmICMPv6Type of int8 +| OxmICMPv6Code of int8 +| OxmIPv6NDTarget of int128 mask +| OxmIPv6NDSll of int48 +| OxmIPv6NDTll of int48 +| OxmMPLSBos of bool +| OxmPBBIsid of int24 mask +| OxmIPv6ExtHdr of oxmIPv6ExtHdr mask +| OxmPBBUCA of bool + +type oxmMatch = oxm list + +val match_all : oxmMatch + +type actionTyp = + | Output + | CopyTTLOut + | CopyTTLIn + | SetMPLSTTL + | DecMPLSTTL + | PushVLAN + | PopVLAN + | PushMPLS + | PopMPLS + | SetQueue + | Group + | SetNWTTL + | DecNWTTL + | SetField + | PushPBB + | PopPBB + | Experimenter + +type action = OpenFlow0x04_Core.action + +type instruction = OpenFlow0x04_Core.instruction + +type switchFlags = + | NormalFrag + | DropFrag + | ReasmFrag + | MaskFrag + +type tableEviction = { other : bool; importance : bool; lifetime : bool } + +type tableVacancy = { vacancy_down : int8; vacancy_up : int8; vacancy : int8 } + +type tableProperties = + | Eviction of tableEviction + | Vacancy of tableVacancy + | Experimenter of experimenter + +type tableConfig = { eviction : bool; vacancyEvent : bool } + +type tableMod = { table_id : tableId; config : tableConfig; properties : tableProperties list} + +type flowModCommand = +| AddFlow +| ModFlow +| ModStrictFlow +| DeleteFlow +| DeleteStrictFlow + +type flowModFlags = { fmf_send_flow_rem : bool; fmf_check_overlap : bool; + fmf_reset_counts : bool; fmf_no_pkt_counts : bool; + fmf_no_byt_counts : bool } + +type flowMod = { mfCookie : int64 mask; mfTable_id : tableId; + mfCommand : flowModCommand; mfIdle_timeout : timeout; + mfHard_timeout : timeout; mfPriority : int16; + mfBuffer_id : bufferId option; + mfOut_port : pseudoPort option; + mfOut_group : groupId option; mfFlags : flowModFlags; mfImportance : int16; + mfOfp_match : oxmMatch; mfInstructions : instruction list } + +type portModPropEthernet = portState + +type portModPropOptical = { configure : opticalFeatures; freq_lmda : int32; + fl_offset : int32; grid_span : int32; tx_pwr : int32 } + +type portModPropt = + | PortModPropEthernet of portModPropEthernet + | PortModPropOptical of portModPropOptical + | PortModPropExperiment of experimenter + +type portMod = { mpPortNo : portId; mpHw_addr : int48; mpConfig : portConfig; + mpMask : portConfig; mpProp : portModPropt list } \ No newline at end of file diff --git a/lib/openflow.mldylib b/lib/openflow.mldylib index fca6ca8..a71e599 100644 --- a/lib/openflow.mldylib +++ b/lib/openflow.mldylib @@ -1,11 +1,13 @@ # OASIS_START -# DO NOT EDIT (digest: e33998d8f65203d198a9d7a41a9d620d) +# DO NOT EDIT (digest: 1b7bac22e7a1fe64a3966339adbe9243) OpenFlow_Header OpenFlow0x01 OpenFlow0x01_Core OpenFlow0x01_Stats OpenFlow0x04 OpenFlow0x04_Core +OpenFlow0x05 +OpenFlow0x05_Core SDN_OpenFlow0x01 SDN_OpenFlow0x04 GroupTable0x04 diff --git a/lib/openflow.mllib b/lib/openflow.mllib index fca6ca8..a71e599 100644 --- a/lib/openflow.mllib +++ b/lib/openflow.mllib @@ -1,11 +1,13 @@ # OASIS_START -# DO NOT EDIT (digest: e33998d8f65203d198a9d7a41a9d620d) +# DO NOT EDIT (digest: 1b7bac22e7a1fe64a3966339adbe9243) OpenFlow_Header OpenFlow0x01 OpenFlow0x01_Core OpenFlow0x01_Stats OpenFlow0x04 OpenFlow0x04_Core +OpenFlow0x05 +OpenFlow0x05_Core SDN_OpenFlow0x01 SDN_OpenFlow0x04 GroupTable0x04 diff --git a/quickcheck/Arbitrary_OpenFlow0x05.ml b/quickcheck/Arbitrary_OpenFlow0x05.ml new file mode 100644 index 0000000..055200f --- /dev/null +++ b/quickcheck/Arbitrary_OpenFlow0x05.ml @@ -0,0 +1,730 @@ +open OpenFlow0x05 +open OpenFlow0x05_Core +open Arbitrary_Base + +open QuickCheck +module Gen = QuickCheck_gen + +let sum (lst : int list) = List.fold_left (fun x y -> x + y) 0 lst + +let arbitrary_32mask = + let open Gen in + (choose_int (1, 32)) >>= fun a -> + ret_gen (Int32.of_int a) + +let arbitrary_128mask = + let open Gen in + (choose_int (1,64)) >>= fun a -> + (choose_int (0,64)) >>= fun b -> + ret_gen (Int64.of_int b,Int64.of_int a) + +let arbitrary_64mask = + let open Gen in + (choose_int (1,64)) >>= fun a -> + ret_gen (Int64.of_int a) + +let arbitrary_48mask = + let open Gen in + (choose_int (1,48)) >>= fun a -> + ret_gen (Int64.of_int a) + +let arbitrary_12mask = + let open Gen in + (choose_int (1,12)) >>= fun a -> + ret_gen a + +let arbitrary_16mask = + let open Gen in + (choose_int (1,16)) >>= fun a -> + ret_gen a + +let arbitrary_masked arb arb_mask = + let open OpenFlow0x05_Core in + let open Gen in + frequency [ + (1, arb >>= fun v -> ret_gen {OpenFlow0x05_Core.m_value = v; m_mask = None}); + (3, arb >>= fun v -> + arb_mask >>= fun m -> ret_gen {OpenFlow0x05_Core.m_value = v; m_mask = Some m}) ] + +let arbitrary_timeout = + let open OpenFlow0x05_Core in + let open Gen in + oneof [ + ret_gen Permanent; + arbitrary_uint16 >>= (fun n -> ret_gen (ExpiresAfter n)) + ] + +let fill_with_0 n= + String.make n '\000' + +let arbitrary_stringl n= + let open Gen in + (choose_int (0,n)) >>= fun a -> + arbitrary_stringN a >>= fun str -> + ret_gen (str ^ (fill_with_0 (n-a))) + +module type OpenFlow0x05_Arbitrary = sig + + type t + type s + + val arbitrary : t arbitrary + + val to_string : t -> string + + val parse : s -> t + val marshal : t -> s + +end + +module type OpenFlow0x05_ArbitraryCstruct = sig + type t + + val arbitrary : t arbitrary + + val to_string : t -> string + + val parse : Cstruct.t -> t + val marshal : Cstruct.t -> t -> int + + val size_of : t -> int + +end + +module OpenFlow0x05_Unsize(ArbC : OpenFlow0x05_ArbitraryCstruct) = struct + type t = ArbC.t + type s = Cstruct.t + + let arbitrary = ArbC.arbitrary + + let to_string = ArbC.to_string + + let parse = ArbC.parse + + let marshal m = + let bytes = Cstruct.of_bigarray Bigarray.(Array1.create char c_layout (ArbC.size_of m)) + in ignore (ArbC.marshal bytes m); bytes +end + +module PortDesc = struct + + module Properties = struct + module EthFeatures = struct + type t = PortDesc.Properties.EthFeatures.t + type s = Int32.t + + let arbitrary = + let open Gen in + let open PortDesc.Properties.EthFeatures in + arbitrary_bool >>= fun rate_10mb_hd -> + arbitrary_bool >>= fun rate_10mb_fd -> + arbitrary_bool >>= fun rate_100mb_hd -> + arbitrary_bool >>= fun rate_100mb_fd -> + arbitrary_bool >>= fun rate_1gb_hd -> + arbitrary_bool >>= fun rate_1gb_fd -> + arbitrary_bool >>= fun rate_10gb_fd -> + arbitrary_bool >>= fun rate_40gb_fd -> + arbitrary_bool >>= fun rate_100gb_fd -> + arbitrary_bool >>= fun rate_1tb_fd -> + arbitrary_bool >>= fun other -> + arbitrary_bool >>= fun copper -> + arbitrary_bool >>= fun fiber -> + arbitrary_bool >>= fun autoneg -> + arbitrary_bool >>= fun pause -> + arbitrary_bool >>= fun pause_asym -> + ret_gen { + rate_10mb_hd; rate_10mb_fd; + rate_100mb_hd; rate_100mb_fd; + rate_1gb_hd; rate_1gb_fd; + rate_10gb_fd; rate_40gb_fd; + rate_100gb_fd; rate_1tb_fd; + other; copper; fiber; + autoneg; pause; pause_asym + } + + let to_string = PortDesc.Properties.EthFeatures.to_string + let marshal = PortDesc.Properties.EthFeatures.marshal + let parse = PortDesc.Properties.EthFeatures.parse + end + + module OptFeatures = struct + type t = PortDesc.Properties.OptFeatures.t + type s = Int32.t + + let arbitrary = + let open Gen in + let open PortDesc.Properties.OptFeatures in + arbitrary_bool >>= fun rx_tune -> + arbitrary_bool >>= fun tx_tune -> + arbitrary_bool >>= fun tx_pwr -> + arbitrary_bool >>= fun use_freq -> + ret_gen { + rx_tune; tx_tune; + tx_pwr; use_freq + } + + let to_string = PortDesc.Properties.OptFeatures.to_string + let marshal = PortDesc.Properties.OptFeatures.marshal + let parse = PortDesc.Properties.OptFeatures.parse + end + + type t = PortDesc.Properties.t + + let arbitrary = + let open Gen in + oneof [ + (EthFeatures.arbitrary >>= fun curr -> + EthFeatures.arbitrary >>= fun advertised -> + EthFeatures.arbitrary >>= fun supported -> + EthFeatures.arbitrary >>= fun peer -> + arbitrary_uint32 >>= fun curr_speed -> + arbitrary_uint32 >>= fun max_speed -> + ret_gen (PropEthernet { curr; advertised; supported; peer; curr_speed; max_speed } )); + (OptFeatures.arbitrary >>= fun supported -> + arbitrary_uint32 >>= fun tx_min_freq_lmda -> + arbitrary_uint32 >>= fun tx_max_freq_lmda -> + arbitrary_uint32 >>= fun tx_grid_freq_lmda -> + arbitrary_uint32 >>= fun rx_min_freq_lmda -> + arbitrary_uint32 >>= fun rx_max_freq_lmda -> + arbitrary_uint32 >>= fun rx_grid_freq_lmda -> + arbitrary_uint16 >>= fun tx_pwr_min -> + arbitrary_uint16 >>= fun tx_pwr_max -> + ret_gen (PropOptical {supported; tx_min_freq_lmda; tx_max_freq_lmda; tx_grid_freq_lmda; + rx_min_freq_lmda; rx_max_freq_lmda; rx_grid_freq_lmda; + tx_pwr_min; tx_pwr_max} )) + ] + + + let to_string = PortDesc.Properties.to_string + let marshal = PortDesc.Properties.marshal + let parse = PortDesc.Properties.parse + let size_of = PortDesc.Properties.sizeof + end + + module State = struct + type t = PortDesc.State.t + type s = Int32.t + let arbitrary = + let open Gen in + let open PortDesc.State in + arbitrary_bool >>= fun link_down -> + arbitrary_bool >>= fun blocked -> + arbitrary_bool >>= fun live -> + ret_gen { + link_down; + blocked; + live + } + let to_string = PortDesc.State.to_string + let marshal = PortDesc.State.marshal + let parse = PortDesc.State.parse + end + + module Config = struct + type t = PortDesc.Config.t + type s = Int32.t + let arbitrary = + let open Gen in + let open PortDesc.Config in + arbitrary_bool >>= fun port_down -> + arbitrary_bool >>= fun no_recv -> + arbitrary_bool >>= fun no_fwd -> + arbitrary_bool >>= fun no_packet_in -> + ret_gen { + port_down; + no_recv; + no_fwd; + no_packet_in + } + let to_string = PortDesc.Config.to_string + let marshal = PortDesc.Config.marshal + let parse = PortDesc.Config.parse + end + + type t = PortDesc.t + + let arbitrary = + let open Gen in + arbitrary_uint32 >>= fun port_no -> + arbitrary_uint48 >>= fun hw_addr -> + arbitrary_stringN 16 >>= fun name -> + Config.arbitrary >>= fun config -> + State.arbitrary >>= fun state -> + list1 Properties.arbitrary >>= fun properties -> + ret_gen { + port_no; + hw_addr; + name; + config; + state; + properties + } + + let to_string = PortDesc.to_string + let parse = PortDesc.parse + let marshal = PortDesc.marshal + let size_of = PortDesc.sizeof + +end + + +module OfpMatch = struct + open Gen + type t = OfpMatch.t + + module Oxm = struct + type t = Oxm.t + + let arbitrary = + let open Gen in + let open Oxm in + let arbitrary_dscp = + (choose_int (0,64)) >>= fun a -> + ret_gen a in + let arbitrary_ecn = + (choose_int (0,3)) >>= fun a -> + ret_gen a in + let arbitrary_24mask = + let open Gen in + (choose_int (1,24)) >>= fun a -> + ret_gen (Int32.of_int a) in + let arbitrary_uint24 = + arbitrary_uint16 >>= fun a -> + arbitrary_uint8 >>= fun b -> + let open Int32 in + let hi = shift_left (of_int a) 8 in + let lo = of_int b in + ret_gen (logor hi lo) in + let arbitrary_ipv6hdr = + arbitrary_bool >>= fun noext -> + arbitrary_bool >>= fun esp -> + arbitrary_bool >>= fun auth -> + arbitrary_bool >>= fun dest -> + arbitrary_bool >>= fun frac -> + arbitrary_bool >>= fun router -> + arbitrary_bool >>= fun hop -> + arbitrary_bool >>= fun unrep -> + arbitrary_bool >>= fun unseq -> + ret_gen {noext; esp; auth; dest; frac; router; hop; unrep; unseq } in + arbitrary_uint32 >>= fun portId -> + arbitrary_uint32 >>= fun portPhyId -> + arbitrary_masked arbitrary_uint64 arbitrary_64mask >>= fun oxmMetadata -> + arbitrary_uint16 >>= fun oxmEthType -> + arbitrary_masked arbitrary_uint48 arbitrary_48mask >>= fun oxmEthDst -> + arbitrary_masked arbitrary_uint48 arbitrary_48mask >>= fun oxmEthSrc -> + arbitrary_masked arbitrary_uint12 arbitrary_12mask >>= fun oxmVlanVId -> + arbitrary_uint8 >>= fun oxmVlanPcp -> + arbitrary_uint8 >>= fun oxmIPProto -> + arbitrary_dscp >>= fun oxmIPDscp -> + arbitrary_ecn >>= fun oxmIPEcn -> + arbitrary_masked arbitrary_uint32 arbitrary_32mask >>= fun oxmIP4Src -> + arbitrary_masked arbitrary_uint32 arbitrary_32mask >>= fun oxmIP4Dst -> + arbitrary_uint16 >>= fun oxmTCPSrc -> + arbitrary_uint16 >>= fun oxmTCPDst -> + arbitrary_uint16 >>= fun oxmARPOp -> + arbitrary_masked arbitrary_uint32 arbitrary_32mask >>= fun oxmARPSpa -> + arbitrary_masked arbitrary_uint32 arbitrary_32mask >>= fun oxmARPTpa -> + arbitrary_masked arbitrary_uint48 arbitrary_48mask >>= fun oxmARPSha -> + arbitrary_masked arbitrary_uint48 arbitrary_48mask >>= fun oxmARPTha -> + arbitrary_uint8 >>= fun oxmICMPType -> + arbitrary_uint8 >>= fun oxmICMPCode -> + arbitrary_uint32 >>= fun oxmMPLSLabel -> + arbitrary_uint8 >>= fun oxmMPLSTc -> + arbitrary_masked arbitrary_uint64 arbitrary_64mask >>= fun oxmTunnelId -> + arbitrary_masked arbitrary_uint128 arbitrary_128mask >>= fun oxmIPv6Src -> + arbitrary_masked arbitrary_uint128 arbitrary_128mask >>= fun oxmIPv6Dst -> + arbitrary_masked arbitrary_uint32 arbitrary_32mask >>= fun oxmIPv6FLabel -> + arbitrary_masked arbitrary_uint128 arbitrary_128mask >>= fun oxmIPv6NDTarget -> + arbitrary_masked arbitrary_uint24 arbitrary_24mask >>= fun oxmPBBIsid -> + arbitrary_masked arbitrary_ipv6hdr arbitrary_ipv6hdr >>= fun oxmIPv6ExtHdr -> + arbitrary_bool >>= fun oxmMPLSBos -> + arbitrary_uint16 >>= fun oxmUDPSrc -> + arbitrary_uint16 >>= fun oxmUDPDst -> + arbitrary_uint16 >>= fun oxmSCTPSrc -> + arbitrary_uint16 >>= fun oxmSCTPDst -> + arbitrary_uint8 >>= fun oxmICMPv6Type -> + arbitrary_uint8 >>= fun oxmICMPv6Code -> + arbitrary_uint48 >>= fun oxmIPv6NDSll -> + arbitrary_uint48 >>= fun oxmIPv6NDTll -> + arbitrary_bool >>= fun oxmPBBUCA -> + oneof [ + ret_gen (OxmInPort portId); + ret_gen (OxmInPhyPort portPhyId); + ret_gen (OxmMetadata oxmMetadata); + ret_gen (OxmEthType oxmEthType); + ret_gen (OxmEthDst oxmEthDst); + ret_gen (OxmEthSrc oxmEthSrc); + ret_gen (OxmVlanVId oxmVlanVId); + ret_gen (OxmVlanPcp oxmVlanPcp); + ret_gen (OxmIPProto oxmIPProto); + ret_gen (OxmIPDscp oxmIPDscp); + ret_gen (OxmIPEcn oxmIPEcn); + ret_gen (OxmIP4Src oxmIP4Src); + ret_gen (OxmIP4Dst oxmIP4Dst); + ret_gen (OxmTCPSrc oxmTCPSrc); + ret_gen (OxmTCPDst oxmTCPDst); + ret_gen (OxmARPOp oxmARPOp); + ret_gen (OxmARPSpa oxmARPSpa); + ret_gen (OxmARPTpa oxmARPTpa); + ret_gen (OxmARPSha oxmARPSha); + ret_gen (OxmARPTha oxmARPTha); + ret_gen (OxmICMPType oxmICMPType); + ret_gen (OxmICMPCode oxmICMPCode); + ret_gen (OxmMPLSLabel oxmMPLSLabel); + ret_gen (OxmMPLSTc oxmMPLSTc); + ret_gen (OxmTunnelId oxmTunnelId); + ret_gen (OxmUDPSrc oxmUDPSrc); + ret_gen (OxmUDPDst oxmUDPDst); + ret_gen (OxmSCTPSrc oxmSCTPSrc); + ret_gen (OxmSCTPDst oxmSCTPDst); + ret_gen (OxmIPv6Src oxmIPv6Src); + ret_gen (OxmIPv6Dst oxmIPv6Dst); + ret_gen (OxmIPv6FLabel oxmIPv6FLabel); + ret_gen (OxmICMPv6Type oxmICMPv6Type); + ret_gen (OxmICMPv6Code oxmICMPv6Code); + ret_gen (OxmIPv6NDTarget oxmIPv6NDTarget); + ret_gen (OxmIPv6NDSll oxmIPv6NDSll); + ret_gen (OxmIPv6NDTll oxmIPv6NDTll); + ret_gen (OxmMPLSBos oxmMPLSBos); + ret_gen (OxmPBBIsid oxmPBBIsid); + ret_gen (OxmIPv6ExtHdr oxmIPv6ExtHdr); + ret_gen (OxmPBBUCA oxmPBBUCA) + ] + let marshal = Oxm.marshal + let to_string = Oxm.to_string + let size_of = Oxm.sizeof + let parse bits = + let p,_ = Oxm.parse bits in + p + end + + module OxmHeader = struct + type t = Oxm.t + + module Oxm = OpenFlow0x05.Oxm + + let arbitrary = + let open Gen in + let open Oxm in + let ipv6hdr_nul = {noext = false; esp = false; auth = false; dest = false; frac = false; router = false; hop = false; unrep = false; unseq = false } in + arbitrary_masked (ret_gen 0L) (ret_gen 0L) >>= fun oxmMetadata -> + arbitrary_masked (ret_gen 0L) (ret_gen 0L) >>= fun oxmEthDst -> + arbitrary_masked (ret_gen 0L) (ret_gen 0L) >>= fun oxmEthSrc -> + arbitrary_masked (ret_gen 0) (ret_gen 0) >>= fun oxmVlanVId -> + arbitrary_masked (ret_gen 0l) (ret_gen 0l) >>= fun oxmIP4Src -> + arbitrary_masked (ret_gen 0l) (ret_gen 0l) >>= fun oxmIP4Dst -> + arbitrary_masked (ret_gen 0l) (ret_gen 0l) >>= fun oxmARPSpa -> + arbitrary_masked (ret_gen 0l) (ret_gen 0l) >>= fun oxmARPTpa -> + arbitrary_masked (ret_gen 0L) (ret_gen 0L) >>= fun oxmARPSha -> + arbitrary_masked (ret_gen 0L) (ret_gen 0L) >>= fun oxmARPTha -> + arbitrary_masked (ret_gen 0L) (ret_gen 0L) >>= fun oxmTunnelId -> + arbitrary_masked (ret_gen (0L,0L)) (ret_gen (0L,0L)) >>= fun oxmIPv6Src -> + arbitrary_masked (ret_gen (0L,0L)) (ret_gen (0L,0L)) >>= fun oxmIPv6Dst -> + arbitrary_masked (ret_gen 0l) (ret_gen 0l) >>= fun oxmIPv6FLabel -> + arbitrary_masked (ret_gen (0L,0L)) (ret_gen (0L,0L)) >>= fun oxmIPv6NDTarget -> + arbitrary_masked (ret_gen 0l) (ret_gen 0l) >>= fun oxmPBBIsid -> + arbitrary_masked (ret_gen ipv6hdr_nul) (ret_gen ipv6hdr_nul) >>= fun oxmIPv6ExtHdr -> + + oneof [ + ret_gen (OxmInPort 0l); + ret_gen (OxmInPhyPort 0l); + ret_gen (OxmMetadata oxmMetadata); + ret_gen (OxmEthType 0); + ret_gen (OxmEthDst oxmEthDst); + ret_gen (OxmEthSrc oxmEthSrc); + ret_gen (OxmVlanVId oxmVlanVId); + ret_gen (OxmVlanPcp 0); + ret_gen (OxmIPProto 0); + ret_gen (OxmIPDscp 0); + ret_gen (OxmIPEcn 0); + ret_gen (OxmIP4Src oxmIP4Src); + ret_gen (OxmIP4Dst oxmIP4Dst); + ret_gen (OxmTCPSrc 0); + ret_gen (OxmTCPDst 0); + ret_gen (OxmARPOp 0); + ret_gen (OxmARPSpa oxmARPSpa); + ret_gen (OxmARPTpa oxmARPTpa); + ret_gen (OxmARPSha oxmARPSha); + ret_gen (OxmARPTha oxmARPTha); + ret_gen (OxmICMPType 0); + ret_gen (OxmICMPCode 0); + ret_gen (OxmMPLSLabel 0l); + ret_gen (OxmMPLSTc 0); + ret_gen (OxmTunnelId oxmTunnelId); + ret_gen (OxmUDPSrc 0); + ret_gen (OxmUDPDst 0); + ret_gen (OxmSCTPSrc 0); + ret_gen (OxmSCTPDst 0); + ret_gen (OxmIPv6Src oxmIPv6Src); + ret_gen (OxmIPv6Dst oxmIPv6Dst); + ret_gen (OxmIPv6FLabel oxmIPv6FLabel); + ret_gen (OxmICMPv6Type 0); + ret_gen (OxmICMPv6Code 0); + ret_gen (OxmIPv6NDTarget oxmIPv6NDTarget); + ret_gen (OxmIPv6NDSll 0L); + ret_gen (OxmIPv6NDTll 0L); + ret_gen (OxmMPLSBos false); + ret_gen (OxmPBBIsid oxmPBBIsid); + ret_gen (OxmIPv6ExtHdr oxmIPv6ExtHdr); + ret_gen (OxmPBBUCA false) + ] + + let marshal = Oxm.marshal_header + + let to_string = Oxm.field_name + let size_of = Oxm.sizeof + let parse bits = + let p,_ = Oxm.parse_header bits in + p + end + + let arbitrary = + let open Gen in + let open OfpMatch in + arbitrary_list Oxm.arbitrary >>= fun ofpMatch -> + ret_gen ofpMatch + + let marshal = OfpMatch.marshal + let parse bits= + let ofpMatch,_ = OfpMatch.parse bits in + ofpMatch + let to_string = OfpMatch.to_string + let size_of = OfpMatch.sizeof +end + +module PseudoPort = Arbitrary_OpenFlow0x04.PseudoPort + +module Action = Arbitrary_OpenFlow0x04.Action + +module Instructions = Arbitrary_OpenFlow0x04.Instructions + +module Experimenter = struct + open Gen + type t = Experimenter.t + + let arbitrary = + let open Gen in + let open Experimenter in + arbitrary_uint32 >>= fun experimenter -> + arbitrary_uint32 >>= fun exp_typ -> + ret_gen { experimenter; exp_typ } + + let marshal = Experimenter.marshal + let parse = Experimenter.parse + let to_string = Experimenter.to_string + let size_of = Experimenter.sizeof + +end + +module SwitchFeatures = struct + open Gen + type t = SwitchFeatures.t + + let arbitrary = + let open Gen in + let open OpenFlow0x04.SwitchFeatures in + let arbitrary_capabilities = + let open OpenFlow0x04_Core in + arbitrary_bool >>= fun flow_stats -> + arbitrary_bool >>= fun table_stats -> + arbitrary_bool >>= fun port_stats -> + arbitrary_bool >>= fun group_stats -> + arbitrary_bool >>= fun ip_reasm -> + arbitrary_bool >>= fun queue_stats -> + arbitrary_bool >>= fun port_blocked -> + ret_gen {flow_stats; table_stats; port_stats; group_stats; ip_reasm; queue_stats; port_blocked } in + arbitrary_capabilities >>= fun supported_capabilities -> + arbitrary_uint64 >>= fun datapath_id -> + arbitrary_uint32 >>= fun num_buffers -> + arbitrary_uint8 >>= fun num_tables -> + arbitrary_uint8 >>= fun aux_id -> + ret_gen { datapath_id; num_buffers; num_tables; aux_id; supported_capabilities } + + let marshal = SwitchFeatures.marshal + let parse = SwitchFeatures.parse + let to_string = SwitchFeatures.to_string + let size_of = SwitchFeatures.sizeof +end + +module SwitchConfig = Arbitrary_OpenFlow0x04.SwitchConfig + +module TableMod = struct + open Gen + open OpenFlow0x05_Core + + module Properties = struct + open Gen + open OpenFlow0x05_Core + + type t = TableMod.Properties.t + + let arbitrary_eviction = + arbitrary_bool >>= fun other -> + arbitrary_bool >>= fun importance -> + arbitrary_bool >>= fun lifetime -> + ret_gen { other; importance; lifetime } + + let arbitrary_vacancy = + arbitrary_uint8 >>= fun vacancy_down -> + arbitrary_uint8 >>= fun vacancy_up -> + arbitrary_uint8 >>= fun vacancy -> + ret_gen { vacancy_down; vacancy_up; vacancy } + + let arbitrary = + arbitrary_eviction >>= fun e -> + arbitrary_vacancy >>= fun v -> + oneof [ + ret_gen (Eviction e); + ret_gen (Vacancy v) + ] + + let marshal = TableMod.Properties.marshal + let parse = TableMod.Properties.parse + let to_string = TableMod.Properties.to_string + let size_of = TableMod.Properties.sizeof + end + type t = TableMod.t + + let arbitrary_config = + arbitrary_bool >>= fun eviction -> + arbitrary_bool >>= fun vacancyEvent -> + ret_gen { eviction; vacancyEvent } + + let arbitrary = + arbitrary_uint8 >>= fun table_id -> + arbitrary_config >>= fun config -> + arbitrary_list Properties.arbitrary >>= fun properties -> + ret_gen { table_id; config ; properties } + + let marshal = TableMod.marshal + let parse = TableMod.parse + let to_string = TableMod.to_string + let size_of = TableMod.sizeof + +end + +module FlowMod = struct + open Gen + module FlowModCommand = struct + type t = FlowMod.FlowModCommand.t + + let arbitrary = + let open Gen in + oneof [ + ret_gen AddFlow; + ret_gen ModFlow; + ret_gen ModStrictFlow; + ret_gen DeleteFlow; + ret_gen DeleteStrictFlow; + ] + let to_string = FlowMod.FlowModCommand.to_string + let marshal = FlowMod.FlowModCommand.marshal + let parse = FlowMod.FlowModCommand.parse + end + type t = FlowMod.t + + let arbitrary_flags = + arbitrary_bool >>= fun fmf_send_flow_rem -> + arbitrary_bool >>= fun fmf_check_overlap -> + arbitrary_bool >>= fun fmf_reset_counts -> + arbitrary_bool >>= fun fmf_no_pkt_counts -> + arbitrary_bool >>= fun fmf_no_byt_counts -> + ret_gen { + fmf_send_flow_rem; + fmf_check_overlap; + fmf_reset_counts; + fmf_no_pkt_counts; + fmf_no_byt_counts + } + + let arbitrary_buffer_id = + arbitrary_uint32 >>= fun bid -> + oneof [ + ret_gen None; + ret_gen (Some bid) + ] + + let arbitrary = + arbitrary_masked arbitrary_uint64 arbitrary_64mask >>= fun mfCookie -> + arbitrary_uint8 >>= fun mfTable_id -> + arbitrary_timeout >>= fun mfIdle_timeout -> + arbitrary_timeout >>= fun mfHard_timeout -> + arbitrary_uint16 >>= fun mfPriority -> + arbitrary_flags >>= fun mfFlags -> + arbitrary_buffer_id >>= fun mfBuffer_id -> + FlowModCommand.arbitrary >>= fun mfCommand -> + PseudoPort.arbitrary_nc >>= fun mfPort -> + oneof [ ret_gen None; ret_gen (Some mfPort)] >>= fun mfOut_port -> + arbitrary_uint32 >>= fun mfGroup -> + oneof [ ret_gen None; ret_gen (Some mfGroup)] >>= fun mfOut_group -> + arbitrary_uint16 >>= fun mfImportance -> + OfpMatch.arbitrary >>= fun mfOfp_match -> + Instructions.arbitrary >>= fun mfInstructions -> + ret_gen { + mfCookie; mfTable_id; + mfCommand; mfIdle_timeout; + mfHard_timeout; mfPriority; + mfBuffer_id; + mfOut_port; + mfOut_group; mfFlags; mfImportance; + mfOfp_match; mfInstructions} + + let marshal = FlowMod.marshal + let parse = FlowMod.parse + let to_string = FlowMod.to_string + let size_of = FlowMod.sizeof +end + +module Bucket = Arbitrary_OpenFlow0x04.Bucket + +module GroupMod = Arbitrary_OpenFlow0x04.GroupMod + +module PortMod = struct + open Gen + + module Properties = struct + open Gen + type t = portModPropt + + let arbitrary = + oneof [ + (PortDesc.State.arbitrary >>= fun a -> + ret_gen (PortModPropEthernet a)); + (PortDesc.Properties.OptFeatures.arbitrary >>= fun configure -> + arbitrary_uint32 >>= fun freq_lmda -> + arbitrary_uint32 >>= fun fl_offset -> + arbitrary_uint32 >>= fun grid_span -> + arbitrary_uint32 >>= fun tx_pwr -> + ret_gen (PortModPropOptical {configure; freq_lmda; fl_offset; grid_span; tx_pwr})) + ] + + let to_string = PortMod.Properties.to_string + let marshal = PortMod.Properties.marshal + let parse = PortMod.Properties.parse + let size_of = PortMod.Properties.sizeof + end + + type t = PortMod.t + + let arbitrary = + arbitrary_uint32 >>= fun mpPortNo -> + arbitrary_uint48 >>= fun mpHw_addr -> + PortDesc.Config.arbitrary >>= fun mpConfig -> + PortDesc.Config.arbitrary >>= fun mpMask -> + list1 Properties.arbitrary >>= fun mpProp -> + ret_gen { mpPortNo; mpHw_addr; mpConfig; mpMask; mpProp} + + + let marshal = PortMod.marshal + let parse = PortMod.parse + let to_string = PortMod.to_string + let size_of = PortMod.sizeof + + let marshal = PortMod.marshal + let parse = PortMod.parse + let to_string = PortMod.to_string + let size_of = PortMod.sizeof + +end + + diff --git a/quickcheck/quickcheck.mllib b/quickcheck/quickcheck.mllib index b272c17..3719b83 100644 --- a/quickcheck/quickcheck.mllib +++ b/quickcheck/quickcheck.mllib @@ -1,7 +1,8 @@ # OASIS_START -# DO NOT EDIT (digest: 2dd0f0252d70a2047df42b62a709e5c7) +# DO NOT EDIT (digest: 3a23b4722464eff99755dddd1f9afff5) Arbitrary_OpenFlow Arbitrary_OpenFlow0x01 Arbitrary_OpenFlow0x04 +Arbitrary_OpenFlow0x05 Arbitrary_SDN_Types # OASIS_STOP diff --git a/setup.ml b/setup.ml index 9e5e557..0b1c9e2 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.4 *) (* OASIS_START *) -(* DO NOT EDIT (digest: d3fea132ac8dd48eb651edee564f7d39) *) +(* DO NOT EDIT (digest: 27baacebdede1e86ec285ee7b23a7fb3) *) (* Regenerated by OASIS v0.4.4 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6942,6 +6942,8 @@ let setup_t = "OpenFlow0x01_Stats"; "OpenFlow0x04"; "OpenFlow0x04_Core"; + "OpenFlow0x05"; + "OpenFlow0x05_Core"; "SDN_OpenFlow0x01"; "SDN_OpenFlow0x04"; "GroupTable0x04"; @@ -7052,6 +7054,7 @@ let setup_t = "Arbitrary_OpenFlow"; "Arbitrary_OpenFlow0x01"; "Arbitrary_OpenFlow0x04"; + "Arbitrary_OpenFlow0x05"; "Arbitrary_SDN_Types" ]; lib_pack = false; @@ -7255,7 +7258,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.4"; - oasis_digest = Some "\018\158qXM\161\177=W\181^R$A\254\025"; + oasis_digest = Some "d%\205\146\031b\183\007\225\199\199\227`EcG"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7263,6 +7266,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7267 "setup.ml" +# 7270 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/test/Test.ml b/test/Test.ml index 73a7ff4..83e3c63 100644 --- a/test/Test.ml +++ b/test/Test.ml @@ -165,6 +165,7 @@ module RoundTripping = struct module Gen = Arbitrary_OpenFlow0x01 module Gen0x04 = Arbitrary_OpenFlow0x04 + module Gen0x05 = Arbitrary_OpenFlow0x05 TEST "OpenFlow_Header RoundTrip" = let module GenHeader = Gen.OpenFlow0x01_Unsize(Arbitrary_OpenFlow.Header) in @@ -442,11 +443,11 @@ module RoundTripping = struct let module GenPacketIn = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.PacketIn) in (openflow_quickCheck GenPacketIn.arbitrary GenPacketIn.to_string GenPacketIn.parse GenPacketIn.marshal) - - TEST "OpenFlow0x04 RoleRequest RoundTrip" = - let module GenRoleReq = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.RoleRequest) in - (openflow_quickCheck GenRoleReq.arbitrary - GenRoleReq.to_string GenRoleReq.parse GenRoleReq.marshal) + + TEST "OpenFlow0x04 RoleRequest RoundTrip" = + let module GenRoleReq = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.RoleRequest) in + (openflow_quickCheck GenRoleReq.arbitrary + GenRoleReq.to_string GenRoleReq.parse GenRoleReq.marshal) TEST "OpenFlow0x04 SwitchConfig RoundTrip" = let module GenSwitchConfig = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.SwitchConfig) in @@ -488,6 +489,115 @@ module RoundTripping = struct (openflow_quickCheck GenError.arbitrary GenError.to_string GenError.parse GenError.marshal) + TEST "OpenFlow0x05 PortDesc.PortConfig RoundTrip" = + let module GenPortConfig = Gen0x05.PortDesc.Config in + (openflow_quickCheck GenPortConfig.arbitrary + GenPortConfig.to_string GenPortConfig.parse GenPortConfig.marshal) + + TEST "OpenFlow0x05 PortDesc.PortState RoundTrip" = + let module GenPortState = Gen0x05.PortDesc.State in + (openflow_quickCheck GenPortState.arbitrary + GenPortState.to_string GenPortState.parse GenPortState.marshal) + + TEST "OpenFlow0x05 PortDesc.Properties RoundTrip" = + let module GenProperties = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.PortDesc.Properties) in + (openflow_quickCheck GenProperties.arbitrary + GenProperties.to_string GenProperties.parse GenProperties.marshal) + + TEST "OpenFlow0x05 PortDesc RoundTrip" = + let module PortDesc = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.PortDesc) in + (openflow_quickCheck PortDesc.arbitrary + PortDesc.to_string PortDesc.parse PortDesc.marshal) + + TEST "OpenFlow0x05 OfpMatch RoundTrip" = + let module GenOfpMatch = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.OfpMatch) in + (openflow_quickCheck GenOfpMatch.arbitrary + GenOfpMatch.to_string GenOfpMatch.parse GenOfpMatch.marshal) + + TEST "OpenFlow0x05 OfpMatch.Oxm RoundTrip" = + let module GenOxm = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.OfpMatch.Oxm) in + (openflow_quickCheck GenOxm.arbitrary + GenOxm.to_string GenOxm.parse GenOxm.marshal) + + TEST "OpenFlow0x05 OfpMatch.OxmHeader RoundTrip" = + let module GenOxm = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.OfpMatch.OxmHeader) in + (openflow_quickCheck GenOxm.arbitrary + GenOxm.to_string GenOxm.parse GenOxm.marshal) + + TEST "OpenFlow0x05 PseudoPort RoundTrip" = + let module GenPseudoPort = Gen0x05.PseudoPort in + (openflow_quickCheck GenPseudoPort.arbitrary + GenPseudoPort.to_string GenPseudoPort.parse GenPseudoPort.marshal) + + TEST "OpenFlow0x05 Action RoundTrip" = + let module GenAction = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.Action) in + (openflow_quickCheck GenAction.arbitrary + GenAction.to_string GenAction.parse GenAction.marshal) + + TEST "OpenFlow0x05 Instructions.Instruction RoundTrip" = + let module GenInstruction = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.Instructions.Instruction) in + (openflow_quickCheck GenInstruction.arbitrary + GenInstruction.to_string GenInstruction.parse GenInstruction.marshal) + + TEST "OpenFlow0x05 Instructions RoundTrip" = + let module GenInstructions = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.Instructions) in + (openflow_quickCheck GenInstructions.arbitrary + GenInstructions.to_string GenInstructions.parse GenInstructions.marshal) + + TEST "OpenFlow0x05 Experimenter RoundTrip" = + let module GenExperimenter = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.Experimenter) in + (openflow_quickCheck GenExperimenter.arbitrary + GenExperimenter.to_string GenExperimenter.parse GenExperimenter.marshal) + + TEST "OpenFlow0x05 SwitchFeatures RoundTrip" = + let module GenSwitchFeatures = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.SwitchFeatures) in + (openflow_quickCheck GenSwitchFeatures.arbitrary + GenSwitchFeatures.to_string GenSwitchFeatures.parse GenSwitchFeatures.marshal) + + TEST "OpenFlow0x05 SwitchConfig RoundTrip" = + let module GenSwitchConfig = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.SwitchConfig) in + (openflow_quickCheck GenSwitchConfig.arbitrary + GenSwitchConfig.to_string GenSwitchConfig.parse GenSwitchConfig.marshal) + + TEST "OpenFlow0x05 TableMod.Properties RoundTrip" = + let module GenTableProperties = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.TableMod.Properties) in + (openflow_quickCheck GenTableProperties.arbitrary + GenTableProperties.to_string GenTableProperties.parse GenTableProperties.marshal) + + TEST "OpenFlow0x05 TableMod RoundTrip" = + let module GenTableMod = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.TableMod) in + (openflow_quickCheck GenTableMod.arbitrary + GenTableMod.to_string GenTableMod.parse GenTableMod.marshal) + + TEST "OpenFlow0x05 FlowMod.Command RoundTrip" = + let module GenCommand = Gen0x05.FlowMod.FlowModCommand in + (openflow_quickCheck GenCommand.arbitrary + GenCommand.to_string GenCommand.parse GenCommand.marshal) + + TEST "OpenFlow0x05 FlowMod RoundTrip" = + let module GenFlowMod = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.FlowMod) in + (openflow_quickCheck GenFlowMod.arbitrary + GenFlowMod.to_string GenFlowMod.parse GenFlowMod.marshal) + + TEST "OpenFlow0x05 Bucket RoundTrip" = + let module GenBucket = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.Bucket) in + (openflow_quickCheck GenBucket.arbitrary + GenBucket.to_string GenBucket.parse GenBucket.marshal) + + TEST "OpenFlow0x05 GroupMod RoundTrip" = + let module GenGroupMod = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.GroupMod) in + (openflow_quickCheck GenGroupMod.arbitrary + GenGroupMod.to_string GenGroupMod.parse GenGroupMod.marshal) + + TEST "OpenFlow0x05 PortMod.Properties RoundTrip" = + let module GenProperties = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.PortMod.Properties) in + (openflow_quickCheck GenProperties.arbitrary + GenProperties.to_string GenProperties.parse GenProperties.marshal) + + TEST "OpenFlow0x05 PortMod RoundTrip" = + let module GenPortMod = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.PortMod) in + (openflow_quickCheck GenPortMod.arbitrary + GenPortMod.to_string GenPortMod.parse GenPortMod.marshal) TEST "OpenFlow Hello Test 1" = let open Message in let bs = Cstruct.create 101 in