diff --git a/_oasis b/_oasis index abc1205..0158b3d 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.3 OCamlVersion: >= 4.01.0 Name: openflow -Version: 0.5.0 +Version: 0.6.0 Synopsis: Serialization library for OpenFlow Authors: https://github.com/frenetic-lang/ocaml-openflow/contributors License: LGPL @@ -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/async/Async_OpenFlow.mli b/async/Async_OpenFlow.mli index 0191a4d..eac7aa6 100644 --- a/async/Async_OpenFlow.mli +++ b/async/Async_OpenFlow.mli @@ -151,7 +151,7 @@ module Chunk : sig val set_idle_wait : t -> Time.Span.t -> unit val set_kill_wait : t -> Time.Span.t -> unit - val echo : (t, h, h) Stage.t + val echo : (t, e, e) Stage.t val handshake : int -> (t, e, h) Stage.t end diff --git a/async/Async_OpenFlow0x01.ml b/async/Async_OpenFlow0x01.ml index 0efdb1a..00482bc 100644 --- a/async/Async_OpenFlow0x01.ml +++ b/async/Async_OpenFlow0x01.ml @@ -157,7 +157,7 @@ module Controller = struct let open ChunkController in let stages = (local (fun t -> t.sub) - (handshake 0x01 >=> echo)) + (echo >=> handshake 0x01)) >=> openflow0x01 in run stages t (listen t.sub) end diff --git a/async/Async_OpenFlow0x04.ml b/async/Async_OpenFlow0x04.ml index fe01fda..d45df50 100644 --- a/async/Async_OpenFlow0x04.ml +++ b/async/Async_OpenFlow0x04.ml @@ -71,7 +71,7 @@ module Controller = struct let open ChunkController in let stages = (local (fun t -> t.sub) - (handshake 0x04 >=> echo)) + (echo >=> handshake 0x04)) >=> openflow0x04 in run stages t (listen t.sub) diff --git a/async/Async_OpenFlowChunk.ml b/async/Async_OpenFlowChunk.ml index 57d04f8..ddd11bf 100644 --- a/async/Async_OpenFlowChunk.ml +++ b/async/Async_OpenFlowChunk.ml @@ -33,7 +33,7 @@ module Controller = struct module Conn = struct type t = { - state : [ `Handshake | `Active | `Idle | `Kill ]; + state : [ `Active | `Idle | `Kill ]; version : int option; state_entered : Time.t; last_activity : Time.t @@ -41,7 +41,7 @@ module Controller = struct let create () : t = let now = Time.now () in - { state = `Handshake + { state = `Active ; version = None ; state_entered = now ; last_activity = now @@ -49,10 +49,10 @@ module Controller = struct let activity (t:t) : t = let t = { t with last_activity = Time.now () } in - if t.state = `Active then - t - else + if t.state = `Idle then { t with state = `Active; state_entered = t.last_activity } + else + t let complete_handshake (t:t) (version:int) : t = activity { t with version = Some(version) } @@ -107,7 +107,7 @@ module Controller = struct | None -> assert false | Some(conn) -> Some(Conn.complete_handshake conn version)) - let activity (t:t) ?ver (c_id:Client_id.t) = + let activity (t:t) (c_id:Client_id.t) = ClientTbl.change t.clients c_id (function | None -> assert false | Some(conn) -> Some(Conn.activity conn)) @@ -194,8 +194,8 @@ module Controller = struct let has_client_id t c_id = Platform.has_client_id t.platform c_id && match ClientTbl.find t.clients c_id with - | Some(conn) -> not (conn.Conn.state = `Handshake) - | _ -> false + | Some({ Conn.version = Some(_) }) -> true + | _ -> false let send t c_id m = Platform.send t.platform c_id m @@ -228,7 +228,7 @@ module Controller = struct | `Message (c_id, msg) -> begin match ClientTbl.find t.clients c_id with | None -> assert false - | Some({ Conn.state = `Handshake }) -> + | Some({ Conn.version = None }) -> let hdr, bits = msg in begin if not (hdr.type_code = type_code_hello) then begin @@ -247,7 +247,7 @@ module Controller = struct | `Disconnect (c_id, exn) -> begin match ClientTbl.find t.clients c_id with | None -> assert false - | Some({ Conn.state = `Handshake }) -> + | Some({ Conn.version = None }) -> ClientTbl.remove t.clients c_id; return [] | Some(_) -> @@ -259,6 +259,7 @@ module Controller = struct let open Header in match evt with | `Message (c_id, (hdr, bytes)) -> + Handler.activity t c_id; begin if hdr.Header.type_code = type_code_echo_request then (* Echo requests get a reply *) let hdr = { hdr with type_code = type_code_echo_reply } in @@ -272,7 +273,7 @@ module Controller = struct * *) >>| (function _ -> []) else if hdr.Header.type_code = type_code_echo_reply then - (* Echo replies get eaten *) + (* Echo replies get eaten. The activity has been recorded above. *) return [] else (* All other messages get forwarded *) diff --git a/lib/META b/lib/META index 74b4c90..bc19727 100644 --- a/lib/META +++ b/lib/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: adf89b68ac0ed5e7674e6d8f66515b39) -version = "0.5.0" +# DO NOT EDIT (digest: 70d46b868aee1843635d9d187dfc1041) +version = "0.6.0" description = "Serialization library for OpenFlow" requires = "str cstruct cstruct.syntax packet core sexplib.syntax sexplib threads" @@ -10,7 +10,7 @@ archive(native) = "openflow.cmxa" archive(native, plugin) = "openflow.cmxs" exists_if = "openflow.cma" package "quickcheck" ( - version = "0.5.0" + version = "0.6.0" description = "Serialization library for OpenFlow" requires = "quickcheck openflow packet.quickcheck" archive(byte) = "quickcheck.cma" @@ -21,7 +21,7 @@ package "quickcheck" ( ) package "async" ( - version = "0.5.0" + version = "0.6.0" description = "Serialization library for OpenFlow" requires = "async openflow cstruct.async threads sexplib.syntax sexplib" archive(byte) = "async.cma" diff --git a/lib/OpenFlow0x04.ml b/lib/OpenFlow0x04.ml index 7ae9bc0..65a79f7 100644 --- a/lib/OpenFlow0x04.ml +++ b/lib/OpenFlow0x04.ml @@ -235,20 +235,22 @@ end module PortState = struct - let state_to_int (state : portState) : int32 = + type t = portState + + let state_to_int (state : t) : 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 marshal (ps : t) : int32 = state_to_int ps - let parse bits : portState = + let parse bits : t = { link_down = Bits.test_bit 0 bits; blocked = Bits.test_bit 1 bits; live = Bits.test_bit 2 bits } - let to_string (state : portState) = + let to_string (state : t) = Format.sprintf "{ link_down = %B; blocked = %B; live = %B }" state.link_down state.blocked @@ -372,8 +374,6 @@ cstruct ofp_table_feature_prop_header { uint16_t length } as big_endian -(* MISSING: ofp_ queues *) - cenum ofp_flow_mod_command { OFPFC_ADD = 0; (* New flow. *) OFPFC_MODIFY = 1; (* Modify all matching flows. *) @@ -1116,8 +1116,8 @@ module Oxm = struct let sizeof (oxm : oxm) : int = sizeof_ofp_oxm + field_length oxm - let sizeof_header (oxml : oxm list) : int = - (List.length oxml) * 4 + let sizeof_header (oxml : oxm) : int = + sizeof_ofp_oxm let to_string oxm = match oxm with @@ -2363,6 +2363,7 @@ end module Action = struct type t = action + type sequence = OpenFlow0x04_Core.actionSequence let sizeof (act : t) : int = match act with @@ -4084,17 +4085,17 @@ module TableFeatureProp = struct | TfpApplyActionMiss act -> sum (map ActionHdr.sizeof act) | TfpMatch ox -> - Oxm.sizeof_header ox + sum (map Oxm.sizeof_header ox) | TfpWildcard ox -> - Oxm.sizeof_header ox + sum (map Oxm.sizeof_header ox) | TfpWriteSetField ox-> - Oxm.sizeof_header ox + sum (map Oxm.sizeof_header ox) | TfpWriteSetFieldMiss ox -> - Oxm.sizeof_header ox + sum (map Oxm.sizeof_header ox) | TfpApplySetField ox -> - Oxm.sizeof_header ox + sum (map Oxm.sizeof_header ox) | TfpApplySetFieldMiss ox -> - Oxm.sizeof_header ox + sum (map Oxm.sizeof_header ox) | TfpExperimenter (_,by) -> Cstruct.len by | TfpExperimenterMiss (_,by) -> @@ -4300,11 +4301,11 @@ module TableFeature = struct type t = tableFeatures - let sizeof (tf : tableFeatures) = + let sizeof (tf : t) = (* should be equal to tf.length *) pad_to_64bits (sizeof_ofp_table_features + sum (map TableFeatureProp.sizeof tf.feature_prop)) - let marshal (buf : Cstruct.t) (tf : tableFeatures) : int = + let marshal (buf : Cstruct.t) (tf : t) : int = set_ofp_table_features_length buf tf.length; set_ofp_table_features_table_id buf tf.table_id; set_ofp_table_features_pad (Cstruct.to_string (Cstruct.create 5)) 0 buf; @@ -4316,7 +4317,7 @@ module TableFeature = struct sizeof_ofp_table_features + ( marshal_fields (Cstruct.shift buf sizeof_ofp_table_features) tf.feature_prop TableFeatureProp.marshal) - let parse (bits : Cstruct.t) : tableFeatures*Cstruct.t = + let parse (bits : Cstruct.t) : t = let length = get_ofp_table_features_length bits in let tableId = get_ofp_table_features_table_id bits in let name = Cstruct.to_string (get_ofp_table_features_name bits) in @@ -4332,9 +4333,9 @@ module TableFeature = struct metadata_write = metadataWrite; config = config; max_entries = maxEntries; - feature_prop = featureProp},(Cstruct.shift bits length) + feature_prop = featureProp} - let to_string (tf : tableFeatures) = + let to_string (tf : t) = Format.sprintf "{ table_id = %u; name = %s; metadata_match = %Lu; \ metadata_write = %Lu; config = %s; max_entries = %lu; feature_prop = %s }" @@ -4346,35 +4347,9 @@ module TableFeature = struct tf.max_entries ("[ " ^ (String.concat "; " (map TableFeatureProp.to_string tf.feature_prop)) ^ " ]") -end - -module TableFeatures = struct - - type t = tableFeatures list - - let sizeof (tfr : tableFeatures list) = - sum (map TableFeature.sizeof tfr) - - let marshal (buf : Cstruct.t) (tfr : tableFeatures list) = - marshal_fields buf tfr TableFeature.marshal - - - let rec parse_fields (bits : Cstruct.t) len cumul : tableFeatures list*Cstruct.t = - if len = cumul then [],bits - else ( - let field,nextBits = TableFeature.parse bits in - let fields,bits3 = parse_fields nextBits len (cumul + (TableFeature.sizeof field)) in - (List.append [field] fields,bits3) - ) - - let parse (bits : Cstruct.t) : tableFeatures list = - let length = Cstruct.len bits in - let body,_ = parse_fields bits length 0 in - body - - let to_string tfr = - "[ " ^ (String.concat "\n" (map TableFeature.to_string tfr)) ^ " ]" - + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_table_features then None + else Some (get_ofp_table_features_length buf) end module MultipartReq = struct @@ -4425,7 +4400,7 @@ module MultipartReq = struct | MeterStatsReq _ | MeterConfReq _ -> sizeof_ofp_meter_multipart_request | TableFeatReq tfr -> (match tfr with | None -> 0 - | Some t -> TableFeatures.sizeof t) + | Some t -> sum (map TableFeature.sizeof t)) | ExperimentReq _ -> sizeof_ofp_experimenter_multipart_header) let to_string (mpr : multipartRequest) : string = @@ -4450,7 +4425,7 @@ module MultipartReq = struct | MeterConfReq m -> Format.sprintf "MeterConf Req %lu" m | MeterFeatReq -> "MeterFeat Req" | TableFeatReq t-> Format.sprintf "TableFeat Req %s" (match t with - | Some v -> TableFeatures.to_string v + | Some v -> "[ " ^ (String.concat "; " (map TableFeature.to_string v)) ^ " ]" | None -> "None" ) | ExperimentReq e-> Format.sprintf "Experimenter Req: id: %lu; type: %lu" e.exp_id e.exp_type) @@ -4487,7 +4462,7 @@ module MultipartReq = struct | TableFeatReq t -> (match t with | None -> 0 - | Some v -> size + (TableFeatures.marshal pay_buf v)) + | Some v -> size + marshal_fields pay_buf v TableFeature.marshal) | ExperimentReq _ -> size let parse (bits : Cstruct.t) : multipartRequest = @@ -4520,7 +4495,7 @@ module MultipartReq = struct | Some OFPMP_TABLE_FEATURES -> TableFeatReq ( if Cstruct.len bits <= sizeof_ofp_multipart_request then None else Some ( - TableFeatures.parse (Cstruct.shift bits sizeof_ofp_multipart_request) + parse_fields (Cstruct.shift bits sizeof_ofp_multipart_request) TableFeature.parse TableFeature.length_func )) | Some OFPMP_EXPERIMENTER -> ExperimentReq ( let exp_bits = Cstruct.shift bits sizeof_ofp_multipart_request in @@ -5310,7 +5285,7 @@ module MeterConfig = struct end -module MeterFeaturesStats = struct +module MeterFeatures = struct cstruct ofp_meter_features { uint32_t max_meter; @@ -5339,12 +5314,12 @@ module MeterFeaturesStats = struct end - type t = meterFeaturesStats + type t = meterFeatures - let sizeof (mfs : meterFeaturesStats) : int = + let sizeof (mfs : t) : int = sizeof_ofp_meter_features - let to_string (mfs : meterFeaturesStats) : string = + let to_string (mfs : t) : string = Format.sprintf "{ max_meter = %lu; band_typ = %s; capabilities = %s; max_band = %u; max_color = %u }" mfs.max_meter (Bands.to_string mfs.band_typ) @@ -5352,7 +5327,7 @@ module MeterFeaturesStats = struct mfs.max_band mfs.max_color - let marshal (buf : Cstruct.t) (mfs : meterFeaturesStats) : int = + let marshal (buf : Cstruct.t) (mfs : t) : int = set_ofp_meter_features_max_meter buf mfs.max_meter; set_ofp_meter_features_band_types buf (Bands.marshal mfs.band_typ); (* int -> int32 fix, before release of OF1.3.5 *) @@ -5361,7 +5336,7 @@ module MeterFeaturesStats = struct set_ofp_meter_features_max_color buf mfs.max_color; sizeof_ofp_meter_features - let parse (bits : Cstruct.t) : meterFeaturesStats = + let parse (bits : Cstruct.t) : t = { max_meter = get_ofp_meter_features_max_meter bits ; band_typ = Bands.parse (get_ofp_meter_features_band_types bits) (* int32 -> int fix, before release of OF1.3.5 *) @@ -5383,7 +5358,7 @@ module MultipartReply = struct | FlowStatsReply fsr -> sum (map FlowStats.sizeof fsr) | AggregateReply ag -> AggregateStats.sizeof ag | TableReply tr -> sum (map TableStats.sizeof tr) - | TableFeaturesReply tf -> TableFeatures.sizeof tf + | TableFeaturesReply tf -> sum (map TableFeature.sizeof tf) | PortStatsReply psr -> sum (map PortStats.sizeof psr) | QueueStatsReply qsr -> sum (map QueueStats.sizeof qsr) | GroupStatsReply gs -> sum (map GroupStats.sizeof gs) @@ -5391,7 +5366,7 @@ module MultipartReply = struct | GroupFeaturesReply gf -> GroupFeatures.sizeof gf | MeterReply mr -> sum (map MeterStats.sizeof mr) | MeterConfig mc -> sum (map MeterConfig.sizeof mc) - | MeterFeaturesReply mf -> MeterFeaturesStats.sizeof mf + | MeterFeaturesReply mf -> MeterFeatures.sizeof mf let to_string (mpr : multipartReply) = match mpr.mpreply_typ with @@ -5400,7 +5375,7 @@ module MultipartReply = struct | FlowStatsReply fsr -> Format.sprintf "Flow { %s }" (String.concat "; " (map FlowStats.to_string fsr)) | AggregateReply ag -> Format.sprintf "Aggregate Flow %s" (AggregateStats.to_string ag) | TableReply tr -> Format.sprintf "TableReply { %s }" (String.concat "; " (map TableStats.to_string tr)) - | TableFeaturesReply tf -> Format.sprintf "TableFeaturesReply %s" (TableFeatures.to_string tf) + | TableFeaturesReply tf -> Format.sprintf "TableFeaturesReply { %s }" (String.concat "; " (map TableFeature.to_string tf)) | PortStatsReply psr -> Format.sprintf "PortStatsReply { %s }" (String.concat "; " (map PortStats.to_string psr)) | QueueStatsReply qsr -> Format.sprintf "QueueStats { %s }" (String.concat "; " (map QueueStats.to_string qsr)) | GroupStatsReply gs -> Format.sprintf "GroupStats { %s }" (String.concat "; " (map GroupStats.to_string gs)) @@ -5408,7 +5383,7 @@ module MultipartReply = struct | GroupFeaturesReply gf -> Format.sprintf "GroupFeatures %s" (GroupFeatures.to_string gf) | MeterReply mr -> Format.sprintf "MeterStats { %s }" (String.concat "; " (map MeterStats.to_string mr)) | MeterConfig mc -> Format.sprintf "MeterConfig { %s }" (String.concat "; " (map MeterConfig.to_string mc)) - | MeterFeaturesReply mf -> Format.sprintf "MeterFeaturesStats %s" (MeterFeaturesStats.to_string mf) + | MeterFeaturesReply mf -> Format.sprintf "MeterFeaturesStats %s" (MeterFeatures.to_string mf) let marshal (buf : Cstruct.t) (mpr : multipartReply) : int = let ofp_body_bits = Cstruct.shift buf sizeof_ofp_multipart_reply in @@ -5434,7 +5409,7 @@ module MultipartReply = struct marshal_fields ofp_body_bits tr TableStats.marshal | TableFeaturesReply tf -> set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_TABLE_FEATURES); - TableFeatures.marshal ofp_body_bits tf + marshal_fields ofp_body_bits tf TableFeature.marshal | PortStatsReply psr -> set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_PORT_STATS); marshal_fields ofp_body_bits psr PortStats.marshal @@ -5458,7 +5433,7 @@ module MultipartReply = struct marshal_fields ofp_body_bits mc MeterConfig.marshal | MeterFeaturesReply mfr -> set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_METER_FEATURES); - MeterFeaturesStats.marshal ofp_body_bits mfr + MeterFeatures.marshal ofp_body_bits mfr ) let parse (bits : Cstruct.t) : multipartReply = @@ -5475,7 +5450,7 @@ module MultipartReply = struct | Some OFPMP_TABLE -> TableReply (parse_fields ofp_body_bits TableStats.parse TableStats.length_func) | Some OFPMP_TABLE_FEATURES -> - TableFeaturesReply (TableFeatures.parse ofp_body_bits) + TableFeaturesReply (parse_fields ofp_body_bits TableFeature.parse TableFeature.length_func) | Some OFPMP_PORT_STATS -> PortStatsReply (parse_fields ofp_body_bits PortStats.parse PortStats.length_func) | Some OFPMP_QUEUE -> @@ -5491,7 +5466,7 @@ module MultipartReply = struct | Some OFPMP_METER_CONFIG -> MeterConfig (parse_fields ofp_body_bits MeterConfig.parse MeterConfig.length_func) | Some OFPMP_METER_FEATURES -> - MeterFeaturesReply (MeterFeaturesStats.parse ofp_body_bits) + MeterFeaturesReply (MeterFeatures.parse ofp_body_bits) | _ -> raise (Unparsable (sprintf "NYI: can't parse this multipart reply"))) in let flags = ( match int_to_ofp_multipart_request_flags (get_ofp_multipart_request_flags bits) with @@ -5601,6 +5576,8 @@ module RoleRequest = struct OFPCR_ROLE_SLAVE = 3 } as uint32_t + type t = controllerRole + let to_string (role : controllerRole) : string = match role with | NoChangeRole -> "NOCHANGE" @@ -6662,6 +6639,75 @@ end module AsyncConfig = struct + module PacketIn = struct + type t = packetInReasonMap + + let to_string (t : t) = + Format.sprintf "{ table_miss = %B; apply_action = %B; invalid_ttl = %B }" + t.table_miss + t.apply_action + t.invalid_ttl + + let marshal (t : t) : int8 = + (if t.table_miss then 1 lsl 0 else 0) lor + (if t.apply_action then 1 lsl 1 else 0) lor + (if t.invalid_ttl then 1 lsl 2 else 0) + + let parse bits : t = + { table_miss = test_bit16 0 bits + ; apply_action = test_bit16 1 bits + ; invalid_ttl = test_bit16 2 bits} + + end + + module PortStatus = struct + + type t = portReasonMap + + let to_string (t : t) = + Format.sprintf "{ add = %B; delete = %B; modify = %B }" + t.add + t.delete + t.modify + + let marshal (t : t) : int8 = + (if t.add then 1 lsl 0 else 0) lor + (if t.delete then 1 lsl 1 else 0) lor + (if t.modify then 1 lsl 2 else 0) + + let parse bits : t = + { add = test_bit16 0 bits + ; delete = test_bit16 1 bits + ; modify = test_bit16 2 bits } + + end + + module FlowRemoved = struct + + type t = flowReasonMask + + let to_string (t : t) = + Format.sprintf "{ idle_timeout = %B; hard_timeout = %B; delete = %B; \ + group_delete = %B }" + t.idle_timeout + t.hard_timeout + t.delete + t.group_delete + + let marshal (t : t) : int8 = + (if t.idle_timeout then 1 lsl 0 else 0) lor + (if t.hard_timeout then 1 lsl 1 else 0) lor + (if t.delete then 1 lsl 2 else 0) lor + (if t.group_delete then 1 lsl 3 else 0) + + let parse bits : t = + { idle_timeout = test_bit16 0 bits + ; hard_timeout = test_bit16 1 bits + ; delete = test_bit16 2 bits + ; group_delete = test_bit16 3 bits } + + end + cstruct ofp_async_config { uint32_t packet_in_mask0; uint32_t packet_in_mask1; @@ -6680,29 +6726,29 @@ module AsyncConfig = struct Format.sprintf "{ packet_in reason (master/slave) = %s/%s; \ port_status reason (master/slave) = %s/%s; \ flow_removed reason (master/slave) = %s/%s }" - (PacketIn.Reason.to_string async.packet_in.m_master) - (PacketIn.Reason.to_string async.packet_in.m_slave) - (PortStatus.Reason.to_string async.port_status.m_master) - (PortStatus.Reason.to_string async.port_status.m_slave) - (FlowRemoved.RemovedReason.to_string async.flow_removed.m_master) - (FlowRemoved.RemovedReason.to_string async.flow_removed.m_slave) + (PacketIn.to_string async.packet_in.m_master) + (PacketIn.to_string async.packet_in.m_slave) + (PortStatus.to_string async.port_status.m_master) + (PortStatus.to_string async.port_status.m_slave) + (FlowRemoved.to_string async.flow_removed.m_master) + (FlowRemoved.to_string async.flow_removed.m_slave) let marshal (buf : Cstruct.t) (async : asyncConfig) : int = - set_ofp_async_config_packet_in_mask0 buf (Int32.of_int (PacketIn.Reason.marshal async.packet_in.m_master)); - set_ofp_async_config_packet_in_mask1 buf (Int32.of_int (PacketIn.Reason.marshal async.packet_in.m_slave)); - set_ofp_async_config_port_status_mask0 buf (Int32.of_int (PortStatus.Reason.marshal async.port_status.m_master)); - set_ofp_async_config_port_status_mask1 buf (Int32.of_int (PortStatus.Reason.marshal async.port_status.m_slave)); - set_ofp_async_config_flow_removed_mask0 buf (Int32.of_int (FlowRemoved.RemovedReason.marshal async.flow_removed.m_master)); - set_ofp_async_config_flow_removed_mask1 buf (Int32.of_int (FlowRemoved.RemovedReason.marshal async.flow_removed.m_slave)); + set_ofp_async_config_packet_in_mask0 buf (Int32.of_int (PacketIn.marshal async.packet_in.m_master)); + set_ofp_async_config_packet_in_mask1 buf (Int32.of_int (PacketIn.marshal async.packet_in.m_slave)); + set_ofp_async_config_port_status_mask0 buf (Int32.of_int (PortStatus.marshal async.port_status.m_master)); + set_ofp_async_config_port_status_mask1 buf (Int32.of_int (PortStatus.marshal async.port_status.m_slave)); + set_ofp_async_config_flow_removed_mask0 buf (Int32.of_int (FlowRemoved.marshal async.flow_removed.m_master)); + set_ofp_async_config_flow_removed_mask1 buf (Int32.of_int (FlowRemoved.marshal async.flow_removed.m_slave)); sizeof_ofp_async_config let parse (bits : Cstruct.t) : asyncConfig = - let packet_in = { m_master = PacketIn.Reason.parse (Int32.to_int (get_ofp_async_config_packet_in_mask0 bits)); - m_slave = PacketIn.Reason.parse (Int32.to_int (get_ofp_async_config_packet_in_mask1 bits))} in - let port_status = { m_master = PortStatus.Reason.parse (Int32.to_int (get_ofp_async_config_port_status_mask0 bits)); - m_slave = PortStatus.Reason.parse (Int32.to_int (get_ofp_async_config_port_status_mask1 bits))} in - let flow_removed = { m_master = FlowRemoved.RemovedReason.parse (Int32.to_int (get_ofp_async_config_flow_removed_mask0 bits)); - m_slave = FlowRemoved.RemovedReason.parse (Int32.to_int (get_ofp_async_config_flow_removed_mask1 bits))} in + let packet_in = { m_master = PacketIn.parse (Int32.to_int (get_ofp_async_config_packet_in_mask0 bits)); + m_slave = PacketIn.parse (Int32.to_int (get_ofp_async_config_packet_in_mask1 bits))} in + let port_status = { m_master = PortStatus.parse (Int32.to_int (get_ofp_async_config_port_status_mask0 bits)); + m_slave = PortStatus.parse (Int32.to_int (get_ofp_async_config_port_status_mask1 bits))} in + let flow_removed = { m_master = FlowRemoved.parse (Int32.to_int (get_ofp_async_config_flow_removed_mask0 bits)); + m_slave = FlowRemoved.parse (Int32.to_int (get_ofp_async_config_flow_removed_mask1 bits))} in { packet_in; port_status; flow_removed } end @@ -6715,14 +6761,14 @@ module Message = struct | EchoReply of bytes | FeaturesRequest | FeaturesReply of SwitchFeatures.t - | FlowModMsg of flowMod + | FlowModMsg of FlowMod.t | GroupModMsg of GroupMod.t - | PortModMsg of portMod - | MeterModMsg of meterMod - | PacketInMsg of packetIn - | FlowRemoved of flowRemoved - | PacketOutMsg of packetOut - | PortStatusMsg of portStatus + | PortModMsg of PortMod.t + | MeterModMsg of MeterMod.t + | PacketInMsg of PacketIn.t + | FlowRemoved of FlowRemoved.t + | PacketOutMsg of PacketOut.t + | PortStatusMsg of PortStatus.t | MultipartReq of MultipartReq.t | MultipartReply of MultipartReply.t | BarrierRequest @@ -6734,10 +6780,10 @@ module Message = struct | GetConfigRequestMsg | GetConfigReplyMsg of SwitchConfig.t | SetConfigMsg of SwitchConfig.t - | TableModMsg of tableMod + | TableModMsg of TableMod.t | GetAsyncRequest - | GetAsyncReply of asyncConfig - | SetAsync of asyncConfig + | GetAsyncReply of AsyncConfig.t + | SetAsync of AsyncConfig.t | Error of Error.t @@ -6811,7 +6857,7 @@ module Message = struct | EchoRequest bytes -> Header.size + (String.length (Cstruct.to_string bytes)) | EchoReply bytes -> Header.size + (String.length (Cstruct.to_string bytes)) | FeaturesRequest -> Header.size - | FeaturesReply _ -> Header.size + sizeof_ofp_switch_features + | FeaturesReply f -> Header.size + SwitchFeatures.sizeof f | FlowModMsg fm -> Header.size + FlowMod.sizeof fm | GroupModMsg gm -> Header.size + GroupMod.sizeof gm | PortModMsg pm -> Header.size + PortMod.sizeof pm @@ -6819,7 +6865,7 @@ module Message = struct | PacketInMsg pi -> Header.size + PacketIn.sizeof pi | FlowRemoved fr -> Header.size + FlowRemoved.sizeof fr | PacketOutMsg po -> Header.size + PacketOut.sizeof po - | PortStatusMsg _ -> Header.size + sizeof_ofp_port_status + sizeof_ofp_port + | PortStatusMsg p -> Header.size + PortStatus.sizeof p | MultipartReq req -> Header.size + MultipartReq.sizeof req | MultipartReply rep -> Header.size + MultipartReply.sizeof rep | QueueGetConfigReq qc -> Header.size + QueueConfReq.sizeof qc @@ -6838,35 +6884,35 @@ module Message = struct | RoleReply rr -> Header.size + RoleRequest.sizeof rr let to_string (msg : t) : string = match msg with - | Hello _ -> "Hello" - | Error _ -> "Error" + | Hello hello -> Format.sprintf "Hello = %s" (Hello.to_string hello) + | Error error -> Format.sprintf "Error = %s" (Error.to_string error) | EchoRequest _ -> "EchoRequest" | EchoReply _ -> "EchoReply" | FeaturesRequest -> "FeaturesRequest" - | FeaturesReply _ -> "FeaturesReply" - | FlowModMsg _ -> "FlowMod" - | GroupModMsg _ -> "GroupMod" - | PortModMsg _ -> "PortMod" - | MeterModMsg _ -> "MeterMod" - | PacketInMsg _ -> "PacketIn" - | FlowRemoved _ -> "FlowRemoved" - | PacketOutMsg _ -> "PacketOut" - | PortStatusMsg _ -> "PortStatus" - | MultipartReq _ -> "MultipartRequest" - | MultipartReply _ -> "MultipartReply" + | FeaturesReply features -> Format.sprintf "FeaturesReply = %s" (SwitchFeatures.to_string features) + | FlowModMsg flow -> Format.sprintf "FlowMod = %s" (FlowMod.to_string flow) + | GroupModMsg group -> Format.sprintf "GroupMod = %s" (GroupMod.to_string group) + | PortModMsg port -> Format.sprintf "PortMod = %s" (PortMod.to_string port) + | MeterModMsg meter -> Format.sprintf "MeterMod = %s" (MeterMod.to_string meter) + | PacketInMsg packet -> Format.sprintf "PacketIn = %s" (PacketIn.to_string packet) + | FlowRemoved flow -> Format.sprintf "FlowRemoved = %s" (FlowRemoved.to_string flow) + | PacketOutMsg packet -> Format.sprintf "PacketOut = %s" (PacketOut.to_string packet) + | PortStatusMsg port -> Format.sprintf "PortStatus = %s" (PortStatus.to_string port) + | MultipartReq mult -> Format.sprintf "MultipartRequest = %s" (MultipartReq.to_string mult) + | MultipartReply mult -> Format.sprintf "MultipartReply = %s" (MultipartReply.to_string mult) | BarrierRequest -> "BarrierRequest" | BarrierReply -> "BarrierReply" - | RoleRequest _ -> "RoleRequest" - | RoleReply _ -> "RoleReply" - | QueueGetConfigReq _ -> "QueueGetConfigReq" - | QueueGetConfigReply _ -> "QueueGetConfigReply" + | RoleRequest role -> Format.sprintf "RoleRequest = %s" (RoleRequest.to_string role) + | RoleReply role -> Format.sprintf "RoleReply = %s" (RoleRequest.to_string role) + | QueueGetConfigReq queue -> Format.sprintf "QueueGetConfigReq = %s" (QueueConfReq.to_string queue) + | QueueGetConfigReply queue -> Format.sprintf "QueueGetConfigReply = %s" (QueueConfReply.to_string queue) | GetConfigRequestMsg -> "GetConfigRequest" - | GetConfigReplyMsg _ -> "GetConfigReply" - | SetConfigMsg _ -> "SetConfig" - | TableModMsg _ -> "TableMod" + | GetConfigReplyMsg conf -> Format.sprintf "GetConfigReply = %s" (SwitchConfig.to_string conf) + | SetConfigMsg conf -> Format.sprintf "SetConfig = %s" (SwitchConfig.to_string conf) + | TableModMsg table -> Format.sprintf "TableMod = %s" (TableMod.to_string table) | GetAsyncRequest -> "GetAsyncRequest" - | GetAsyncReply _ -> "GetAsyncReply" - | SetAsync _ -> "SetAsync" + | GetAsyncReply async -> Format.sprintf "GetAsyncReply = %s" (AsyncConfig.to_string async) + | SetAsync async -> Format.sprintf "SetAsync = %s" (AsyncConfig.to_string async) (* let marshal (buf : Cstruct.t) (msg : message) : int = *) (* let buf2 = (Cstruct.shift buf Header.size) in *) diff --git a/lib/OpenFlow0x04.mli b/lib/OpenFlow0x04.mli index efb2495..89a1515 100644 --- a/lib/OpenFlow0x04.mli +++ b/lib/OpenFlow0x04.mli @@ -11,6 +11,7 @@ type msg_code = | HELLO | ERROR | ECHO_REQ | ECHO_RESP | VENDOR | FEATURES_REQ val msg_code_to_int : msg_code -> int +(** See the [ofp_port_config] enumeration in section 7.2.1 of the OpenFlow 1.3.4 specification *) module PortConfig : sig type t = portConfig @@ -19,9 +20,12 @@ module PortConfig : sig val parse : int32 -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string + end +(** See the [ofp_port_features] enumeration in section 7.2.1 of the OpenFlow 1.3.4 specification *) module PortFeatures : sig type t = portFeatures @@ -30,28 +34,37 @@ module PortFeatures : sig val parse : int32 -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** Flow Match Fields structure. See the section 7.2.3.2 of the OpenFlow 1.3.4 specification *) module Oxm : sig type t = oxm val field_name : t -> string + (** [sizeof t] size of the oxm field *) val sizeof : t -> int - val sizeof_header : t list -> int + (** [sizeof_header t] size of the oxm field without the payload *) + val sizeof_header : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string + (** [marshal buf t] serializes [t] *) val marshal : Cstruct.t -> t -> int + (** [marshal_header buf t] same as [marshal] but doesn't serialize the payload *) val marshal_header : Cstruct.t -> t -> int + (** [parse bits] parse the buffer [bits] *) val parse : Cstruct.t -> t * Cstruct.t + (** [parse_header bits] same as [parse] but doesn't parse the payload *) val parse_header : Cstruct.t -> t * Cstruct.t end @@ -62,6 +75,7 @@ module PseudoPort : sig val size_of : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : t -> int32 @@ -70,14 +84,17 @@ module PseudoPort : sig end +(** Queue Description structure. See the section 7.2.2 of the OpenFlow 1.3.4 specification *) module QueueDesc : sig + (** Queue Property Description structure. See the 7.2.2 of the OpenFlow 1.3.4 specification *) module QueueProp : sig type t = queueProp val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -90,6 +107,7 @@ module QueueDesc : sig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -98,12 +116,14 @@ module QueueDesc : sig end +(** Switch Configuration structure. See the section 7.3.2 of the OpenFlow 1.3.4 specification *) module SwitchConfig : sig type t = switchConfig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -112,6 +132,7 @@ module SwitchConfig : sig end +(** Flow Match structure. See the section 7.2.3.1 of the OpenFlow 1.3.4 specification *) module OfpMatch : sig type t = oxmMatch @@ -122,12 +143,16 @@ module OfpMatch : sig val parse : Cstruct.t -> t * Cstruct.t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string + end +(** Action structure. See the section 7.2.5 of the OpenFlow 1.3.4 specification *) module Action : sig type t = action + type sequence = OpenFlow0x04_Core.actionSequence val sizeof : t -> int @@ -138,23 +163,28 @@ module Action : sig val parse_sequence : Cstruct.t -> sequence + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** Bucket structure for use in groups. See the section 7.3.4.2 of OpenFlow 1.3.4 specification *) module Bucket : sig type t = bucket val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t + end +(** Modify Flow message structure. See the section 7.3.4.1 of the OpenFlow 1.3.4 specification *) module FlowModCommand : sig type t = flowModCommand @@ -165,14 +195,17 @@ module FlowModCommand : sig val parse : int -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** See the [ofp_group_type] enumeration in section 7.3.4.2 of the OpenFlow 1.3.4 specification *) module GroupType : sig type t = groupType + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : t -> int @@ -181,12 +214,14 @@ module GroupType : sig end +(** Modify Group message structure. See the section 7.3.4.2 of the OpenFlow 1.3.4 specification *) module GroupMod : sig type t = groupMod val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -195,12 +230,14 @@ module GroupMod : sig end +(** Modify Port message structure. See the section 7.3.4.3 of the OpenFlow 1.3.4 specification *) module PortMod : sig type t = portMod val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -209,12 +246,14 @@ module PortMod : sig end +(** Modify Meter message structure. See the section 7.3.4.4 of the OpenFlow 1.3.4 specification *) module MeterMod : sig type t = meterMod val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -223,6 +262,7 @@ module MeterMod : sig end +(** Flow Instruction structure. See the section 7.2.4 of the OpenFlow 1.3.4 specification *) module Instruction : sig type t = instruction @@ -230,8 +270,10 @@ module Instruction : sig val sizeof : t -> int val marshal : Cstruct.t -> t -> int + val parse : Cstruct.t -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end @@ -243,12 +285,15 @@ module Instructions : sig val sizeof : t -> int val marshal : Cstruct.t -> t -> int + val parse : Cstruct.t -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** Modify flow message structure. See the section 7.3.4.1 of the OpenFlow 1.3.4 specification *) module FlowMod : sig type t = flowMod @@ -259,20 +304,26 @@ module FlowMod : sig val parse : Cstruct.t -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** See the [ofp_capabilities] enumeration in section 7.3.1 of OpenFlow 1.3.4 specification *) module Capabilities : sig type t = capabilities + (** [to_string v] pretty-prints [v] *) val to_string : t -> string + val to_int32 : t -> int32 + val parse : int32 -> t end +(** Switch Features structure. See the section 7.3.1 of the OpenFlow 1.3.4 specification *) module SwitchFeatures : sig type t = { datapath_id : int64; num_buffers : int32; @@ -281,6 +332,7 @@ module SwitchFeatures : sig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -289,46 +341,61 @@ module SwitchFeatures : sig end - +(** See the [ofp_port_state] enumeration in section 7.2.1 of the OpenFlow 1.3.4 specification *) module PortState : sig + type t = portState + val marshal : portState -> int32 val parse : int32 -> portState + (** [to_string v] pretty-prints [v] *) val to_string : portState -> string end +(** Description of a port structure. See the section 7.3.1 of the OpenFlow 1.3.4 specification *) module PortDesc : sig - val sizeof : portDesc -> int + type t = portDesc + + val sizeof : t -> int - val marshal : Cstruct.t -> portDesc -> int + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t - val parse : Cstruct.t -> portDesc + (** [to_string v] pretty-prints [v] *) + val to_string : t -> string - val to_string : portDesc -> string end +(** Port Status structure. See the section 7.4.3 of the OpenFlow 1.3.4 specification *) module PortStatus : sig - val sizeof : portStatus -> int + type t = portStatus - val marshal : Cstruct.t -> portStatus -> int + val sizeof : t -> int - val parse : Cstruct.t -> portStatus + val marshal : Cstruct.t -> t -> int - val to_string : portStatus -> string + val parse : Cstruct.t -> t + + (** [to_string v] pretty-prints [v] *) + val to_string : t -> string end +(** Packet received by the datapath and sent to the controller structure. See the section + 7.4.1 of the OpenFlow 1.3.4 specification *) module PacketIn : sig type t = packetIn val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -337,24 +404,30 @@ module PacketIn : sig end +(** Packet send out of the datapath structure. See the section 7.3.7 of the OpenFlow 1.3.4 specification *) module PacketOut : sig type t = packetOut val sizeof : t -> int + + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int + val parse : Cstruct.t -> t end +(** Meter bands structure. See the section 7.3.4.4 of the OpenFlow 1.3.4 specification *) module MeterBand : sig type t = meterBand val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -363,12 +436,14 @@ module MeterBand : sig end +(** Flow Removed structure. See the section 7.4.2 of the OpenFlow 1.3.4 specification *) module FlowRemoved : sig type t = flowRemoved val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -377,12 +452,15 @@ module FlowRemoved : sig end +(** Flow Statistics request structure. See the section 7.3.5.2 of the OpenFlow 1.3.4 specification + this structure is the same for indidual and aggregate flow request *) module FlowRequest : sig type t = flowRequest val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -391,6 +469,7 @@ module FlowRequest : sig end +(** Queue Statistics request structure. See the section 7.3.5.8 of the OpenFlow 1.3.4 specification *) module QueueRequest : sig type t = queueRequest @@ -399,12 +478,14 @@ module QueueRequest : sig val parse : Cstruct.t -> t + (** [to_string v] pretty-prints [v] *) val sizeof : t -> int val to_string : t -> string end +(** Table Features property structure. See the section 7.3.5.5.2 of the OpenFlow 1.3.4 specification *) module TableFeatureProp : sig type t = tableFeatureProp @@ -415,10 +496,12 @@ module TableFeatureProp : sig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** Table Feature structure. See the section 7.3.5.5.1 of the OpenFlow 1.3.4 specification *) module TableFeature : sig type t = tableFeatures @@ -427,32 +510,23 @@ module TableFeature : sig val marshal : Cstruct.t -> t -> int - val parse : Cstruct.t -> t * Cstruct.t - - val to_string : t -> string - -end - -module TableFeatures : sig - - type t = tableFeatures list - - val sizeof : t -> int - - val marshal : Cstruct.t -> t -> int - val parse : Cstruct.t -> t + (** [to_string v] pretty-prints [v] *) val to_string : t -> string + val length_func : Cstruct.t -> int option + end +(** Multipart request message structure. See the section 7.3.5 of the OpenFlow 1.3.4 specification *) module MultipartReq : sig type t = multipartRequest val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -461,14 +535,17 @@ module MultipartReq : sig end +(** Group statistics structure. See the section 7.3.5.9 of the OpenFlow 1.3.4 specification *) module GroupStats : sig + (** Bucket statistics structure. See the section 7.3.5.9 of the OpenFlow 1.3.4 specification *) module BucketStats : sig type t = bucketStats val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -481,19 +558,25 @@ module GroupStats : sig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + end +(** Switch Description structure. See the section 7.3.5.1 of the OpenFlow 1.3.4 specification *) module SwitchDescriptionReply : sig type t = switchDesc val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -502,28 +585,32 @@ module SwitchDescriptionReply : sig end - +(** Individual Flow Statistics structure. See the section 7.3.5.2 of the OpenFlow 1.3.4 specification *) module FlowStats : sig type t = flowStats val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t -end + val length_func : Cstruct.t -> int option +end +(** Aggregate Flow Statistics structure. See the section 7.3.5.3 of the OpenFlow 1.3.4 specification *) module AggregateStats : sig type t = aggregStats val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -532,26 +619,32 @@ module AggregateStats : sig end +(** Table Statistics structure. See the section 7.3.5.4 of the OpenFlow 1.3.4 specification *) module TableStats : sig type t = tableStats val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t + val length_func : Cstruct.t -> int option + end +(** Port Statistics structure. See the section 7.3.5.6 of the OpenFlow 1.3.4 specification *) module PortStats : sig type t = portStats val sizeof : t-> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -560,12 +653,14 @@ module PortStats : sig end +(** Queue Statistics structure. See the section 7.3.5.8 of the OpenFlow 1.3.4 specification *) module QueueStats : sig type t = queueStats val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -574,26 +669,32 @@ module QueueStats : sig end +(** Group Description structure. See the section 7.3.5.10 of the OpenFlow 1.3.4 specification *) module GroupDesc : sig type t = groupDesc val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t + val length_func : Cstruct.t -> int option + end +(** Group Features structure. See the section 7.3.5.10 of the OpenFlow 1.3.4 specification *) module GroupFeatures : sig type t = groupFeatures val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -602,41 +703,50 @@ module GroupFeatures : sig end +(** Meter Statistics structure. See the section 7.3.5.12 of the OpenFlow 1.3.4 specification *) module MeterStats : sig type t = meterStats val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t + val length_func : Cstruct.t -> int option + end +(** Meter Configuration structure. See the section 7.3.5.13 of the OpenFlow 1.3.4 specification *) module MeterConfig : sig type t = meterConfig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int val parse : Cstruct.t -> t -end + val length_func : Cstruct.t -> int option +end -module MeterFeaturesStats : sig +(** Meter Features structure. See the section 7.3.5.14 of the OpenFlow 1.3.4 specification *) +module MeterFeatures : sig - type t = meterFeaturesStats + type t = meterFeatures val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -645,12 +755,14 @@ module MeterFeaturesStats : sig end +(** Multipart reply message structure. See the section 7.3.5 of the OpenFlow 1.3.4 specification *) module MultipartReply : sig type t = multipartReply val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -659,12 +771,14 @@ module MultipartReply : sig end +(** Modify Table message structure. See the section 7.3.3 of the OpenFlow 1.3.4 specification *) module TableMod : sig type t = tableMod val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -673,12 +787,14 @@ module TableMod : sig end +(** Queue Configuration request message structure. See the section 7.3.6 of the OpenFlow 1.3.4 specification *) module QueueConfReq : sig type t = queueConfReq val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -687,12 +803,14 @@ module QueueConfReq : sig end +(** Queue Configuration respond message structure. See the section 7.3.6 of the OpenFlow 1.3.4 specification *) module QueueConfReply : sig type t = queueConfReply val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -701,6 +819,7 @@ module QueueConfReply : sig end +(** Error message structure. See the section 7.4.4 of the OpenFlow 1.3.4 specification *) module Error : sig type t = { @@ -709,18 +828,36 @@ module Error : sig } val marshal : Cstruct.t -> t -> int + val parse : Cstruct.t -> t + val sizeof : t -> int + + (** [to_string v] pretty-prints [v] *) val to_string : t -> string end +(** Role Request message structure. See the section 7.3.9 of OpenFlow 1.3.4 specification *) module RoleRequest : sig + module Role : sig + + type t = controllerRole + + val to_string : t -> string + + val marshal : t -> int32 + + val parse : int32 -> t + + end + type t = roleRequest val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -729,16 +866,20 @@ module RoleRequest : sig end +(** Hello message structure. See the section 7.5.1 of the OpenFlow 1.3.4 specification *) module Hello : sig + (** Hello Element structure. See the section 7.5.1 of OpenFlow 1.3.4 specification *) module Element : sig + (** Supported Version Bitmap structure. See the section 7.5.1. of OpenFlow 1.3.4 specification *) module VersionBitMap : sig type t = supportedList val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -751,6 +892,7 @@ module Hello : sig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -763,6 +905,7 @@ module Hello : sig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -771,12 +914,14 @@ module Hello : sig end +(** Set Asynchronous message structure. See the section 7.3.10 of OpenFlow 1.3.4 specification *) module AsyncConfig : sig type t = asyncConfig val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val marshal : Cstruct.t -> t -> int @@ -793,14 +938,14 @@ module Message : sig | EchoReply of bytes | FeaturesRequest | FeaturesReply of SwitchFeatures.t - | FlowModMsg of flowMod + | FlowModMsg of FlowMod.t | GroupModMsg of GroupMod.t - | PortModMsg of portMod - | MeterModMsg of meterMod - | PacketInMsg of packetIn - | FlowRemoved of flowRemoved - | PacketOutMsg of packetOut - | PortStatusMsg of portStatus + | PortModMsg of PortMod.t + | MeterModMsg of MeterMod.t + | PacketInMsg of PacketIn.t + | FlowRemoved of FlowRemoved.t + | PacketOutMsg of PacketOut.t + | PortStatusMsg of PortStatus.t | MultipartReq of MultipartReq.t | MultipartReply of MultipartReply.t | BarrierRequest @@ -812,14 +957,15 @@ module Message : sig | GetConfigRequestMsg | GetConfigReplyMsg of SwitchConfig.t | SetConfigMsg of SwitchConfig.t - | TableModMsg of tableMod + | TableModMsg of TableMod.t | GetAsyncRequest - | GetAsyncReply of asyncConfig - | SetAsync of asyncConfig + | GetAsyncReply of AsyncConfig.t + | SetAsync of AsyncConfig.t | Error of Error.t val sizeof : t -> int + (** [to_string v] pretty-prints [v] *) val to_string : t -> string val blit_message : t -> Cstruct.t -> int diff --git a/lib/OpenFlow0x04_Core.ml b/lib/OpenFlow0x04_Core.ml index 88f4d53..767b7af 100644 --- a/lib/OpenFlow0x04_Core.ml +++ b/lib/OpenFlow0x04_Core.ml @@ -601,7 +601,7 @@ type meterConfig = { length : length; flags : meterFlags; meter_id : int32; band type meterBandMaps = { drop : bool; dscpRemark : bool} -type meterFeaturesStats = { max_meter : int32; band_typ : meterBandMaps; +type meterFeatures = { max_meter : int32; band_typ : meterBandMaps; capabilities : meterFlags; max_band : int8; max_color : int8 } @@ -619,7 +619,7 @@ type multipartReplyTyp = | GroupFeaturesReply of groupFeatures | MeterReply of meterStats list | MeterConfig of meterConfig list - | MeterFeaturesReply of meterFeaturesStats + | MeterFeaturesReply of meterFeatures type multipartReply = {mpreply_typ : multipartReplyTyp; mpreply_flags : bool} @@ -655,7 +655,13 @@ type element = type helloElement = element list -type asyncConfig = { packet_in : packetInReason asyncMask; - port_status : portReason asyncMask; - flow_removed : flowReason asyncMask } +type packetInReasonMap = { table_miss : bool; apply_action : bool; invalid_ttl : bool } +type portReasonMap = { add : bool; delete : bool; modify : bool } + +type flowReasonMask = { idle_timeout : bool; hard_timeout : bool; delete : bool; + group_delete : bool} + +type asyncConfig = { packet_in : packetInReasonMap asyncMask; + port_status : portReasonMap asyncMask; + flow_removed : flowReasonMask asyncMask } diff --git a/lib/OpenFlow0x04_Core.mli b/lib/OpenFlow0x04_Core.mli index f61acba..649f857 100644 --- a/lib/OpenFlow0x04_Core.mli +++ b/lib/OpenFlow0x04_Core.mli @@ -568,7 +568,7 @@ type meterConfig = { length : length; flags : meterFlags; meter_id : int32; band type meterBandMaps = { drop : bool; dscpRemark : bool} -type meterFeaturesStats = { max_meter : int32; band_typ : meterBandMaps; +type meterFeatures = { max_meter : int32; band_typ : meterBandMaps; capabilities : meterFlags; max_band : int8; max_color : int8 } @@ -586,7 +586,7 @@ type multipartReplyTyp = | GroupFeaturesReply of groupFeatures | MeterReply of meterStats list | MeterConfig of meterConfig list - | MeterFeaturesReply of meterFeaturesStats + | MeterFeaturesReply of meterFeatures type multipartReply = {mpreply_typ : multipartReplyTyp; mpreply_flags : bool} @@ -622,7 +622,14 @@ type element = type helloElement = element list -type asyncConfig = { packet_in : packetInReason asyncMask; - port_status : portReason asyncMask; - flow_removed : flowReason asyncMask } +type packetInReasonMap = { table_miss : bool; apply_action : bool; invalid_ttl : bool } + +type portReasonMap = { add : bool; delete : bool; modify : bool } + +type flowReasonMask = { idle_timeout : bool; hard_timeout : bool; delete : bool; + group_delete : bool} + +type asyncConfig = { packet_in : packetInReasonMap asyncMask; + port_status : portReasonMap asyncMask; + flow_removed : flowReasonMask asyncMask } diff --git a/lib/OpenFlow0x05.ml b/lib/OpenFlow0x05.ml new file mode 100644 index 0000000..28a10ec --- /dev/null +++ b/lib/OpenFlow0x05.ml @@ -0,0 +1,5194 @@ +(** 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 Capabilities = OpenFlow0x04.Capabilities + +module SwitchFeatures = struct + + cstruct ofp_switch_features { + uint64_t datapath_id; + uint32_t n_buffers; + uint8_t n_tables; + uint8_t auxiliary_id; + uint8_t pad0; + uint8_t pad1; + uint32_t capabilities; + uint32_t reserved + } as big_endian + + type t = switchFeatures + + let sizeof (sw : t) : int = + sizeof_ofp_switch_features + + let to_string (sw : t) : string = + Format.sprintf "{ datapath_id = %Lu; num_buffers = %lu; num_Tables = %u; aux_id = %u; capabilities = %s }" + sw.datapath_id + sw.num_buffers + sw.num_tables + sw.aux_id + (Capabilities.to_string sw.supported_capabilities) + + let marshal (buf : Cstruct.t) (features : t) : int = + set_ofp_switch_features_datapath_id buf features.datapath_id; + set_ofp_switch_features_n_buffers buf features.num_buffers; + set_ofp_switch_features_n_tables buf features.num_tables; + set_ofp_switch_features_auxiliary_id buf features.aux_id; + set_ofp_switch_features_pad0 buf 0; + set_ofp_switch_features_pad1 buf 0; + set_ofp_switch_features_capabilities buf (Capabilities.to_int32 features.supported_capabilities); + sizeof_ofp_switch_features + + let parse (bits : Cstruct.t) : t = + let datapath_id = get_ofp_switch_features_datapath_id bits in + let num_buffers = get_ofp_switch_features_n_buffers bits in + let num_tables = get_ofp_switch_features_n_tables bits in + let aux_id = get_ofp_switch_features_auxiliary_id bits in + let supported_capabilities = Capabilities.parse + (get_ofp_switch_features_capabilities bits) in + { datapath_id; + num_buffers; + num_tables; + aux_id; + supported_capabilities } + +end +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 : t) = + 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 FlowRemoved = struct + + module Reason = struct + + cenum ofp_flow_removed_reason { + OFPRR_IDLE_TIMEOUT = 0; + OFPRR_HARD_TIMEOUT = 1; + OFPRR_DELETE = 2; + OFPRR_GROUP_DELETE = 3; + OFPRR_METER_DELETE = 4; + OFPRR_EVICTION = 5 + } as uint8_t + + type t = flowReason + + let to_string (t : flowReason) : string = + match t with + | FlowIdleTimeout -> "IDLE_TIMEOUT" + | FlowHardTiemout -> "HARD_TIMEOUT" + | FlowDelete -> "DELETE" + | FlowGroupDelete -> "GROUP_DELETE" + | FlowMeterDelete -> "METER_DELETE" + | FlowEviction -> "EVICTION" + + let marshal (t : flowReason) : int8 = + match t with + | FlowIdleTimeout -> ofp_flow_removed_reason_to_int OFPRR_IDLE_TIMEOUT + | FlowHardTiemout -> ofp_flow_removed_reason_to_int OFPRR_HARD_TIMEOUT + | FlowDelete -> ofp_flow_removed_reason_to_int OFPRR_DELETE + | FlowGroupDelete -> ofp_flow_removed_reason_to_int OFPRR_GROUP_DELETE + | FlowMeterDelete -> ofp_flow_removed_reason_to_int OFPRR_METER_DELETE + | FlowEviction -> ofp_flow_removed_reason_to_int OFPRR_EVICTION + + let parse bits : flowReason = + match (int_to_ofp_flow_removed_reason bits) with + | Some OFPRR_IDLE_TIMEOUT -> FlowIdleTimeout + | Some OFPRR_HARD_TIMEOUT -> FlowHardTiemout + | Some OFPRR_DELETE -> FlowDelete + | Some OFPRR_GROUP_DELETE -> FlowGroupDelete + | Some OFPRR_METER_DELETE -> FlowMeterDelete + | Some OFPRR_EVICTION -> FlowEviction + | None -> raise (Unparsable (sprintf "malformed reason")) + + end + + cstruct ofp_flow_removed { + uint64_t cookie; + uint16_t priority; + uint8_t reason; + uint8_t table_id; + uint32_t duration_sec; + uint32_t duration_nsec; + uint16_t idle_timeout; + uint16_t hard_timeout; + uint64_t packet_count; + uint64_t byte_count + } as big_endian + + type t = flowRemoved + + let sizeof (f : flowRemoved) : int = + sizeof_ofp_flow_removed + (OfpMatch.sizeof f.oxm) + + let to_string (f : flowRemoved) : string = + Format.sprintf "{ cookie = %Lu; priotity = %u; reason = %s; table_id = %u;\ + duration s/ns = %lu/%lu; idle_timeout = %s; hard_timeout = %s; packet_count = %Lu;\ + byte_count = %Lu; match = %s }" + f.cookie + f.priority + (Reason.to_string f.reason) + f.table_id + f.duration_sec + f.duration_nsec + (match f.idle_timeout with + | Permanent -> "Permanent" + | ExpiresAfter t-> string_of_int t) + (match f.hard_timeout with + | Permanent -> "Permanent" + | ExpiresAfter t-> string_of_int t) + f.packet_count + f.byte_count + (OfpMatch.to_string f.oxm) + + let marshal (buf : Cstruct.t) (f : flowRemoved) : int = + set_ofp_flow_removed_cookie buf f.cookie; + set_ofp_flow_removed_priority buf f.priority; + set_ofp_flow_removed_reason buf (Reason.marshal f.reason); + set_ofp_flow_removed_table_id buf f.table_id; + set_ofp_flow_removed_duration_sec buf f.duration_sec; + set_ofp_flow_removed_duration_nsec buf f.duration_nsec; + set_ofp_flow_removed_idle_timeout buf (match f.idle_timeout with + | Permanent -> 0 + | ExpiresAfter v -> v); + set_ofp_flow_removed_hard_timeout buf (match f.hard_timeout with + | Permanent -> 0 + | ExpiresAfter v -> v); + set_ofp_flow_removed_packet_count buf f.packet_count; + set_ofp_flow_removed_byte_count buf f.byte_count; + let oxm_buf = Cstruct.shift buf sizeof_ofp_flow_removed in + sizeof_ofp_flow_removed + (OfpMatch.marshal oxm_buf f.oxm) + + let parse (bits : Cstruct.t) : flowRemoved = + let cookie = get_ofp_flow_removed_cookie bits in + let priority = get_ofp_flow_removed_priority bits in + let reason = Reason.parse (get_ofp_flow_removed_reason bits) in + let table_id = get_ofp_flow_removed_table_id bits in + let duration_sec = get_ofp_flow_removed_duration_sec bits in + let duration_nsec = get_ofp_flow_removed_duration_nsec bits in + let idle_timeout = match (get_ofp_flow_removed_idle_timeout bits) with + | 0 -> Permanent + | n -> ExpiresAfter n in + let hard_timeout = match (get_ofp_flow_removed_hard_timeout bits) with + | 0 -> Permanent + | n -> ExpiresAfter n in + let packet_count = get_ofp_flow_removed_packet_count bits in + let byte_count = get_ofp_flow_removed_byte_count bits in + let oxm,_ = OfpMatch.parse (Cstruct.shift bits sizeof_ofp_flow_removed) in + { cookie; priority; reason; table_id; duration_sec; duration_nsec; idle_timeout; + hard_timeout; packet_count; byte_count; oxm } + + +end + + +(* Multipart Messages*) + +module FlowRequest = OpenFlow0x04.FlowRequest + +module TableFeature = OpenFlow0x04.TableFeature + +module QueueRequest = OpenFlow0x04.QueueRequest + +module QueueDescReq = struct + + cstruct ofp_queue_desc_request { + uint32_t port_no; + uint32_t queue_id + } as big_endian + + type t = queueDescRequest + + let sizeof ( _ : t) = + sizeof_ofp_queue_desc_request + + let to_string (t : t) = + Format.sprintf "{ port_no = %s; queue_id = %lu }" + (PseudoPort.to_string t.port_no) + t.queue_id + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_queue_desc_request_port_no buf (PseudoPort.marshal t.port_no); + set_ofp_queue_desc_request_queue_id buf t.queue_id; + sizeof_ofp_queue_desc_request + + let parse (bits : Cstruct.t) : t = + let port_no = PseudoPort.make (get_ofp_queue_desc_request_port_no bits) 0 in + let queue_id = get_ofp_queue_desc_request_queue_id bits in + {port_no; queue_id} + +end + +module FlowMonitorRequest = struct + + cstruct ofp_flow_monitor_request { + uint32_t monitor_id; + uint32_t out_port; + uint32_t out_group; + uint16_t flags; + uint8_t table_id; + uint8_t command + } as big_endian + + module Command = struct + + cenum ofp_flow_monitor_command { + OFPFMC_ADD = 0; + OFPFMC_MODIFY = 1; + OFPFMC_DELETE = 2 + } as uint8_t + + let to_string (t : flowMonitorCommand) = + match t with + | FMonAdd -> "Add" + | FMonModify -> "Modify" + | FMonDelete -> "Delete" + + let marshal (t : flowMonitorCommand) = + match t with + | FMonAdd -> ofp_flow_monitor_command_to_int OFPFMC_ADD + | FMonModify -> ofp_flow_monitor_command_to_int OFPFMC_MODIFY + | FMonDelete -> ofp_flow_monitor_command_to_int OFPFMC_DELETE + + let parse bits : flowMonitorCommand = + match int_to_ofp_flow_monitor_command bits with + | Some OFPFMC_ADD -> FMonAdd + | Some OFPFMC_MODIFY -> FMonModify + | Some OFPFMC_DELETE -> FMonDelete + | None -> raise (Unparsable (sprintf "malformed command")) + + end + + module Flags = struct + let marshal (f : flowMonitorFlags) = + (if f.fmInitial then 1 lsl 0 else 0) lor + (if f.fmAdd then 1 lsl 1 else 0) lor + (if f.fmRemoved then 1 lsl 2 else 0) lor + (if f.fmModify then 1 lsl 3 else 0) lor + (if f.fmInstructions then 1 lsl 4 else 0) lor + (if f.fmNoAbvrev then 1 lsl 5 else 0) lor + (if f.fmOnlyOwn then 1 lsl 6 else 0) + + let parse bits : flowMonitorFlags = + { fmInitial = test_bit16 0 bits + ; fmAdd = test_bit16 1 bits + ; fmRemoved = test_bit16 2 bits + ; fmModify = test_bit16 3 bits + ; fmInstructions = test_bit16 4 bits + ; fmNoAbvrev = test_bit16 5 bits + ; fmOnlyOwn = test_bit16 6 bits} + + let to_string (f : flowMonitorFlags) = + Format.sprintf "{ initial = %B; add = %B; removed = %B; modify = %B; instructions = %B\ + no_abbrev = %B; only_own = %B }" + f.fmInitial + f.fmAdd + f.fmRemoved + f.fmModify + f.fmInstructions + f.fmNoAbvrev + f.fmOnlyOwn + end + + type t = flowMonitorReq + + let sizeof (t : t) = + sizeof_ofp_flow_monitor_request + (OfpMatch.sizeof t.fmMatch) + + let to_string (t : t) = + Format.sprintf "{ monitor_id = %lu; out_port = %s; out_group = %lu; flags = %s\ + table_id = %u; command = %s; match = %s }" + t.fmMonitor_id + (PseudoPort.to_string t.fmOut_port) + t.fmOut_group + (Flags.to_string t.fmFlags) + t.fmTable_id + (Command.to_string t.fmCommand) + (OfpMatch.to_string t.fmMatch) + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_flow_monitor_request_monitor_id buf t.fmMonitor_id; + set_ofp_flow_monitor_request_out_port buf (PseudoPort.marshal t.fmOut_port); + set_ofp_flow_monitor_request_out_group buf t.fmOut_group; + set_ofp_flow_monitor_request_flags buf (Flags.marshal t.fmFlags); + set_ofp_flow_monitor_request_table_id buf t.fmTable_id; + set_ofp_flow_monitor_request_command buf (Command.marshal t.fmCommand); + sizeof_ofp_flow_monitor_request + (OfpMatch.marshal (Cstruct.shift buf sizeof_ofp_flow_monitor_request) t.fmMatch) + + let parse (bits : Cstruct.t) : t = + { fmMonitor_id = get_ofp_flow_monitor_request_monitor_id bits + ; fmOut_port = PseudoPort.make (get_ofp_flow_monitor_request_out_port bits) 0 + ; fmOut_group = get_ofp_flow_monitor_request_out_group bits + ; fmFlags = Flags.parse (get_ofp_flow_monitor_request_flags bits) + ; fmTable_id = get_ofp_flow_monitor_request_table_id bits + ; fmCommand = Command.parse (get_ofp_flow_monitor_request_command bits) + ; fmMatch = (let ret,_ = OfpMatch.parse (Cstruct.shift bits sizeof_ofp_flow_monitor_request) in ret) + } +end + +cenum ofp_multipart_types { + OFPMP_DESC = 0; + OFPMP_FLOW = 1; + OFPMP_AGGREGATE = 2; + OFPMP_TABLE = 3; + OFPMP_PORT_STATS = 4; + OFPMP_QUEUE = 5; + OFPMP_GROUP = 6; + OFPMP_GROUP_DESC = 7; + OFPMP_GROUP_FEATURES = 8; + OFPMP_METER = 9; + OFPMP_METER_CONFIG = 10; + OFPMP_METER_FEATURES = 11; + OFPMP_TABLE_FEATURES = 12; + OFPMP_PORT_DESC = 13; + OFPMP_TABLE_DESC = 14; + OFPMP_QUEUE_DESC = 15; + OFPMP_FLOW_MONITOR = 16; + OFPMP_EXPERIMENTER = 0xffff +} as uint16_t + +module MultipartReq = struct + + cstruct ofp_multipart_request { + uint16_t typ; (* One of the OFPMP_* constants. *) + uint16_t flags; (* OFPMPF_REQ_* flags. *) + uint8_t pad0; + uint8_t pad1; + uint8_t pad2; + uint8_t pad3 + } as big_endian + + cenum ofp_multipart_request_flags { + OFPMPF_REQ_MORE = 1 (* More requests to follow. *) + } as uint16_t + + cstruct ofp_experimenter_multipart_header { + uint32_t experimenter; + uint32_t exp_type + } as big_endian + + cstruct ofp_port_stats_request { + uint32_t port_no; + uint8_t pad[4] + } as big_endian + + cstruct ofp_group_stats_request { + uint32_t group_id; + uint8_t pad[4] + } as big_endian + + cstruct ofp_meter_multipart_request { + uint32_t meter_id; + uint8_t pad[4] + } as big_endian + + type t = multipartRequest + + let msg_code_of_request mpr = match mpr with + | SwitchDescReq -> OFPMP_DESC + | PortsDescReq -> OFPMP_PORT_DESC + | FlowStatsReq _ -> OFPMP_FLOW + | AggregFlowStatsReq _ -> OFPMP_AGGREGATE + | TableStatsReq -> OFPMP_TABLE + | PortStatsReq _ -> OFPMP_PORT_STATS + | QueueStatsReq _ -> OFPMP_QUEUE + | GroupStatsReq _ -> OFPMP_GROUP + | GroupDescReq -> OFPMP_GROUP_DESC + | GroupFeatReq -> OFPMP_GROUP_FEATURES + | MeterStatsReq _ -> OFPMP_METER + | MeterConfReq _ -> OFPMP_METER_CONFIG + | MeterFeatReq -> OFPMP_METER_FEATURES + | TableFeatReq _ -> OFPMP_TABLE_FEATURES + | ExperimentReq _ -> OFPMP_EXPERIMENTER + | TableDescReq -> OFPMP_TABLE_DESC + | QueueDescReq _ -> OFPMP_QUEUE_DESC + | FlowMonitorReq _ -> OFPMP_FLOW_MONITOR + + let sizeof (mpr : multipartRequest) = + sizeof_ofp_multipart_request + + (match mpr.mpr_type with + | SwitchDescReq | PortsDescReq | TableStatsReq | MeterFeatReq | GroupDescReq + | GroupFeatReq + | TableDescReq -> 0 + | FlowStatsReq fr -> FlowRequest.sizeof fr + | AggregFlowStatsReq fr -> FlowRequest.sizeof fr + | PortStatsReq _ -> sizeof_ofp_port_stats_request + | QueueStatsReq q -> QueueRequest.sizeof q + | GroupStatsReq _ -> sizeof_ofp_group_stats_request + | MeterStatsReq _ | MeterConfReq _ -> sizeof_ofp_meter_multipart_request + | QueueDescReq q -> QueueDescReq.sizeof q + | TableFeatReq tfr -> (match tfr with + | None -> 0 + | Some t -> sum (map TableFeature.sizeof t)) + | FlowMonitorReq f -> FlowMonitorRequest.sizeof f + | ExperimentReq _ -> sizeof_ofp_experimenter_multipart_header ) + + let to_string (mpr : multipartRequest) : string = + Format.sprintf "{ more = %B; typ = %s }" + mpr.mpr_flags + (match mpr.mpr_type with + | SwitchDescReq -> "SwitchDesc Req" + | PortsDescReq -> "PortDesc Req" + | FlowStatsReq f -> + Format.sprintf "FlowStats Req %s" (FlowRequest.to_string f) + | AggregFlowStatsReq f -> + Format.sprintf "AggregFlowStats %s Req" (FlowRequest.to_string f) + | TableStatsReq -> "TableStats Req" + | PortStatsReq p -> + Format.sprintf "PortStats Req %lu" p + | QueueStatsReq q -> + Format.sprintf "QueueStats Req %s" (QueueRequest.to_string q) + | GroupStatsReq g -> Format.sprintf "GroupStats Req %lu" g + | GroupDescReq -> "GroupDesc Req" + | GroupFeatReq -> "GroupFeat Req" + | MeterStatsReq m -> Format.sprintf "MeterStats Req %lu " m + | MeterConfReq m -> Format.sprintf "MeterConf Req %lu" m + | MeterFeatReq -> "MeterFeat Req" + | TableFeatReq t -> Format.sprintf "TableFeat Req { %s }" (match t with + | Some v -> String.concat "; " (map TableFeature.to_string v) + | None -> "None" ) + | ExperimentReq e-> Format.sprintf "Experimenter Req: id: %lu; type: %lu" e.experimenter e.exp_typ + | TableDescReq -> "TableDesc Req" + | QueueDescReq q -> QueueDescReq.to_string q + | FlowMonitorReq f -> FlowMonitorRequest.to_string f) + + let marshal (buf : Cstruct.t) (mpr : multipartRequest) : int = + let size = sizeof_ofp_multipart_request in + set_ofp_multipart_request_typ buf (ofp_multipart_types_to_int (msg_code_of_request mpr.mpr_type)); + set_ofp_multipart_request_flags buf ( + match mpr.mpr_flags with + | true -> ofp_multipart_request_flags_to_int OFPMPF_REQ_MORE + | false -> 0); + set_ofp_multipart_request_pad0 buf 0; + set_ofp_multipart_request_pad1 buf 0; + set_ofp_multipart_request_pad2 buf 0; + set_ofp_multipart_request_pad3 buf 0; + let pay_buf = Cstruct.shift buf sizeof_ofp_multipart_request in + match mpr.mpr_type with + | SwitchDescReq + | PortsDescReq -> size + | FlowStatsReq f -> size + (FlowRequest.marshal pay_buf f) + | AggregFlowStatsReq f -> size + (FlowRequest.marshal pay_buf f) + | TableStatsReq -> size + | PortStatsReq p -> set_ofp_port_stats_request_port_no pay_buf p; + size + sizeof_ofp_port_stats_request + | QueueStatsReq q -> size + (QueueRequest.marshal pay_buf q) + | GroupStatsReq g -> set_ofp_port_stats_request_port_no pay_buf g; + size + sizeof_ofp_port_stats_request + | GroupDescReq + | GroupFeatReq -> size + | MeterStatsReq m -> set_ofp_meter_multipart_request_meter_id pay_buf m; + size + sizeof_ofp_meter_multipart_request + | MeterConfReq m -> set_ofp_meter_multipart_request_meter_id pay_buf m; + size + sizeof_ofp_meter_multipart_request + | MeterFeatReq -> size + | TableFeatReq t -> + (match t with + | None -> 0 + | Some v -> size + (marshal_fields pay_buf v TableFeature.marshal)) + | ExperimentReq _ -> size + | TableDescReq -> size + | QueueDescReq q -> size + (QueueDescReq.marshal pay_buf q) + | FlowMonitorReq f -> size + (FlowMonitorRequest.marshal pay_buf f) + + let parse (bits : Cstruct.t) : multipartRequest = + let mprType = int_to_ofp_multipart_types (get_ofp_multipart_request_typ bits) in + let mpr_flags = ( + match int_to_ofp_multipart_request_flags (get_ofp_multipart_request_flags bits) with + | Some OFPMPF_REQ_MORE -> true + | _ -> false) in + let mpr_type = match mprType with + | Some OFPMP_DESC -> SwitchDescReq + | Some OFPMP_PORT_DESC -> PortsDescReq + | Some OFPMP_FLOW -> FlowStatsReq ( + FlowRequest.parse (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_AGGREGATE -> AggregFlowStatsReq ( + FlowRequest.parse (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_TABLE -> TableStatsReq + | Some OFPMP_PORT_STATS -> PortStatsReq ( + get_ofp_port_stats_request_port_no (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_QUEUE -> QueueStatsReq ( + QueueRequest.parse (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_GROUP -> GroupStatsReq ( + get_ofp_group_stats_request_group_id (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_GROUP_DESC -> GroupDescReq + | Some OFPMP_GROUP_FEATURES -> GroupFeatReq + | Some OFPMP_METER -> MeterStatsReq ( + get_ofp_meter_multipart_request_meter_id (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_METER_CONFIG -> MeterConfReq ( + get_ofp_meter_multipart_request_meter_id (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_METER_FEATURES -> MeterFeatReq + | Some OFPMP_TABLE_FEATURES -> TableFeatReq ( + if Cstruct.len bits <= sizeof_ofp_multipart_request then None + else Some ( + parse_fields (Cstruct.shift bits sizeof_ofp_multipart_request) TableFeature.parse TableFeature.length_func + )) + | Some OFPMP_EXPERIMENTER -> ExperimentReq ( + let exp_bits = Cstruct.shift bits sizeof_ofp_multipart_request in + let exp_id = get_ofp_experimenter_multipart_header_experimenter exp_bits in + let exp_type = get_ofp_experimenter_multipart_header_exp_type exp_bits in + {experimenter = exp_id; exp_typ = exp_type}) + | Some OFPMP_TABLE_DESC -> TableDescReq + | Some OFPMP_QUEUE_DESC -> QueueDescReq (QueueDescReq.parse (Cstruct.shift bits sizeof_ofp_multipart_request)) + | Some OFPMP_FLOW_MONITOR -> FlowMonitorReq (FlowMonitorRequest.parse (Cstruct.shift bits sizeof_ofp_multipart_request)) + | _ -> raise (Unparsable (sprintf "bad ofp_multipart_types number")) + in {mpr_type; mpr_flags} + + +end + +module FlowStats = OpenFlow0x04.FlowStats + +module AggregateStats = OpenFlow0x04.AggregateStats + +module TableStats = OpenFlow0x04.TableStats + +module PortStats = struct + + cstruct ofp_port_stats { + uint16_t length; + uint8_t pad[2]; + uint32_t port_no; + uint32_t duration_sec; + uint32_t duration_nsec; + uint64_t rx_packets; + uint64_t tx_packets; + uint64_t rx_bytes; + uint64_t tx_bytes; + uint64_t rx_dropped; + uint64_t tx_dropped; + uint64_t rx_errors; + uint64_t tx_errors; + } as big_endian + + module Properties = struct + + cenum ofp_port_stats_prop_type { + OFPPSPT_ETHERNET = 0; + OFPPSPT_OPTICAL = 1; + OFPPSPT_EXPERIMENTER = 0xffff + } as uint16_t + + module Ethernet = struct + cstruct ofp_port_stats_prop_ethernet { + uint16_t typ; + uint16_t len; + uint8_t pad[4]; + uint64_t rx_frame_err; + uint64_t rx_over_err; + uint64_t rx_crc_err; + uint64_t collisions + } as big_endian + + type t = portStatsPropEthernet + + let to_string (t : t) = + Format.sprintf "{ rx_frame_err = %Lu; rx_over_err = %Lu; rx_crc_err = %Lu; collisions = %Lu }" + t.rx_frame_err + t.rx_over_err + t.rx_crc_err + t.collisions + + let sizeof (_ : t) = + sizeof_ofp_port_stats_prop_ethernet + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_port_stats_prop_ethernet_typ buf (ofp_port_stats_prop_type_to_int OFPPSPT_ETHERNET); + set_ofp_port_stats_prop_ethernet_len buf sizeof_ofp_port_stats_prop_ethernet; + set_ofp_port_stats_prop_ethernet_rx_frame_err buf t.rx_frame_err; + set_ofp_port_stats_prop_ethernet_rx_over_err buf t.rx_over_err; + set_ofp_port_stats_prop_ethernet_rx_crc_err buf t.rx_crc_err; + set_ofp_port_stats_prop_ethernet_collisions buf t.collisions; + sizeof_ofp_port_stats_prop_ethernet + + let parse (bits : Cstruct.t) : t = + { rx_frame_err = get_ofp_port_stats_prop_ethernet_rx_frame_err bits + ; rx_over_err = get_ofp_port_stats_prop_ethernet_rx_over_err bits + ; rx_crc_err = get_ofp_port_stats_prop_ethernet_rx_crc_err bits + ; collisions = get_ofp_port_stats_prop_ethernet_collisions bits } + + end + + module Optical = struct + + module Flags = struct + + type t = portStatsOpticalFlag + + let to_string (t : t) = + Format.sprintf "{ rx_tune = %B; tx_tune = %B; tx_pwr = %B; rx_pwr = %B;\ + tx_bias = %B; tx_temp = %B }" + t.rx_tune + t.tx_tune + t.tx_pwr + t.rx_pwr + t.tx_bias + t.tx_temp + + let marshal (t : t) : int32 = + Int32.logor (if t.rx_tune then (Int32.shift_left 1l 0) else 0l) + (Int32.logor (if t.tx_tune then (Int32.shift_left 1l 1) else 0l) + (Int32.logor (if t.tx_pwr then (Int32.shift_left 1l 2) else 0l) + (Int32.logor (if t.rx_pwr then (Int32.shift_left 1l 4) else 0l) + (Int32.logor (if t.tx_bias then (Int32.shift_left 1l 5) else 0l) + (if t.tx_temp then (Int32.shift_left 1l 6) else 0l))))) + + let parse bits : t = + { rx_tune = Bits.test_bit 0 bits + ; tx_tune = Bits.test_bit 1 bits + ; tx_pwr = Bits.test_bit 2 bits + ; rx_pwr = Bits.test_bit 4 bits + ; tx_bias = Bits.test_bit 5 bits + ; tx_temp = Bits.test_bit 6 bits } + + end + cstruct ofp_port_stats_prop_optical { + uint16_t typ; + uint16_t len; + uint8_t pad[4]; + uint32_t flags; + uint32_t tx_freq_lmda; + uint32_t tx_offset; + uint32_t tx_grid_span; + uint32_t rx_freq_lmda; + uint32_t rx_offset; + uint32_t rx_grid_span; + uint16_t tx_pwr; + uint16_t rx_pwr; + uint16_t bias_current; + uint16_t temperature + } as big_endian + + type t = portStatsPropOptical + + let sizeof (_ : t) = + sizeof_ofp_port_stats_prop_optical + + let to_string (t : t) = + Format.sprintf "{ flags = %s; tx_freq_lmda = %lu; tx_offset = %lu; tx_grid_span = %lu;\ + rx_freq_lmda = %lu; rx_offset = %lu; rx_grid_span = %lu; \ + tx_pwr = %u; rx_pwr = %u; bias_current = %u; temperature = %u }" + (Flags.to_string t.flags) + t.tx_freq_lmda + t.tx_offset + t.tx_grid_span + t.rx_freq_lmda + t.rx_offset + t.rx_grid_span + t.tx_pwr + t.rx_pwr + t.bias_current + t.temperature + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_port_stats_prop_optical_typ buf (ofp_port_stats_prop_type_to_int OFPPSPT_OPTICAL); + set_ofp_port_stats_prop_optical_len buf sizeof_ofp_port_stats_prop_optical; + set_ofp_port_stats_prop_optical_flags buf (Flags.marshal t.flags); + set_ofp_port_stats_prop_optical_tx_freq_lmda buf t.tx_freq_lmda; + set_ofp_port_stats_prop_optical_tx_offset buf t.tx_offset; + set_ofp_port_stats_prop_optical_tx_grid_span buf t.tx_grid_span; + set_ofp_port_stats_prop_optical_rx_freq_lmda buf t.rx_freq_lmda; + set_ofp_port_stats_prop_optical_rx_offset buf t.rx_offset; + set_ofp_port_stats_prop_optical_rx_grid_span buf t.rx_grid_span; + set_ofp_port_stats_prop_optical_tx_pwr buf t.tx_pwr; + set_ofp_port_stats_prop_optical_rx_pwr buf t.rx_pwr; + set_ofp_port_stats_prop_optical_bias_current buf t.bias_current; + set_ofp_port_stats_prop_optical_temperature buf t.temperature; + sizeof_ofp_port_stats_prop_optical + + let parse (bits : Cstruct.t) : t = + { flags = Flags.parse (get_ofp_port_stats_prop_optical_flags bits) + ; tx_freq_lmda = get_ofp_port_stats_prop_optical_tx_freq_lmda bits + ; tx_offset = get_ofp_port_stats_prop_optical_tx_offset bits + ; tx_grid_span = get_ofp_port_stats_prop_optical_tx_grid_span bits + ; rx_freq_lmda = get_ofp_port_stats_prop_optical_rx_freq_lmda bits + ; rx_offset = get_ofp_port_stats_prop_optical_rx_offset bits + ; rx_grid_span = get_ofp_port_stats_prop_optical_rx_grid_span bits + ; tx_pwr = get_ofp_port_stats_prop_optical_tx_pwr bits + ; rx_pwr = get_ofp_port_stats_prop_optical_rx_pwr bits + ; bias_current = get_ofp_port_stats_prop_optical_bias_current bits + ; temperature = get_ofp_port_stats_prop_optical_temperature bits + } + + end + + module Experimenter = struct + + cstruct ofp_port_stats_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_stats_prop_experimenter + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_port_stats_prop_experimenter_typ buf (ofp_port_stats_prop_type_to_int OFPPSPT_EXPERIMENTER); + set_ofp_port_stats_prop_experimenter_len buf sizeof_ofp_port_stats_prop_experimenter; + set_ofp_port_stats_prop_experimenter_experimenter buf t.experimenter; + set_ofp_port_stats_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_port_stats_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_port_stats_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_port_stats_prop_experimenter_exp_typ bits} + + end + + cstruct ofp_port_stats_prop_header { + uint16_t typ; + uint16_t len; + } as big_endian + + type t = portStatsProp + + let sizeof (t : t) : int = + match t with + | PortStatsPropEthernet p -> Ethernet.sizeof p + | PortStatsPropOptical p -> Optical.sizeof p + | PortStatsPropExperimenter p -> Experimenter.sizeof p + + let to_string (t : t) : string = + match t with + | PortStatsPropEthernet p -> Format.sprintf "Ethernet : %s" (Ethernet.to_string p) + | PortStatsPropOptical p -> Format.sprintf "Optical : %s" (Optical.to_string p) + | PortStatsPropExperimenter p -> Format.sprintf "Experimenter : %s" (Experimenter.to_string p) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_port_stats_prop_header then None + else Some (get_ofp_port_stats_prop_header_len buf) + + let marshal (buf : Cstruct.t) (t : t) = + match t with + | PortStatsPropEthernet p -> Ethernet.marshal buf p + | PortStatsPropOptical p -> Optical.marshal buf p + | PortStatsPropExperimenter p -> Experimenter.marshal buf p + + let parse (bits : Cstruct.t) : t = + let typ = match int_to_ofp_port_stats_prop_type (get_ofp_port_stats_prop_header_typ bits) with + | Some v -> v + | None -> raise (Unparsable (sprintf "malformed prop typ")) in + match typ with + | OFPPSPT_ETHERNET -> PortStatsPropEthernet (Ethernet.parse bits) + | OFPPSPT_OPTICAL -> PortStatsPropOptical (Optical.parse bits) + | OFPPSPT_EXPERIMENTER -> PortStatsPropExperimenter (Experimenter.parse bits) + + + end + + type t = portStats + + let sizeof (ps : portStats) = + sizeof_ofp_port_stats + sum (map Properties.sizeof ps.properties) + + let to_string ps = + Format.sprintf "{ port_no = %lu; duration (s/ns) = %lu/%lu ;rx/tx pkt = %Lu/%Lu;\ + rx/tx byt = %Lu/%Lu; rx/tx dropped = %Lu/%Lu; rx/tx error = %Lu/%Lu; + properties : %s }" + ps.psPort_no + ps.duration_sec + ps.duration_nsec + ps.rx_packets + ps.tx_packets + ps.rx_bytes + ps.tx_bytes + ps.rx_dropped + ps.tx_dropped + ps.rx_errors + ps.tx_errors + ("[ " ^ (String.concat "; " (map Properties.to_string ps.properties)) ^ " ]") + + let marshal (buf : Cstruct.t) (ps : portStats) : int = + set_ofp_port_stats_length buf (sizeof ps); + set_ofp_port_stats_port_no buf ps.psPort_no; + set_ofp_port_stats_duration_sec buf ps.duration_sec; + set_ofp_port_stats_duration_nsec buf ps.duration_nsec; + set_ofp_port_stats_rx_packets buf ps.rx_packets; + set_ofp_port_stats_tx_packets buf ps.tx_packets; + set_ofp_port_stats_rx_bytes buf ps.rx_bytes; + set_ofp_port_stats_tx_bytes buf ps.tx_bytes; + set_ofp_port_stats_rx_dropped buf ps.rx_dropped; + set_ofp_port_stats_tx_dropped buf ps.tx_dropped; + set_ofp_port_stats_rx_errors buf ps.rx_errors; + set_ofp_port_stats_tx_errors buf ps.tx_errors; + sizeof_ofp_port_stats + marshal_fields (Cstruct.shift buf sizeof_ofp_port_stats) ps.properties Properties.marshal + + let parse (bits : Cstruct.t) : portStats = + { psPort_no = get_ofp_port_stats_port_no bits; + duration_sec = get_ofp_port_stats_duration_sec bits; + duration_nsec = get_ofp_port_stats_duration_nsec bits; + rx_packets = get_ofp_port_stats_rx_packets bits; + tx_packets = get_ofp_port_stats_tx_packets bits; + rx_bytes = get_ofp_port_stats_rx_bytes bits; + tx_bytes = get_ofp_port_stats_tx_bytes bits; + rx_dropped = get_ofp_port_stats_rx_dropped bits; + tx_dropped = get_ofp_port_stats_tx_dropped bits; + rx_errors = get_ofp_port_stats_rx_errors bits; + tx_errors = get_ofp_port_stats_tx_errors bits; + properties = parse_fields (Cstruct.shift bits sizeof_ofp_port_stats) Properties.parse Properties.length_func + } + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_port_stats then None + else Some (get_ofp_port_stats_length buf) + +end + +module QueueStats = struct + + module Properties = struct + + cstruct ofp_queue_stats_prop_header { + uint16_t typ; + uint16_t len + } as big_endian + + cenum ofp_queue_stats_prop_type { + OFPQSPT_EXPERIMENTER = 0xffff + } as uint16_t + + module Experimenter = struct + cstruct ofp_queue_stats_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_queue_stats_prop_experimenter + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_queue_stats_prop_experimenter_typ buf (ofp_queue_stats_prop_type_to_int OFPQSPT_EXPERIMENTER); + set_ofp_queue_stats_prop_experimenter_len buf sizeof_ofp_queue_stats_prop_experimenter; + set_ofp_queue_stats_prop_experimenter_experimenter buf t.experimenter; + set_ofp_queue_stats_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_queue_stats_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_queue_stats_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_queue_stats_prop_experimenter_exp_typ bits} + + end + + type t = queueStatsProp + + let sizeof (t : t) : int = + match t with + | ExperimenterQueueStats e -> Experimenter.sizeof e + + let to_string (t : t) : string = + match t with + | ExperimenterQueueStats e -> Format.sprintf "Experimenter : %s" (Experimenter.to_string e) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_queue_stats_prop_header then None + else Some (get_ofp_queue_stats_prop_header_len buf) + + let marshal (buf : Cstruct.t) (t : t) = + match t with + | ExperimenterQueueStats e -> Experimenter.marshal buf e + + let parse (bits : Cstruct.t) : t = + let typ = match int_to_ofp_queue_stats_prop_type (get_ofp_queue_stats_prop_header_typ bits) with + | Some v -> v + | None -> raise (Unparsable (sprintf "malformed prop typ")) in + match typ with + | OFPQSPT_EXPERIMENTER -> ExperimenterQueueStats (Experimenter.parse bits) + end + + cstruct ofp_queue_stats { + uint16_t length; + uint8_t pad[6]; + uint32_t port_no; + uint32_t queue_id; + uint64_t tx_bytes; + uint64_t tx_packets; + uint64_t tx_errors; + uint32_t duration_sec; + uint32_t duration_nsec + } as big_endian + + type t = queueStats + + let sizeof (qs : queueStats) : int = + sizeof_ofp_queue_stats + sum (map Properties.sizeof qs.properties) + + let to_string (qs : queueStats) : string = + Format.sprintf "{ port no = %lu; queue_id = %lu; tx bytes = %Lu; tx pkt = %Lu; tx errors = %Lu; duration (s/ns) = %lu/%lu;\ + properties = %s }" + qs.qsPort_no + qs.queue_id + qs.tx_bytes + qs.tx_packets + qs.tx_errors + qs.duration_sec + qs.duration_nsec + ("[ " ^ (String.concat "; " (map Properties.to_string qs.properties)) ^ " ]") + + let marshal (buf : Cstruct.t) (qs : queueStats) : int = + set_ofp_queue_stats_length buf (sizeof qs); + set_ofp_queue_stats_port_no buf qs.qsPort_no; + set_ofp_queue_stats_queue_id buf qs.queue_id; + set_ofp_queue_stats_tx_bytes buf qs.tx_bytes; + set_ofp_queue_stats_tx_packets buf qs.tx_packets; + set_ofp_queue_stats_tx_errors buf qs.tx_errors; + set_ofp_queue_stats_duration_sec buf qs.duration_sec; + set_ofp_queue_stats_duration_nsec buf qs.duration_nsec; + sizeof_ofp_queue_stats + marshal_fields (Cstruct.shift buf sizeof_ofp_queue_stats) qs.properties Properties.marshal + + let parse (bits : Cstruct.t) : queueStats = + { qsPort_no = get_ofp_queue_stats_port_no bits + ; queue_id = get_ofp_queue_stats_queue_id bits + ; tx_bytes = get_ofp_queue_stats_tx_bytes bits + ; tx_packets = get_ofp_queue_stats_tx_packets bits + ; tx_errors = get_ofp_queue_stats_tx_errors bits + ; duration_sec = get_ofp_queue_stats_duration_sec bits + ; duration_nsec = get_ofp_queue_stats_duration_nsec bits + ; properties = parse_fields (Cstruct.shift bits sizeof_ofp_queue_stats) Properties.parse Properties.length_func + } + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_queue_stats then None + else Some (get_ofp_queue_stats_length buf) + +end + +module GroupStats = OpenFlow0x04.GroupStats + +module GroupDesc = OpenFlow0x04.GroupDesc + +module GroupFeatures = OpenFlow0x04.GroupFeatures + +module MeterStats = OpenFlow0x04.MeterStats + +module MeterConfig = OpenFlow0x04.MeterConfig + +module MeterFeatures = OpenFlow0x04.MeterFeatures + +module SwitchDescriptionReply = OpenFlow0x04.SwitchDescriptionReply + +module TableDescReply = struct + + cstruct ofp_table_desc { + uint16_t len; + uint8_t table_id; + uint8_t pad; + uint32_t config + } as big_endian + + type t = tableDescReply + + let sizeof (tab : t) : int = + sizeof_ofp_table_desc + sum (map TableMod.Properties.sizeof tab.properties) + + let to_string (tab : t) : string = + Format.sprintf "{ tabled_id = %u; config = %s; properties = %s }" + tab.table_id + (TableMod.TableConfig.to_string tab.config) + ("[ " ^ (String.concat "; " (map TableMod.Properties.to_string tab.properties))^ " ]") + + let marshal (buf : Cstruct.t) (tab : t) : int = + set_ofp_table_desc_len buf (sizeof tab); + set_ofp_table_desc_table_id buf tab.table_id; + set_ofp_table_desc_config buf (TableMod.TableConfig.marshal tab.config); + sizeof_ofp_table_desc + (marshal_fields (Cstruct.shift buf sizeof_ofp_table_desc) tab.properties TableMod.Properties.marshal) + + let parse (bits : Cstruct.t) : t = + let table_id = get_ofp_table_desc_table_id bits in + let config = TableMod.TableConfig.parse (get_ofp_table_desc_config bits) in + let properties = parse_fields (Cstruct.shift bits sizeof_ofp_table_desc) TableMod.Properties.parse TableMod.Properties.length_func in + { table_id; config; properties } + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_table_desc then None + else Some (get_ofp_table_desc_len buf) + +end + +module QueueDescReply = struct + + module Properties = struct + + cenum ofp_queue_desc_prop_type { + OFPQDPT_MIN_RATE = 1; + OFPQDPT_MAX_RATE = 2; + OFPQDPT_EXPERIMENTER = 0xffff + } as uint16_t + + module MinRate = struct + + cstruct ofp_queue_desc_prop_min_rate { + uint16_t typ; + uint16_t len; + uint16_t rate; + uint8_t pad[2] + } as big_endian + + type t = rateQueue + + let sizeof (_ : t) = + sizeof_ofp_queue_desc_prop_min_rate + + let to_string (t : t) = + match t with + | Rate n -> string_of_int n + | Disabled -> "Disabled" + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_queue_desc_prop_min_rate_typ buf (ofp_queue_desc_prop_type_to_int OFPQDPT_MIN_RATE); + set_ofp_queue_desc_prop_min_rate_len buf sizeof_ofp_queue_desc_prop_min_rate; + set_ofp_queue_desc_prop_min_rate_rate buf ( + match t with + | Rate n -> n + | Disabled -> 0xffff); + sizeof_ofp_queue_desc_prop_min_rate + + let parse (bits : Cstruct.t) : t = + let rate = get_ofp_queue_desc_prop_min_rate_rate bits in + if rate > 1000 then Disabled + else Rate rate + + end + + module MaxRate = struct + + cstruct ofp_queue_desc_prop_max_rate { + uint16_t typ; + uint16_t len; + uint16_t rate; + uint8_t pad[2] + } as big_endian + + type t = rateQueue + + let sizeof (_ : t) = + sizeof_ofp_queue_desc_prop_max_rate + + let to_string (t : t) = + match t with + | Rate n -> string_of_int n + | Disabled -> "Disabled" + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_queue_desc_prop_max_rate_typ buf (ofp_queue_desc_prop_type_to_int OFPQDPT_MAX_RATE); + set_ofp_queue_desc_prop_max_rate_len buf sizeof_ofp_queue_desc_prop_max_rate; + set_ofp_queue_desc_prop_max_rate_rate buf ( + match t with + | Rate n -> n + | Disabled -> 0xffff); + sizeof_ofp_queue_desc_prop_max_rate + + let parse (bits : Cstruct.t) : t = + let rate = get_ofp_queue_desc_prop_max_rate_rate bits in + if rate > 1000 then Disabled + else Rate rate + + end + + module Experimenter = struct + + cstruct ofp_queue_desc_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_queue_desc_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_queue_desc_prop_experimenter_typ buf (ofp_queue_desc_prop_type_to_int OFPQDPT_EXPERIMENTER); + set_ofp_queue_desc_prop_experimenter_len buf (sizeof t); + set_ofp_queue_desc_prop_experimenter_experimenter buf t.experimenter; + set_ofp_queue_desc_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_queue_desc_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_queue_desc_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_queue_desc_prop_experimenter_exp_typ bits} + + end + cstruct ofp_queue_desc_prop_header { + uint16_t typ; + uint16_t len; + } as big_endian + + type t = queueDescProp + + let sizeof (t : t) = + match t with + | QueueDescPropMinRate r -> MinRate.sizeof r + | QueueDescPropMaxRate r -> MaxRate.sizeof r + | QueueDescPropExperimenter e -> Experimenter.sizeof e + + let to_string (t : t) = + match t with + | QueueDescPropMinRate r -> Format.sprintf "MinRate : %s" (MinRate.to_string r) + | QueueDescPropMaxRate r -> Format.sprintf "MaxRate : %s" (MaxRate.to_string r) + | QueueDescPropExperimenter e -> Format.sprintf "Experimenter : %s" (Experimenter.to_string e) + + let marshal (buf : Cstruct.t) (t : t) : int = + match t with + | QueueDescPropMinRate r -> MinRate.marshal buf r + | QueueDescPropMaxRate r -> MaxRate.marshal buf r + | QueueDescPropExperimenter e -> Experimenter.marshal buf e + + let parse (bits : Cstruct.t) : t = + match int_to_ofp_queue_desc_prop_type (get_ofp_queue_desc_prop_header_typ bits) with + | Some OFPQDPT_MIN_RATE -> QueueDescPropMinRate (MinRate.parse bits) + | Some OFPQDPT_MAX_RATE -> QueueDescPropMaxRate (MaxRate.parse bits) + | Some OFPQDPT_EXPERIMENTER -> QueueDescPropExperimenter (Experimenter.parse bits) + | None -> raise (Unparsable (sprintf "Malformed queue desc prop typ")) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_queue_desc_prop_header then None + else Some (get_ofp_queue_desc_prop_header_len buf) + + end + + cstruct ofp_queue_desc { + uint32_t port_no; + uint32_t queue_id; + uint16_t len; + uint8_t pad[6] + } as big_endian + + type t = queueDescReply + + let sizeof (t : t) = + sizeof_ofp_queue_desc + sum (map Properties.sizeof t.properties) + + let to_string (t : t) = + Format.sprintf "{ port_no = %lu; queue_id = %lu; properties = %s }" + t.port_no + t.queue_id + ("[ " ^ (String.concat "; " (map Properties.to_string t.properties)) ^ " ]") + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_queue_desc_port_no buf t.port_no; + set_ofp_queue_desc_queue_id buf t.queue_id; + set_ofp_queue_desc_len buf (sizeof t); + sizeof_ofp_queue_desc + marshal_fields (Cstruct.shift buf sizeof_ofp_queue_desc) t.properties Properties.marshal + + let parse (bits : Cstruct.t) : t = + { port_no = get_ofp_queue_desc_port_no bits + ; queue_id = get_ofp_queue_desc_queue_id bits + ; properties = parse_fields (Cstruct.shift bits sizeof_ofp_queue_desc) Properties.parse Properties.length_func + } + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_queue_desc then None + else Some (get_ofp_queue_desc_len buf) +end + +module FlowMonitorReply = struct + + cenum ofp_flow_update_event { + OFPFME_INITIAL = 0; + OFPFME_ADDED = 1; + OFPFME_REMOVED = 2; + OFPFME_MODIFIED = 3; + OFPFME_ABBREV = 4; + OFPFME_PAUSED = 5; + OFPFME_RESUMED = 6 + } as uint16_t + + module UpdateFull = struct + + cstruct ofp_flow_update_full { + uint16_t length; + uint16_t event; + uint8_t table_id; + uint8_t reason; + uint16_t idle_timeout; + uint16_t hard_timeout; + uint16_t priority; + uint8_t zeros[4]; + uint64_t cookie; + } as big_endian + + type t = fmUpdateFull + + let sizeof (t : t) = + sizeof_ofp_flow_update_full + (OfpMatch.sizeof t.updateMatch)+ (Instructions.sizeof t.instructions) + + let to_string (t : t) = + Format.sprintf "{ event = %s; table_id = %u; reason = %s; idle_timeout = %s; hard_timeout = %s\ + priority = %u; cookie = %Lu; match = %s; instructions = %s }" + (match t.event with + | InitialUpdate -> "Initial" + | AddedUpdate -> "Added" + | RemovedUpdate -> "Remove" + | ModifiedUpdate -> "Modified") + t.table_id + (FlowRemoved.Reason.to_string t.reason) + (match t.idle_timeout with + | Permanent -> "Permanent" + | ExpiresAfter v -> string_of_int v) + (match t.hard_timeout with + | Permanent -> "Permanent" + | ExpiresAfter v -> string_of_int v) + t.priority + t.cookie + (OfpMatch.to_string t.updateMatch) + (Instructions.to_string t.instructions) + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_flow_update_full_length buf (sizeof t); + set_ofp_flow_update_full_event buf ( + match t.event with + | InitialUpdate -> ofp_flow_update_event_to_int OFPFME_INITIAL + | AddedUpdate -> ofp_flow_update_event_to_int OFPFME_ADDED + | RemovedUpdate -> ofp_flow_update_event_to_int OFPFME_REMOVED + | ModifiedUpdate -> ofp_flow_update_event_to_int OFPFME_MODIFIED); + set_ofp_flow_update_full_table_id buf t.table_id; + set_ofp_flow_update_full_reason buf (FlowRemoved.Reason.marshal t.reason); + set_ofp_flow_update_full_idle_timeout buf ( + match t.idle_timeout with + | Permanent -> 0 + | ExpiresAfter n -> n); + set_ofp_flow_update_full_hard_timeout buf ( + match t.hard_timeout with + | Permanent -> 0 + | ExpiresAfter n -> n); + set_ofp_flow_update_full_priority buf t.priority; + set_ofp_flow_update_full_cookie buf t.cookie; + let size = sizeof_ofp_flow_update_full + + OfpMatch.marshal + (Cstruct.sub buf sizeof_ofp_flow_update_full (OfpMatch.sizeof t.updateMatch)) + t.updateMatch in + size + Instructions.marshal (Cstruct.shift buf size) t.instructions + + let parse (bits : Cstruct.t) (e : updateEvent): t = + let event = e in + let table_id = get_ofp_flow_update_full_table_id bits in + let reason = FlowRemoved.Reason.parse (get_ofp_flow_update_full_reason bits) in + let idle_timeout = ( + match get_ofp_flow_update_full_idle_timeout bits with + | 0 -> Permanent + | n -> ExpiresAfter n) in + let hard_timeout = ( + match get_ofp_flow_update_full_hard_timeout bits with + | 0 -> Permanent + | n -> ExpiresAfter n) in + let priority = get_ofp_flow_update_full_priority bits in + let cookie = get_ofp_flow_update_full_cookie bits in + let updateMatch,instructionsBits = OfpMatch.parse (Cstruct.shift bits sizeof_ofp_flow_update_full) in + let instructions = Instructions.parse instructionsBits in + { event; table_id; reason; idle_timeout; hard_timeout; priority; cookie; updateMatch; instructions } + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_flow_update_full then None + else Some (get_ofp_flow_update_full_length buf) + + end + + module Abbrev = struct + + cstruct ofp_flow_update_abbrev { + uint16_t len; + uint16_t event; + uint32_t xid + } as big_endian + + type t = int32 + + let sizeof _ = + sizeof_ofp_flow_update_abbrev + + let to_string t = + Format.sprintf "{ xid = %lu }" t + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_flow_update_abbrev_len buf sizeof_ofp_flow_update_abbrev; + set_ofp_flow_update_abbrev_event buf (ofp_flow_update_event_to_int OFPFME_ABBREV); + set_ofp_flow_update_abbrev_xid buf t; + sizeof_ofp_flow_update_abbrev + + let parse (bits : Cstruct.t) : t = + get_ofp_flow_update_abbrev_xid bits + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_flow_update_abbrev then None + else Some sizeof_ofp_flow_update_abbrev + + end + + module Paused = struct + + cstruct ofp_flow_update_paused { + uint16_t len; + uint16_t event; + uint8_t zeros[4] + } as big_endian + + type t = pauseEvent + + let sizeof _ = + sizeof_ofp_flow_update_paused + + let to_string t = + match t with + | Pause -> "Pause" + | Resume -> "Resume" + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_flow_update_paused_len buf sizeof_ofp_flow_update_paused; + set_ofp_flow_update_paused_event buf ( + match t with + | Pause -> ofp_flow_update_event_to_int OFPFME_PAUSED + | Resume -> ofp_flow_update_event_to_int OFPFME_RESUMED); + sizeof_ofp_flow_update_paused + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_flow_update_paused then None + else Some (get_ofp_flow_update_paused_len buf) + + end + + cstruct ofp_flow_update_header { + uint16_t len; + uint16_t event; + } as big_endian + + type t = flowMonitorReply + + let sizeof (t : t) = + match t with + | FmUpdateFull u -> UpdateFull.sizeof u + | FmAbbrev a -> Abbrev.sizeof a + | FmPaused p -> Paused.sizeof p + + let to_string (t : t) = + match t with + | FmUpdateFull u -> UpdateFull.to_string u + | FmAbbrev a -> Format.sprintf "Abbrev : %s" (Abbrev.to_string a) + | FmPaused p -> Paused.to_string p + + let marshal (buf : Cstruct.t) (t : t) = + match t with + | FmUpdateFull u -> UpdateFull.marshal buf u + | FmAbbrev a -> Abbrev.marshal buf a + | FmPaused p -> Paused.marshal buf p + + let parse (bits : Cstruct.t) : t = + match int_to_ofp_flow_update_event (get_ofp_flow_update_header_event bits) with + | Some OFPFME_INITIAL -> FmUpdateFull (UpdateFull.parse bits InitialUpdate) + | Some OFPFME_ADDED -> FmUpdateFull (UpdateFull.parse bits AddedUpdate) + | Some OFPFME_REMOVED -> FmUpdateFull (UpdateFull.parse bits RemovedUpdate) + | Some OFPFME_MODIFIED -> FmUpdateFull (UpdateFull.parse bits ModifiedUpdate) + | Some OFPFME_ABBREV -> FmAbbrev (Abbrev.parse bits) + | Some OFPFME_PAUSED -> FmPaused Pause + | Some OFPFME_RESUMED -> FmPaused Resume + | None -> raise (Unparsable (sprintf "malformed event")) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_flow_update_header then None + else Some (get_ofp_flow_update_header_len buf) +end + +module MultipartReply = struct + + cstruct ofp_multipart_reply { + uint16_t typ; + uint16_t flags; + uint8_t pad[4]; + uint8_t body[0] + } as big_endian + + cenum ofp_multipart_reply_flags { + OFPMPF_REPLY_MORE = 1 (* More requests to follow. *) + } as uint16_t + + type t = multipartReply + + let sizeof (mpr : multipartReply) = + sizeof_ofp_multipart_reply + + match mpr.mpreply_typ with + | PortsDescReply pdr -> sum (map PortDesc.sizeof pdr) + | SwitchDescReply s -> SwitchDescriptionReply.sizeof s + | FlowStatsReply fsr -> sum (map FlowStats.sizeof fsr) + | AggregateReply ag -> AggregateStats.sizeof ag + | TableReply tr -> sum (map TableStats.sizeof tr) + | TableFeaturesReply tf -> sum (map TableFeature.sizeof tf) + | PortStatsReply psr -> sum (map PortStats.sizeof psr) + | QueueStatsReply qsr -> sum (map QueueStats.sizeof qsr) + | GroupStatsReply gs -> sum (map GroupStats.sizeof gs) + | GroupDescReply gd -> sum (map GroupDesc.sizeof gd) + | GroupFeaturesReply gf -> GroupFeatures.sizeof gf + | MeterReply mr -> sum (map MeterStats.sizeof mr) + | MeterConfig mc -> sum (map MeterConfig.sizeof mc) + | MeterFeaturesReply mf -> MeterFeatures.sizeof mf + | TableDescReply t -> sum (map TableDescReply.sizeof t) + | QueueDescReply q -> sum (map QueueDescReply.sizeof q) + | FlowMonitorReply f -> sum (map FlowMonitorReply.sizeof f) + + let to_string (mpr : multipartReply) = + match mpr.mpreply_typ with + | PortsDescReply pdr -> Format.sprintf "PortsDescReply { %s }" (String.concat "; " (map PortDesc.to_string pdr)) + | SwitchDescReply sdc -> Format.sprintf "SwitchDescReply %s" (SwitchDescriptionReply.to_string sdc) + | FlowStatsReply fsr -> Format.sprintf "Flow { %s }" (String.concat "; " (map FlowStats.to_string fsr)) + | AggregateReply ag -> Format.sprintf "Aggregate Flow %s" (AggregateStats.to_string ag) + | TableReply tr -> Format.sprintf "TableReply { %s }" (String.concat "; " (map TableStats.to_string tr)) + | TableFeaturesReply tf -> Format.sprintf "TableFeaturesReply { %s }" (String.concat "; " (map TableFeature.to_string tf)) + | PortStatsReply psr -> Format.sprintf "PortStatsReply { %s }" (String.concat "; " (map PortStats.to_string psr)) + | QueueStatsReply qsr -> Format.sprintf "QueueStats { %s }" (String.concat "; " (map QueueStats.to_string qsr)) + | GroupStatsReply gs -> Format.sprintf "GroupStats { %s }" (String.concat "; " (map GroupStats.to_string gs)) + | GroupDescReply gd -> Format.sprintf "GroupSDesc { %s }" (String.concat "; " (map GroupDesc.to_string gd)) + | GroupFeaturesReply gf -> Format.sprintf "GroupFeatures %s" (GroupFeatures.to_string gf) + | MeterReply mr -> Format.sprintf "MeterStats { %s }" (String.concat "; " (map MeterStats.to_string mr)) + | MeterConfig mc -> Format.sprintf "MeterConfig { %s }" (String.concat "; " (map MeterConfig.to_string mc)) + | MeterFeaturesReply mf -> Format.sprintf "MeterFeaturesStats %s" (MeterFeatures.to_string mf) + | TableDescReply t -> Format.sprintf "TableDescReply { %s }" (String.concat "; " (map TableDescReply.to_string t)) + | QueueDescReply q -> Format.sprintf "QueueDescReply { %s }" (String.concat "; " (map QueueDescReply.to_string q)) + | FlowMonitorReply f -> Format.sprintf "FlowMonitorReply { %s }" (String.concat "; " (map FlowMonitorReply.to_string f)) + + let marshal (buf : Cstruct.t) (mpr : multipartReply) : int = + let ofp_body_bits = Cstruct.shift buf sizeof_ofp_multipart_reply in + set_ofp_multipart_reply_flags buf ( + match mpr.mpreply_flags with + | true -> ofp_multipart_reply_flags_to_int OFPMPF_REPLY_MORE + | false -> 0); + sizeof_ofp_multipart_reply + (match mpr.mpreply_typ with + | PortsDescReply pdr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_PORT_DESC); + marshal_fields ofp_body_bits pdr PortDesc.marshal + | SwitchDescReply sdr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_DESC); + SwitchDescriptionReply.marshal ofp_body_bits sdr + | FlowStatsReply fsr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_FLOW); + marshal_fields ofp_body_bits fsr FlowStats.marshal + | AggregateReply ar -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_AGGREGATE); + AggregateStats.marshal ofp_body_bits ar + | TableReply tr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_TABLE); + marshal_fields ofp_body_bits tr TableStats.marshal + | TableFeaturesReply tf -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_TABLE_FEATURES); + marshal_fields ofp_body_bits tf TableFeature.marshal + | PortStatsReply psr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_PORT_STATS); + marshal_fields ofp_body_bits psr PortStats.marshal + | QueueStatsReply qsr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_QUEUE); + marshal_fields ofp_body_bits qsr QueueStats.marshal + | GroupStatsReply gs -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_GROUP); + marshal_fields ofp_body_bits gs GroupStats.marshal + | GroupDescReply gd -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_GROUP_DESC); + marshal_fields ofp_body_bits gd GroupDesc.marshal + | GroupFeaturesReply gf -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_GROUP_FEATURES); + GroupFeatures.marshal ofp_body_bits gf + | MeterReply mr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_METER); + marshal_fields ofp_body_bits mr MeterStats.marshal + | MeterConfig mc -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_METER_CONFIG); + marshal_fields ofp_body_bits mc MeterConfig.marshal + | MeterFeaturesReply mfr -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_METER_FEATURES); + MeterFeatures.marshal ofp_body_bits mfr + | TableDescReply t -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_TABLE_DESC); + marshal_fields ofp_body_bits t TableDescReply.marshal + | QueueDescReply q -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_QUEUE_DESC); + marshal_fields ofp_body_bits q QueueDescReply.marshal + | FlowMonitorReply f -> + set_ofp_multipart_reply_typ buf (ofp_multipart_types_to_int OFPMP_FLOW_MONITOR); + marshal_fields ofp_body_bits f FlowMonitorReply.marshal + ) + + let parse (bits : Cstruct.t) : multipartReply = + let ofp_body_bits = Cstruct.shift bits sizeof_ofp_multipart_reply in + let typ = (match int_to_ofp_multipart_types (get_ofp_multipart_reply_typ bits) with + | Some OFPMP_PORT_DESC -> + PortsDescReply (parse_fields ofp_body_bits PortDesc.parse PortDesc.length_func) + | Some OFPMP_DESC -> + SwitchDescReply (SwitchDescriptionReply.parse ofp_body_bits) + | Some OFPMP_FLOW -> + FlowStatsReply (parse_fields ofp_body_bits FlowStats.parse FlowStats.length_func) + | Some OFPMP_AGGREGATE -> + AggregateReply (AggregateStats.parse ofp_body_bits) + | Some OFPMP_TABLE -> + TableReply (parse_fields ofp_body_bits TableStats.parse TableStats.length_func) + | Some OFPMP_TABLE_FEATURES -> + TableFeaturesReply (parse_fields ofp_body_bits TableFeature.parse TableFeature.length_func) + | Some OFPMP_PORT_STATS -> + PortStatsReply (parse_fields ofp_body_bits PortStats.parse PortStats.length_func) + | Some OFPMP_QUEUE -> + QueueStatsReply (parse_fields ofp_body_bits QueueStats.parse QueueStats.length_func) + | Some OFPMP_GROUP -> + GroupStatsReply (parse_fields ofp_body_bits GroupStats.parse GroupStats.length_func) + | Some OFPMP_GROUP_DESC -> + GroupDescReply (parse_fields ofp_body_bits GroupDesc.parse GroupDesc.length_func) + | Some OFPMP_GROUP_FEATURES -> + GroupFeaturesReply (GroupFeatures.parse ofp_body_bits) + | Some OFPMP_METER -> + MeterReply (parse_fields ofp_body_bits MeterStats.parse MeterStats.length_func) + | Some OFPMP_METER_CONFIG -> + MeterConfig (parse_fields ofp_body_bits MeterConfig.parse MeterConfig.length_func) + | Some OFPMP_METER_FEATURES -> + MeterFeaturesReply (MeterFeatures.parse ofp_body_bits) + | Some OFPMP_QUEUE_DESC -> + QueueDescReply (parse_fields ofp_body_bits QueueDescReply.parse QueueDescReply.length_func) + | Some OFPMP_TABLE_DESC -> + TableDescReply (parse_fields ofp_body_bits TableDescReply.parse TableDescReply.length_func) + | Some OFPMP_FLOW_MONITOR -> + FlowMonitorReply (parse_fields ofp_body_bits FlowMonitorReply.parse FlowMonitorReply.length_func) + | _ -> raise (Unparsable (sprintf "NYI: can't parse this multipart reply"))) in + let flags = ( + match int_to_ofp_multipart_reply_flags (get_ofp_multipart_reply_flags bits) with + | Some OFPMPF_REPLY_MORE -> true + | _ -> false) in + {mpreply_typ = typ; mpreply_flags = flags} + +end + +module PacketOut = OpenFlow0x04.PacketOut + +module RoleRequest = OpenFlow0x04.RoleRequest + +module BundleProp = struct + + cenum ofp_bundle_prop_type { + OFPBPT_EXPERIMENTER = 0xFFFF + } as uint16_t + + cstruct ofp_bundle_prop_header { + uint16_t typ; + uint16_t len + } as big_endian + + module Experimenter = struct + cstruct ofp_bundle_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_bundle_prop_experimenter + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_bundle_prop_experimenter_typ buf (ofp_bundle_prop_type_to_int OFPBPT_EXPERIMENTER); + set_ofp_bundle_prop_experimenter_len buf sizeof_ofp_bundle_prop_experimenter; + set_ofp_bundle_prop_experimenter_experimenter buf t.experimenter; + set_ofp_bundle_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_bundle_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_bundle_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_bundle_prop_experimenter_exp_typ bits} + + end + + type t = bundleProp + + let sizeof (t : t) : int = + match t with + | BundleExperimenter e -> Experimenter.sizeof e + + let to_string (t : t) : string = + match t with + | BundleExperimenter e -> Format.sprintf "Experimenter : %s" (Experimenter.to_string e) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_bundle_prop_header then None + else Some (get_ofp_bundle_prop_header_len buf) + + let marshal (buf : Cstruct.t) (t : t) = + match t with + | BundleExperimenter e -> Experimenter.marshal buf e + + let parse (bits : Cstruct.t) : t = + let typ = match int_to_ofp_bundle_prop_type (get_ofp_bundle_prop_header_typ bits) with + | Some v -> v + | None -> raise (Unparsable (sprintf "malformed prop typ")) in + match typ with + | OFPBPT_EXPERIMENTER -> BundleExperimenter (Experimenter.parse bits) +end + +module BundleFlags = struct + + type t = bundleFlags + + let to_string (t : t) = + Format.sprintf "{ atomic = %B; ordered = %B }" + t.atomic + t.ordered + + let marshal (f : t) = + (if f.atomic then 1 lsl 0 else 0) lor + (if f.ordered then 1 lsl 1 else 0) + + let parse bits : t = + { atomic = test_bit16 0 bits + ; ordered = test_bit16 1 bits } + +end + +module BundleCtrl = struct + + cstruct ofp_bundle_ctrl_msg { + uint32_t bundle_id; + uint16_t typ; + uint16_t flags + } as big_endian + + cenum ofp_bundle_ctrl_type { + OFPBCT_OPEN_REQUEST = 0; + OFPBCT_OPEN_REPLY = 1; + OFPBCT_CLOSE_REQUEST = 2; + OFPBCT_CLOSE_REPLY = 3; + OFPBCT_COMMIT_REQUEST = 4; + OFPBCT_COMMIT_REPLY = 5; + OFPBCT_DISCARD_REQUEST = 6; + OFPBCT_DISCARD_REPLY = 7 + } as uint16_t + + type t = bundleCtrl + + let sizeof (t : t) = + sizeof_ofp_bundle_ctrl_msg + sum (map BundleProp.sizeof t.properties) + + let to_string (t : t) = + Format.sprintf "{ bundle_id = %lu; typ = %s; flags = %s; properties = %s }" + t.bundle_id + (match t.typ with + | OpenReq -> "OpenReq" + | OpenReply -> "OpenReply" + | CloseReq -> "CloseReq" + | CloseReply -> "CloseReply" + | CommitReq -> "CommitReq" + | CommitReply -> "CommitReply" + | DiscardReq -> "DiscardReq" + | DiscardReply -> "DiscardReply") + (BundleFlags.to_string t.flags) + ("[ " ^ (String.concat "; " (map BundleProp.to_string t.properties)) ^ " ]") + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_bundle_ctrl_msg_bundle_id buf t.bundle_id; + set_ofp_bundle_ctrl_msg_typ buf ( + match t.typ with + | OpenReq -> ofp_bundle_ctrl_type_to_int OFPBCT_OPEN_REQUEST + | OpenReply -> ofp_bundle_ctrl_type_to_int OFPBCT_OPEN_REPLY + | CloseReq -> ofp_bundle_ctrl_type_to_int OFPBCT_CLOSE_REQUEST + | CloseReply -> ofp_bundle_ctrl_type_to_int OFPBCT_CLOSE_REPLY + | CommitReq -> ofp_bundle_ctrl_type_to_int OFPBCT_COMMIT_REQUEST + | CommitReply -> ofp_bundle_ctrl_type_to_int OFPBCT_COMMIT_REPLY + | DiscardReq -> ofp_bundle_ctrl_type_to_int OFPBCT_DISCARD_REQUEST + | DiscardReply -> ofp_bundle_ctrl_type_to_int OFPBCT_DISCARD_REPLY); + set_ofp_bundle_ctrl_msg_flags buf (BundleFlags.marshal t.flags); + sizeof_ofp_bundle_ctrl_msg + marshal_fields (Cstruct.shift buf sizeof_ofp_bundle_ctrl_msg) t.properties BundleProp.marshal + + let parse (bits : Cstruct.t) : t = + { bundle_id = get_ofp_bundle_ctrl_msg_bundle_id bits + ; typ = (match int_to_ofp_bundle_ctrl_type (get_ofp_bundle_ctrl_msg_typ bits) with + | Some OFPBCT_OPEN_REQUEST -> OpenReq + | Some OFPBCT_OPEN_REPLY -> OpenReply + | Some OFPBCT_CLOSE_REQUEST -> CloseReq + | Some OFPBCT_CLOSE_REPLY -> CloseReply + | Some OFPBCT_COMMIT_REQUEST -> CommitReq + | Some OFPBCT_COMMIT_REPLY -> CommitReply + | Some OFPBCT_DISCARD_REQUEST -> DiscardReq + | Some OFPBCT_DISCARD_REPLY -> DiscardReply + | None -> raise (Unparsable (sprintf "malformed bundle controle type"))) + ; flags = BundleFlags.parse (get_ofp_bundle_ctrl_msg_flags bits) + ; properties = parse_fields (Cstruct.shift bits sizeof_ofp_bundle_ctrl_msg) BundleProp.parse BundleProp.length_func + } + +end + +module BundleAdd = struct + + cstruct ofp_bundle_add_msg { + uint32_t bundle_id; + uint16_t pad; + uint16_t flags + } as big_endian + +(* type t = 'a bundleAdd*) + + module Header = OpenFlow_Header + + let sizeof (t : 'a bundleAdd) (sizeof_fn : 'a -> int)= + sizeof_ofp_bundle_add_msg + (sizeof_fn t.message) + sum (map BundleProp.sizeof t.properties) + + let to_string (t : 'a bundleAdd) (to_string_fn : 'a -> string)= + Format.sprintf "{ bundle_id = %lu; flags = %s; message = %s; properties = %s }" + t.bundle_id + (BundleFlags.to_string t.flags) + (to_string_fn t.message) + ("[ " ^ (String.concat "; " (map BundleProp.to_string t.properties)) ^ " ]") + + let marshal (buf : Cstruct.t) (t : 'a bundleAdd) (marshal_fn : 'a -> Cstruct.t -> int) (header_of : xid -> 'a -> Header.t)= + let open OpenFlow_Header in + set_ofp_bundle_add_msg_bundle_id buf t.bundle_id; + set_ofp_bundle_add_msg_flags buf (BundleFlags.marshal t.flags); + let hdr = header_of t.xid t.message in + Header.marshal (Cstruct.shift buf sizeof_ofp_bundle_add_msg) hdr; + let body_buf = Cstruct.shift buf (sizeof_ofp_bundle_add_msg + Header.size)in + let message_size = marshal_fn t.message body_buf in + let prop_buf = (Cstruct.shift body_buf message_size) in + sizeof_ofp_bundle_add_msg + message_size + marshal_fields prop_buf t.properties BundleProp.marshal + + let parse (bits : Cstruct.t) (parse_fn : Header.t -> string -> xid * 'a) (sizeof_fn : 'a -> int) : 'a bundleAdd = + let open OpenFlow_Header in + let bundle_id = get_ofp_bundle_add_msg_bundle_id bits in + let flags = BundleFlags.parse (get_ofp_bundle_add_msg_flags bits) in + let message_bits = Cstruct.shift bits (sizeof_ofp_bundle_add_msg + Header.size) in + let hdr = Header.parse (Cstruct.shift bits (sizeof_ofp_bundle_add_msg)) in + let xid = hdr.xid in + let _,message = parse_fn hdr (Cstruct.to_string message_bits) in + let sizeof_msg = sizeof_fn message in + let properties = parse_fields (Cstruct.shift message_bits sizeof_msg) BundleProp.parse BundleProp.length_func in + { bundle_id; flags; xid; message; properties } + +end + +module AsyncConfig = struct + + module Properties = struct + + cenum ofp_async_config_prop_type { + OFPACPT_PACKET_IN_SLAVE = 0; + OFPACPT_PACKET_IN_MASTER = 1; + OFPACPT_PORT_STATUS_SLAVE = 2; + OFPACPT_PORT_STATUS_MASTER = 3; + OFPACPT_FLOW_REMOVED_SLAVE = 4; + OFPACPT_FLOW_REMOVED_MASTER = 5; + OFPACPT_ROLE_STATUS_SLAVE = 6; + OFPACPT_ROLE_STATUS_MASTER = 7; + OFPACPT_TABLE_STATUS_SLAVE = 8; + OFPACPT_TABLE_STATUS_MASTER = 9; + OFPACPT_REQUESTFORWARD_SLAVE = 10; + OFPACPT_REQUESTFORWARD_MASTER = 11; + OFPTFPT_EXPERIMENTER_SLAVE = 0xFFFE; + OFPTFPT_EXPERIMENTER_MASTER = 0xFFFF + } as uint16_t + + module PacketIn = struct + + type t = packetInReasonMap + + let to_string (t : t) = + Format.sprintf "{ table_miss = %B; apply_action = %B; invalid_ttl = %B \ + action_set = %B; group = %B; packet_out = %B }" + t.table_miss + t.apply_action + t.invalid_ttl + t.action_set + t.group + t.packet_out + + let marshal (t : t) : int8 = + (if t.table_miss then 1 lsl 0 else 0) lor + (if t.apply_action then 1 lsl 1 else 0) lor + (if t.invalid_ttl then 1 lsl 2 else 0) lor + (if t.action_set then 1 lsl 3 else 0) lor + (if t.group then 1 lsl 4 else 0) lor + (if t.packet_out then 1 lsl 5 else 0) + + let parse bits : t = + { table_miss = test_bit16 0 bits + ; apply_action = test_bit16 1 bits + ; invalid_ttl = test_bit16 2 bits + ; action_set = test_bit16 3 bits + ; group = test_bit16 4 bits + ; packet_out = test_bit16 5 bits} + + end + + module PortStatus = struct + + type t = portStatusReasonMap + + let to_string (t : t) = + Format.sprintf "{ add = %B; delete = %B; modify = %B }" + t.add + t.delete + t.modify + + let marshal (t : t) : int8 = + (if t.add then 1 lsl 0 else 0) lor + (if t.delete then 1 lsl 1 else 0) lor + (if t.modify then 1 lsl 2 else 0) + + let parse bits : t = + { add = test_bit16 0 bits + ; delete = test_bit16 1 bits + ; modify = test_bit16 2 bits } + + end + + module FlowRemoved = struct + + type t = flowRemovedReasonMap + + let to_string (t : t) = + Format.sprintf "{ idle_timeout = %B; hard_timeout = %B; delete = %B; \ + group_delete = %B; meter_delete = %B; eviction = %B }" + t.idle_timeout + t.hard_timeout + t.delete + t.group_delete + t.meter_delete + t.eviction + + let marshal (t : t) : int8 = + (if t.idle_timeout then 1 lsl 0 else 0) lor + (if t.hard_timeout then 1 lsl 1 else 0) lor + (if t.delete then 1 lsl 2 else 0) lor + (if t.group_delete then 1 lsl 3 else 0) lor + (if t.meter_delete then 1 lsl 4 else 0) lor + (if t.eviction then 1 lsl 5 else 0) + + let parse bits : t = + { idle_timeout = test_bit16 0 bits + ; hard_timeout = test_bit16 1 bits + ; delete = test_bit16 2 bits + ; group_delete = test_bit16 3 bits + ; meter_delete = test_bit16 4 bits + ; eviction = test_bit16 5 bits} + + end + + module RoleStatus = struct + + type t = roleStatusReasonMap + + let to_string (t : t) = + Format.sprintf "{ master_request = %B; config = %B; experimenter = %B }" + t.master_request + t.config + t.experimenter + + let marshal (t : t) : int8 = + (if t.master_request then 1 lsl 0 else 0) lor + (if t.config then 1 lsl 1 else 0) lor + (if t.experimenter then 1 lsl 2 else 0) + + let parse bits : t = + { master_request = test_bit16 0 bits + ; config = test_bit16 1 bits + ; experimenter = test_bit16 2 bits } + + end + + module TableStatus = struct + + type t = tableStatusReasonMap + + let to_string (t : t) = + Format.sprintf "{ vacancy_down = %B; vacancy_up = %B}" + t.vacancy_down + t.vacancy_up + + let marshal (t : t) : int8 = + (if t.vacancy_down then 1 lsl 3 else 0) lor + (if t.vacancy_up then 1 lsl 4 else 0) + + let parse bits : t = + { vacancy_down = test_bit16 3 bits + ; vacancy_up = test_bit16 4 bits } + + end + + module RequestForward = struct + + type t = requestedForwardReasonMap + + let to_string (t : t) = + Format.sprintf "{ group_mod = %B; meter_mod = %B}" + t.group_mod + t.meter_mod + + let marshal (t : t) : int8 = + (if t.group_mod then 1 lsl 0 else 0) lor + (if t.meter_mod then 1 lsl 1 else 0) + + let parse bits : t = + { group_mod = test_bit16 0 bits + ; meter_mod = test_bit16 1 bits } + + end + + cstruct ofp_async_config_prop_header { + uint16_t typ; + uint16_t len; + } as big_endian + + cstruct ofp_async_config_prop_reasons { + uint16_t typ; + uint16_t len; + uint32_t mask; + } as big_endian + + type t = asyncProp + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_async_config_prop_header then None + else Some (get_ofp_async_config_prop_header_len buf) + + + let sizeof (t : t) = + match t with + | AsyncReasonPacketInSlave _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonPacketInMaster _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonPortStatusSlave _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonPortStatusMaster _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonFlowRemovedSlave _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonFlowRemovedMaster _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonRoleStatusSlave _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonRoleStatusMaster _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonTableStatusSlave _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonTableStatusMaster _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonRequestedForwardSlave _ -> sizeof_ofp_async_config_prop_reasons + | AsyncReasonRequestedForwardMaster _ -> sizeof_ofp_async_config_prop_reasons + | AsyncExperimenterSlave async -> sizeof_ofp_async_config_prop_header + Experimenter.sizeof async + | AsyncExperimenterMaster async -> sizeof_ofp_async_config_prop_header + Experimenter.sizeof async + + let to_string (t : t) = + match t with + | AsyncReasonPacketInSlave async -> Format.sprintf "PacketInSlave = %s" (PacketIn.to_string async) + | AsyncReasonPacketInMaster async -> Format.sprintf "PacketInMaster = %s" (PacketIn.to_string async) + | AsyncReasonPortStatusSlave async -> Format.sprintf "PortStatusSlave = %s" (PortStatus.to_string async) + | AsyncReasonPortStatusMaster async -> Format.sprintf "PortStatusMaster = %s" (PortStatus.to_string async) + | AsyncReasonFlowRemovedSlave async -> Format.sprintf "FlowRemovedSlave = %s" (FlowRemoved.to_string async) + | AsyncReasonFlowRemovedMaster async -> Format.sprintf "FlowRemovedMaster = %s" (FlowRemoved.to_string async) + | AsyncReasonRoleStatusSlave async -> Format.sprintf "RoleStatusSlave = %s" (RoleStatus.to_string async) + | AsyncReasonRoleStatusMaster async -> Format.sprintf "RoleStatusMaster = %s" (RoleStatus.to_string async) + | AsyncReasonTableStatusSlave async -> Format.sprintf "TableStatusInSlave = %s" (TableStatus.to_string async) + | AsyncReasonTableStatusMaster async -> Format.sprintf "TableStatusMaster = %s" (TableStatus.to_string async) + | AsyncReasonRequestedForwardSlave async -> Format.sprintf "RequestForwardSlave = %s" (RequestForward.to_string async) + | AsyncReasonRequestedForwardMaster async -> Format.sprintf "RequestForwardMaster = %s" (RequestForward.to_string async) + | AsyncExperimenterSlave async -> Format.sprintf "Experimenter = %s" (Experimenter.to_string async) + | AsyncExperimenterMaster async -> Format.sprintf "Experimenter = %s" (Experimenter.to_string async) + + let marshal (buf : Cstruct.t) (t : t) : int = + match t with + | AsyncReasonPacketInSlave async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_PACKET_IN_SLAVE); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (PacketIn.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonPacketInMaster async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_PACKET_IN_MASTER); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (PacketIn.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonPortStatusSlave async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_PORT_STATUS_SLAVE); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (PortStatus.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonPortStatusMaster async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_PORT_STATUS_MASTER); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (PortStatus.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonFlowRemovedSlave async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_FLOW_REMOVED_SLAVE); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (FlowRemoved.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonFlowRemovedMaster async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_FLOW_REMOVED_MASTER); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (FlowRemoved.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonRoleStatusSlave async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_ROLE_STATUS_SLAVE); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (RoleStatus.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonRoleStatusMaster async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_ROLE_STATUS_MASTER); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (RoleStatus.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonTableStatusSlave async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_TABLE_STATUS_SLAVE); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (TableStatus.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonTableStatusMaster async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_TABLE_STATUS_MASTER); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (TableStatus.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonRequestedForwardSlave async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_REQUESTFORWARD_SLAVE); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (RequestForward.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncReasonRequestedForwardMaster async -> + set_ofp_async_config_prop_reasons_typ buf (ofp_async_config_prop_type_to_int OFPACPT_REQUESTFORWARD_MASTER); + set_ofp_async_config_prop_reasons_len buf sizeof_ofp_async_config_prop_reasons; + set_ofp_async_config_prop_reasons_mask buf (Int32.of_int (RequestForward.marshal async)); + sizeof_ofp_async_config_prop_reasons + | AsyncExperimenterSlave async -> + set_ofp_async_config_prop_header_typ buf (ofp_async_config_prop_type_to_int OFPTFPT_EXPERIMENTER_SLAVE); + set_ofp_async_config_prop_header_len buf (sizeof_ofp_async_config_prop_header + Experimenter.sizeof async); + sizeof_ofp_async_config_prop_header + Experimenter.marshal (Cstruct.shift buf sizeof_ofp_async_config_prop_header) async + | AsyncExperimenterMaster async -> + set_ofp_async_config_prop_header_typ buf (ofp_async_config_prop_type_to_int OFPTFPT_EXPERIMENTER_MASTER); + set_ofp_async_config_prop_header_len buf (sizeof_ofp_async_config_prop_header + Experimenter.sizeof async); + sizeof_ofp_async_config_prop_header + Experimenter.marshal (Cstruct.shift buf sizeof_ofp_async_config_prop_header) async + + let parse (bits : Cstruct.t) : t = + match int_to_ofp_async_config_prop_type (get_ofp_async_config_prop_header_typ bits) with + | Some OFPACPT_PACKET_IN_SLAVE -> + AsyncReasonPacketInSlave (PacketIn.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_PACKET_IN_MASTER -> + AsyncReasonPacketInMaster (PacketIn.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_PORT_STATUS_SLAVE -> + AsyncReasonPortStatusSlave (PortStatus.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_PORT_STATUS_MASTER -> + AsyncReasonPortStatusMaster (PortStatus.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_FLOW_REMOVED_SLAVE -> + AsyncReasonFlowRemovedSlave (FlowRemoved.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_FLOW_REMOVED_MASTER -> + AsyncReasonFlowRemovedMaster (FlowRemoved.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_ROLE_STATUS_SLAVE -> + AsyncReasonRoleStatusSlave (RoleStatus.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_ROLE_STATUS_MASTER -> + AsyncReasonRoleStatusMaster (RoleStatus.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_TABLE_STATUS_SLAVE -> + AsyncReasonTableStatusSlave (TableStatus.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_TABLE_STATUS_MASTER -> + AsyncReasonTableStatusMaster (TableStatus.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_REQUESTFORWARD_SLAVE -> + AsyncReasonRequestedForwardSlave (RequestForward.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPACPT_REQUESTFORWARD_MASTER -> + AsyncReasonRequestedForwardMaster (RequestForward.parse (Int32.to_int (get_ofp_async_config_prop_reasons_mask bits))) + | Some OFPTFPT_EXPERIMENTER_SLAVE -> + AsyncExperimenterSlave (Experimenter.parse (Cstruct.shift bits sizeof_ofp_async_config_prop_header)) + | Some OFPTFPT_EXPERIMENTER_MASTER -> + AsyncExperimenterMaster (Experimenter.parse (Cstruct.shift bits sizeof_ofp_async_config_prop_header)) + | None -> raise (Unparsable (sprintf "malfomed async config type")) + + end + + type t = asyncConfig + + let sizeof (async : t) : int = + sum (map Properties.sizeof async) + + let to_string (async : t) : string = + "[ " ^ (String.concat "; " (map Properties.to_string async)) ^ " ]" + + let marshal (buf : Cstruct.t) (async : t) : int = + marshal_fields buf async Properties.marshal + + let parse (bits : Cstruct.t) : t = + parse_fields bits Properties.parse Properties.length_func + +end + +(* Asynchronous messages *) + +module PacketIn = struct + + module Reason = struct + + cenum ofp_packet_in_reason { + OFPR_TABLE_MISS = 0; + OFPR_APPLY_ACTION = 1; + OFPR_INVALID_TTL = 2; + OFPR_ACTION_SET = 3; + OFPR_GROUP = 4; + OFPR_PACKET_OUT = 5 + } as uint8_t + + type t = packetInReason + + let to_string t : string = + match t with + | NoMatch -> "NO_MATCH" + | ExplicitSend -> "ACTION" + | InvalidTTL -> "INVALID_TTL" + | ActionSet -> "ActionSet" + | Group -> "Group" + | PacketOut -> "PacketOut" + + let marshal t : int = + match t with + | NoMatch -> ofp_packet_in_reason_to_int OFPR_TABLE_MISS + | ExplicitSend -> ofp_packet_in_reason_to_int OFPR_APPLY_ACTION + | InvalidTTL -> ofp_packet_in_reason_to_int OFPR_INVALID_TTL + | ActionSet -> ofp_packet_in_reason_to_int OFPR_ACTION_SET + | Group -> ofp_packet_in_reason_to_int OFPR_GROUP + | PacketOut -> ofp_packet_in_reason_to_int OFPR_PACKET_OUT + + + let parse bits : t = + match int_to_ofp_packet_in_reason bits with + | Some OFPR_TABLE_MISS -> NoMatch + | Some OFPR_APPLY_ACTION -> ExplicitSend + | Some OFPR_INVALID_TTL -> InvalidTTL + | Some OFPR_ACTION_SET -> ActionSet + | Some OFPR_GROUP -> Group + | Some OFPR_PACKET_OUT -> PacketOut + | None -> raise (Unparsable (sprintf "bad reason in packet_in (%d)" bits)) + end + + cstruct ofp_packet_in { + uint32_t buffer_id; + uint16_t total_len; + uint8_t reason; + uint8_t table_id; + uint64_t cookie + } as big_endian + + type t = packetIn + + let sizeof (pi : t) : int = + pi.pi_total_len + (OfpMatch.sizeof pi.pi_ofp_match) + sizeof_ofp_packet_in + 2 (*2 bytes of pad*) + + let to_string (pi: t) : string = + Format.sprintf "{ total_len = %u; reason = %s; table_id = %u; cookie = %Lu; match = %s; payload = %s }" + pi.pi_total_len + (Reason.to_string pi.pi_reason) + pi.pi_table_id + pi.pi_cookie + (OfpMatch.to_string pi.pi_ofp_match) + (match pi.pi_payload with + | Buffered (n,bytes) -> Format.sprintf "Buffered= %s; len = %u" n (Packet.to_string (Packet.parse bytes)) (Cstruct.len bytes) + | NotBuffered bytes -> Format.sprintf "NotBuffered = %s; len = %u" (Packet.to_string (Packet.parse bytes)) (Cstruct.len bytes)) + + let marshal (buf : Cstruct.t) (pi : t) : int = + let bufMatch = Cstruct.shift buf sizeof_ofp_packet_in in + let size = pi.pi_total_len + (OfpMatch.marshal bufMatch pi.pi_ofp_match) + + sizeof_ofp_packet_in in + let buffer_id,bytes = match pi.pi_payload with + | Buffered (n,bytes) -> n, bytes + | NotBuffered bytes -> -1l, bytes in + set_ofp_uint8_value (Cstruct.shift bufMatch (OfpMatch.sizeof pi.pi_ofp_match)) 0; (*pad*) + set_ofp_uint8_value (Cstruct.shift bufMatch (OfpMatch.sizeof pi.pi_ofp_match + 1)) 0; (*pad*) + Cstruct.blit bytes 0 bufMatch (2 + OfpMatch.sizeof pi.pi_ofp_match) pi.pi_total_len; + set_ofp_packet_in_buffer_id buf buffer_id; + set_ofp_packet_in_total_len buf pi.pi_total_len; + set_ofp_packet_in_reason buf (Reason.marshal pi.pi_reason); + set_ofp_packet_in_table_id buf pi.pi_table_id; + set_ofp_packet_in_cookie buf pi.pi_cookie; + size + + let parse (bits : Cstruct.t) : t = + (* let oc = open_out "test-msg-1.3-msg3-bits" in *) + (* let str = Cstruct.to_string bits in *) + (* fprintf oc "%s" str; *) + (* close_out oc; *) + let bufId = match get_ofp_packet_in_buffer_id bits with + | -1l -> None + | n -> Some n in + let total_len = get_ofp_packet_in_total_len bits in + let reason_code = get_ofp_packet_in_reason bits in + let reason = Reason.parse (reason_code) in + let table_id = get_ofp_packet_in_table_id bits in + let cookie = get_ofp_packet_in_cookie bits in + let ofp_match_bits = Cstruct.shift bits sizeof_ofp_packet_in in + let ofp_match, pkt_bits = OfpMatch.parse ofp_match_bits in + let pkt_bits = Cstruct.sub pkt_bits 2 total_len in (* pad bytes *) + let final_bits = Cstruct.create total_len in + (* create a new Cstruct to set the offset to 0 *) + Cstruct.blit pkt_bits 0 final_bits 0 total_len; + (* printf "len = %d\n" (Cstruct.len pkt_bits); *) + let pkt = match bufId with + | None -> NotBuffered final_bits + | Some n -> Buffered (n,final_bits) + in + { pi_total_len = total_len; + pi_reason = reason; + pi_table_id = table_id; + pi_cookie = cookie; + pi_ofp_match = ofp_match; + pi_payload = pkt + } + +end + +module PortStatus = OpenFlow0x04.PortStatus + +module RoleStatus = struct + + module Properties = struct + + cenum ofp_role_prop_type { + OFPRPT_EXPERIMENTER = 0xffff + } as uint16_t + + cstruct ofp_role_prop_header { + uint16_t typ; + uint16_t len + } as big_endian + + module Experimenter = struct + + cstruct ofp_role_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_role_prop_experimenter + + let marshal (buf : Cstruct.t) (t : t) : int = + set_ofp_role_prop_experimenter_typ buf (ofp_role_prop_type_to_int OFPRPT_EXPERIMENTER); + set_ofp_role_prop_experimenter_len buf sizeof_ofp_role_prop_experimenter; + set_ofp_role_prop_experimenter_experimenter buf t.experimenter; + set_ofp_role_prop_experimenter_exp_typ buf t.exp_typ; + sizeof_ofp_role_prop_experimenter + + let parse (bits : Cstruct.t) : t = + { experimenter = get_ofp_role_prop_experimenter_experimenter bits + ; exp_typ = get_ofp_role_prop_experimenter_exp_typ bits} + + end + + type t = roleStatusProp + + let sizeof (t : t) : int = + match t with + | RSPExperimenter e -> Experimenter.sizeof e + + let to_string (t : t) : string = + match t with + | RSPExperimenter e -> Format.sprintf "Experimenter : %s" (Experimenter.to_string e) + + let length_func (buf : Cstruct.t) : int option = + if Cstruct.len buf < sizeof_ofp_role_prop_header then None + else Some (get_ofp_role_prop_header_len buf) + + let marshal (buf : Cstruct.t) (t : t) = + match t with + | RSPExperimenter e -> Experimenter.marshal buf e + + let parse (bits : Cstruct.t) : t = + let typ = match int_to_ofp_role_prop_type (get_ofp_role_prop_header_typ bits) with + | Some v -> v + | None -> raise (Unparsable (sprintf "malformed prop typ")) in + match typ with + | OFPRPT_EXPERIMENTER -> RSPExperimenter (Experimenter.parse bits) + + end + + module Reason = struct + + cenum ofp_controller_role_reason { + OFPCRR_MASTER_REQUEST = 0; + OFPCRR_CONFIG = 1; + OFPCRR_EXPERIMENTER = 2 + } as uint8_t + + type t = roleStatusReason + + let to_string (t : t) = + match t with + | RSRMasterRequest -> "MasterRequest" + | RSRConfig -> "Config" + | RSRExperimenter -> "Experimenter" + + let marshal (t : t) : int8 = + match t with + | RSRMasterRequest -> ofp_controller_role_reason_to_int OFPCRR_MASTER_REQUEST + | RSRConfig -> ofp_controller_role_reason_to_int OFPCRR_CONFIG + | RSRExperimenter -> ofp_controller_role_reason_to_int OFPCRR_EXPERIMENTER + + let parse bits : t = + match int_to_ofp_controller_role_reason bits with + | Some OFPCRR_MASTER_REQUEST -> RSRMasterRequest + | Some OFPCRR_CONFIG -> RSRConfig + | Some OFPCRR_EXPERIMENTER -> RSRExperimenter + | None -> raise (Unparsable (sprintf "malformed reason")) + + end + + cstruct ofp_role_status { + uint32_t role; + uint8_t reason; + uint8_t pad[3]; + uint64_t generation_id; + } as big_endian + + type t = roleStatus + + let sizeof (t : t) = + sizeof_ofp_role_status + sum (map Properties.sizeof t.properties) + + let to_string (t : t) = + Format.sprintf "{ role = %s; reason = %s; generation_id = %Lu; properties = %s }" + (RoleRequest.Role.to_string t.role) + (Reason.to_string t.reason) + t.generation_id + ("[ " ^ (String.concat "; " (map Properties.to_string t.properties)) ^ " ]") + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_role_status_role buf (RoleRequest.Role.marshal t.role); + set_ofp_role_status_reason buf (Reason.marshal t.reason); + set_ofp_role_status_generation_id buf t.generation_id; + sizeof_ofp_role_status + marshal_fields (Cstruct.shift buf sizeof_ofp_role_status) t.properties Properties.marshal + + let parse (bits : Cstruct.t) : t = + { role = RoleRequest.Role.parse (get_ofp_role_status_role bits) + ; reason = Reason.parse (get_ofp_role_status_reason bits) + ; generation_id = get_ofp_role_status_generation_id bits + ; properties = parse_fields (Cstruct.shift bits sizeof_ofp_role_status) Properties.parse Properties.length_func + } +end + +module TableStatus = struct + + module Reason = struct + + cenum ofp_table_reason { + OFPTR_VACANCY_DOWN = 3; + OFPTR_VACANCY_UP = 4 + } as uint8_t + + type t = tableStatusReason + + let to_string (t : t) = + match t with + | VacancyDown -> "VacancyDown" + | VacancyUp -> "VacancyUp" + + let marshal (t : t) : int8 = + match t with + | VacancyDown -> ofp_table_reason_to_int OFPTR_VACANCY_DOWN + | VacancyUp -> ofp_table_reason_to_int OFPTR_VACANCY_UP + + let parse bits : t = + match int_to_ofp_table_reason bits with + | Some OFPTR_VACANCY_DOWN -> VacancyDown + | Some OFPTR_VACANCY_UP -> VacancyUp + | None -> raise (Unparsable (sprintf "malfomed reason")) + + end + + cstruct ofp_table_status { + uint8_t reason; + uint8_t pad[7]; + } as big_endian + + type t = tableStatus + + let sizeof (t : t) = + sizeof_ofp_table_status + (TableMod.sizeof t.table) + + let to_string (t : t) = + Format.sprintf "{ reason = %s; table = %s }" + (Reason.to_string t.reason) + (TableMod.to_string t.table) + + let marshal (buf : Cstruct.t) (t : t) = + set_ofp_table_status_reason buf (Reason.marshal t.reason); + sizeof_ofp_table_status + TableMod.marshal (Cstruct.shift buf sizeof_ofp_table_status) t.table + + let parse (bits : Cstruct.t) : t = + { reason = Reason.parse (get_ofp_table_status_reason bits) + ; table = TableMod.parse (Cstruct.shift bits sizeof_ofp_table_status) } + +end + +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 + | MultipartReq of MultipartReq.t + | MultipartReply of MultipartReply.t + | BarrierRequest + | BarrierReply + | PacketOutMsg of PacketOut.t + | RoleRequest of RoleRequest.t + | RoleReply of RoleRequest.t + | BundleControl of BundleCtrl.t + | BundleAdd of t bundleAdd + | GetAsyncRequest + | GetAsyncReply of AsyncConfig.t + | SetAsync of AsyncConfig.t + | PacketInMsg of PacketIn.t + | PortStatus of PortStatus.t + | RoleStatus of RoleStatus.t + | TableStatus of TableStatus.t + | RequestForward of t requestForward + + 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 + | MultipartReq _ -> MULTIPART_REQ + | MultipartReply _ -> MULTIPART_RESP + | BarrierRequest -> BARRIER_REQ + | BarrierReply -> BARRIER_RESP + | PacketOutMsg _ -> PACKET_OUT + | RoleRequest _ -> ROLE_REQ + | RoleReply _ -> ROLE_RESP + | BundleControl _ -> BUNDLE_CONTROL + | BundleAdd _ -> BUNDLE_ADD_MESSAGE + | GetAsyncRequest -> GET_ASYNC_REQ + | GetAsyncReply _ -> GET_ASYNC_REP + | SetAsync _ -> SET_ASYNC + | PacketInMsg _ -> PACKET_IN + | PortStatus _ -> PORT_STATUS + | RoleStatus _ -> ROLE_STATUS + | TableStatus _ -> TABLE_STATUS + | RequestForward _ -> REQUEST_FORWARD + + let rec 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 + | MultipartReq m -> Header.size + MultipartReq.sizeof m + | MultipartReply m -> Header.size + MultipartReply.sizeof m + | BarrierRequest -> Header.size + | BarrierReply -> Header.size + | PacketOutMsg p -> Header.size + PacketOut.sizeof p + | RoleRequest r -> Header.size + RoleRequest.sizeof r + | RoleReply r -> Header.size + RoleRequest.sizeof r + | BundleControl b -> Header.size + BundleCtrl.sizeof b + | BundleAdd b -> Header.size + BundleAdd.sizeof b sizeof + | GetAsyncRequest -> Header.size + | GetAsyncReply a -> Header.size + AsyncConfig.sizeof a + | SetAsync a -> Header.size + AsyncConfig.sizeof a + | PacketInMsg p -> Header.size + PacketIn.sizeof p + | PortStatus p -> Header.size + PortStatus.sizeof p + | RoleStatus r -> Header.size + RoleStatus.sizeof r + | TableStatus t -> Header.size + TableStatus.sizeof t + | RequestForward (_,t) -> Header.size + sizeof t + + 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" + | MultipartReq _ -> "MultipartReq" + | MultipartReply _ -> "MultipartReply" + | BarrierRequest -> "BarrierRequest" + | BarrierReply -> "BarrierReply" + | PacketOutMsg _ -> "PacketOutMsg" + | RoleRequest _ -> "RoleReq" + | RoleReply _ -> "RoleReply" + | BundleControl _ -> "BundleControl" + | BundleAdd _ -> "BundleAdd" + | GetAsyncRequest -> "GetAsyncRequest" + | GetAsyncReply _ -> "GetAsyncReply" + | SetAsync _ -> "SetAsync" + | PacketInMsg _ -> "PacketIn" + | PortStatus _ -> "PortStatus" + | RoleStatus _ -> "RoleStatus" + | TableStatus _ -> "TableStatus" + | RequestForward _ -> "RequestForward" + + 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 (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 rec 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 + | MultipartReq m -> + Header.size + MultipartReq.marshal out m + | MultipartReply m -> + Header.size + MultipartReply.marshal out m + | BarrierRequest -> + Header.size + | BarrierReply -> + Header.size + | PacketOutMsg p -> + Header.size + PacketOut.marshal out p + | RoleRequest r -> + Header.size + RoleRequest.marshal out r + | RoleReply r -> + Header.size + RoleRequest.marshal out r + | BundleControl b -> + Header.size + BundleCtrl.marshal out b + | BundleAdd b -> + Header.size + BundleAdd.marshal out b blit_message header_of + | GetAsyncRequest -> + Header.size + | GetAsyncReply a -> + Header.size + AsyncConfig.marshal out a + | SetAsync a -> + Header.size + AsyncConfig.marshal out a + | PacketInMsg p -> + Header.size + PacketIn.marshal out p + | PortStatus p -> + Header.size + PortStatus.marshal out p + | RoleStatus r -> + Header.size + RoleStatus.marshal out r + | TableStatus t -> + Header.size + TableStatus.marshal out t + | RequestForward (xid,t) -> + let hdr = header_of xid t in + Header.marshal out hdr; + Header.size + blit_message t (Cstruct.shift out Header.size) + + + 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 rec 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) + | MULTIPART_REQ -> MultipartReq (MultipartReq.parse body_bits) + | MULTIPART_RESP -> MultipartReply (MultipartReply.parse body_bits) + | PACKET_OUT -> PacketOutMsg (PacketOut.parse body_bits) + | ROLE_REQ -> RoleRequest (RoleRequest.parse body_bits) + | ROLE_RESP -> RoleReply (RoleRequest.parse body_bits) + | BUNDLE_CONTROL -> BundleControl (BundleCtrl.parse body_bits) + | BUNDLE_ADD_MESSAGE -> BundleAdd (BundleAdd.parse body_bits parse sizeof) + | GET_ASYNC_REP -> GetAsyncReply (AsyncConfig.parse body_bits) + | SET_ASYNC -> SetAsync (AsyncConfig.parse body_bits) + | PACKET_IN -> PacketInMsg (PacketIn.parse body_bits) + | PORT_STATUS -> PortStatus (PortStatus.parse body_bits) + | ROLE_STATUS -> RoleStatus (RoleStatus.parse body_bits) + | TABLE_STATUS -> TableStatus (TableStatus.parse body_bits) + | REQUEST_FORWARD -> RequestForward (parse (Header.parse body_bits) (Cstruct.to_string (Cstruct.shift body_bits Header.size))) + | 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..c5bef8e --- /dev/null +++ b/lib/OpenFlow0x05.mli @@ -0,0 +1,988 @@ +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 Capabilities : sig + + type t = capabilities + + val to_int32 : t -> int32 + + val to_string : t -> string + + val parse : int32 -> t + +end + + + +module SwitchFeatures : sig + + type t = switchFeatures + + 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 FlowRemoved : sig + + type t = flowRemoved + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + + +module FlowRequest : sig + + type t = flowRequest + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module QueueRequest : sig + + type t = queueRequest + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val sizeof : t -> int + + val to_string : t -> string + +end + +module TableFeature : sig + + type t = tableFeatures + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val to_string : t -> string + +end + +module QueueDescReq : sig + + type t = queueDescRequest + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val to_string : t -> string + +end + +module FlowMonitorRequest : sig + + type t = flowMonitorReq + + val sizeof : t -> int + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val to_string : t -> string + +end + +module MultipartReq : sig + + type t = multipartRequest + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module GroupStats : sig + + type t = groupStats + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module SwitchDescriptionReply : sig + + type t = switchDesc + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + + +module FlowStats : sig + + type t = flowStats + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + + +module AggregateStats : sig + + type t = aggregStats + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module TableStats : sig + + type t = tableStats + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module PortStats : sig + + module Properties : sig + + type t = portStatsProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + + end + + type t = portStats + + val sizeof : t-> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module QueueStats : sig + + module Properties : sig + + type t = queueStatsProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + + end + + type t = queueStats + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module GroupDesc : sig + + type t = groupDesc + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module GroupFeatures : sig + + type t = groupFeatures + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module MeterStats : sig + + type t = meterStats + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module MeterConfig : sig + + type t = meterConfig + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + + +module MeterFeatures : sig + + type t = meterFeatures + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module FlowMonitorReply : sig + + type t = flowMonitorReply + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module TableDescReply : sig + + type t = tableDescReply + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module QueueDescReply : sig + + module Properties : sig + + type t = queueDescProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + + end + + type t = queueDescReply + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module MultipartReply : sig + + type t = multipartReply + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module PacketOut : sig + + type t = packetOut + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module RoleRequest : sig + + module Role : sig + + type t = controllerRole + + val to_string : t -> string + + val marshal : t -> int32 + + val parse : int32 -> t + end + + type t = roleRequest + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module BundleProp : sig + + type t = bundleProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + +end + +module BundleCtrl : sig + + type t = bundleCtrl + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module BundleAdd : sig + + val sizeof : 'a bundleAdd -> ('a -> int) -> int + + val to_string : 'a bundleAdd -> ('a -> string) -> string + + val marshal : Cstruct.t -> 'a bundleAdd -> ('a -> Cstruct.t -> int) -> (xid -> 'a -> OpenFlow_Header.t) -> int + + val parse : Cstruct.t -> (OpenFlow_Header.t -> string -> xid * 'a) -> ('a -> int) -> 'a bundleAdd + +end + +module AsyncConfig : sig + + module Properties : sig + + type t = asyncProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + val length_func : Cstruct.t -> int option + + end + + type t = asyncConfig + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module PacketIn : sig + + type t = packetIn + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module PortStatus : sig + + type t = portStatus + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module RoleStatus : sig + + module Properties : sig + + type t = roleStatusProp + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + + end + + type t = roleStatus + + val sizeof : t -> int + + val to_string : t -> string + + val marshal : Cstruct.t -> t -> int + + val parse : Cstruct.t -> t + +end + +module TableStatus : sig + + type t = tableStatus + + 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 + | MultipartReq of MultipartReq.t + | MultipartReply of MultipartReply.t + | BarrierRequest + | BarrierReply + | PacketOutMsg of PacketOut.t + | RoleRequest of RoleRequest.t + | RoleReply of RoleRequest.t + | BundleControl of BundleCtrl.t + | BundleAdd of t bundleAdd + | GetAsyncRequest + | GetAsyncReply of AsyncConfig.t + | SetAsync of AsyncConfig.t + | PacketInMsg of PacketIn.t + | PortStatus of PortStatus.t + | RoleStatus of RoleStatus.t + | TableStatus of TableStatus.t + | RequestForward of t requestForward + + 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..f8659f7 --- /dev/null +++ b/lib/OpenFlow0x05_Core.ml @@ -0,0 +1,465 @@ +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 } + +type groupMod = OpenFlow0x04_Core.groupMod + +type meterMod = OpenFlow0x04_Core.meterMod + +type capabilities = OpenFlow0x04_Core.capabilities + +type switchFeatures = { datapath_id : int64; num_buffers : int32; + num_tables : int8; aux_id : int8; + supported_capabilities : capabilities } + +type switchConfig = OpenFlow0x04_Core.switchConfig + +type flowRequest = OpenFlow0x04_Core.flowRequest + +type queueRequest = OpenFlow0x04_Core.queueRequest + +type tableFeatures = OpenFlow0x04_Core.tableFeatures + +type queueDescRequest = { port_no : pseudoPort; queue_id : int32 } + +type flowMonitorFlags = { fmInitial : bool; fmAdd : bool; fmRemoved : bool; fmModify : bool; + fmInstructions : bool; fmNoAbvrev : bool; fmOnlyOwn : bool } + +type flowMonitorCommand = + | FMonAdd + | FMonModify + | FMonDelete + +type flowMonitorReq = { fmMonitor_id : int32; fmOut_port : pseudoPort; fmOut_group : int32; + fmFlags : flowMonitorFlags; fmTable_id : int16; fmCommand : + flowMonitorCommand; fmMatch : oxmMatch} + +type multipartType = + | SwitchDescReq + | PortsDescReq + | FlowStatsReq of flowRequest + | AggregFlowStatsReq of flowRequest + | TableStatsReq + | PortStatsReq of portId + | QueueStatsReq of queueRequest + | GroupStatsReq of int32 + | GroupDescReq + | GroupFeatReq + | MeterStatsReq of int32 + | MeterConfReq of int32 + | MeterFeatReq + | TableFeatReq of (tableFeatures list) option + | ExperimentReq of experimenter + | TableDescReq + | QueueDescReq of queueDescRequest + | FlowMonitorReq of flowMonitorReq + +type multipartRequest = { mpr_type : multipartType; mpr_flags : bool } + +type switchDesc = OpenFlow0x04_Core.switchDesc + +type flowStats = OpenFlow0x04_Core.flowStats + +type aggregStats = OpenFlow0x04_Core.aggregStats + +type tableStats = OpenFlow0x04_Core.tableStats + +type portStatsPropEthernet = { rx_frame_err : int64; rx_over_err : int64; rx_crc_err : int64; + collisions : int64 } + +type portStatsOpticalFlag = { rx_tune : bool; tx_tune : bool; tx_pwr : bool; rx_pwr : bool; + tx_bias : bool; tx_temp : bool } + +type portStatsPropOptical = { flags : portStatsOpticalFlag; tx_freq_lmda : int32; + tx_offset : int32; tx_grid_span : int32; rx_freq_lmda : int32; + rx_offset : int32; rx_grid_span : int32; tx_pwr : int16; rx_pwr : int16; + bias_current : int16; temperature : int16 } + +type portStatsProp = + | PortStatsPropEthernet of portStatsPropEthernet + | PortStatsPropOptical of portStatsPropOptical + | PortStatsPropExperimenter of experimenter + +type portStats = { psPort_no : portId; duration_sec : int32; duration_nsec : int32 ; + rx_packets : int64; tx_packets : int64; + rx_bytes : int64; tx_bytes : int64; rx_dropped : int64; + tx_dropped : int64; rx_errors : int64; tx_errors : int64; + properties : portStatsProp list} + + +type queueStatsProp = + | ExperimenterQueueStats of experimenter + +type queueStats = { qsPort_no : portId; queue_id : int32; tx_bytes : int64; tx_packets : int64; + tx_errors : int64; duration_sec : int32; duration_nsec : int32; + properties : queueStatsProp list } + +type groupStats = OpenFlow0x04_Core.groupStats + +type groupDesc = OpenFlow0x04_Core.groupDesc + +type groupFeatures = OpenFlow0x04_Core.groupFeatures + +type meterStats = OpenFlow0x04_Core.meterStats + +type meterConfig = OpenFlow0x04_Core.meterConfig + +type meterFeatures = OpenFlow0x04_Core.meterFeatures + +type tableDescReply = tableMod + +type rateQueue = + | Rate of int16 + | Disabled + +type queueDescProp = + | QueueDescPropMinRate of rateQueue + | QueueDescPropMaxRate of rateQueue + | QueueDescPropExperimenter of experimenter + +type queueDescReply = { port_no : portId; queue_id : int32; properties : queueDescProp list } + +type updateEvent = + | InitialUpdate + | AddedUpdate + | RemovedUpdate + | ModifiedUpdate + +type flowReason = + | FlowIdleTimeout + | FlowHardTiemout + | FlowDelete + | FlowGroupDelete + | FlowMeterDelete + | FlowEviction + +type flowRemoved = { cookie : int64; priority : int16; reason : flowReason; + table_id : tableId; duration_sec : int32; duration_nsec : int32; + idle_timeout : timeout; hard_timeout : timeout; packet_count : int64; + byte_count : int64; oxm : oxmMatch } + +type fmUpdateFull = { event : updateEvent; table_id : tableId; reason : flowReason; + idle_timeout : timeout; hard_timeout : timeout; priority : int16; + cookie : int64; updateMatch : oxmMatch; instructions : instruction list} + +type pauseEvent = + | Pause + | Resume + +type flowMonitorReply = + | FmUpdateFull of fmUpdateFull + | FmAbbrev of int32 + | FmPaused of pauseEvent + +type multipartReplyTyp = + | PortsDescReply of portDesc list + | SwitchDescReply of switchDesc + | FlowStatsReply of flowStats list + | AggregateReply of aggregStats + | TableReply of tableStats list + | TableFeaturesReply of tableFeatures list + | PortStatsReply of portStats list + | QueueStatsReply of queueStats list + | GroupStatsReply of groupStats list + | GroupDescReply of groupDesc list + | GroupFeaturesReply of groupFeatures + | MeterReply of meterStats list + | MeterConfig of meterConfig list + | MeterFeaturesReply of meterFeatures + | TableDescReply of tableDescReply list + | QueueDescReply of queueDescReply list + | FlowMonitorReply of flowMonitorReply list + +type multipartReply = {mpreply_typ : multipartReplyTyp; mpreply_flags : bool} + +type packetOut = OpenFlow0x04_Core.packetOut + +type controllerRole = OpenFlow0x04_Core.controllerRole + +type roleRequest = OpenFlow0x04_Core.roleRequest + +type bundleCtrlTyp = + | OpenReq + | OpenReply + | CloseReq + | CloseReply + | CommitReq + | CommitReply + | DiscardReq + | DiscardReply + +type bundleFlags = { atomic : bool; ordered : bool} + +type bundleProp = + | BundleExperimenter of experimenter + +type bundleCtrl = { bundle_id : int32; typ : bundleCtrlTyp; flags : bundleFlags; properties : bundleProp list } + +type 'a bundleAdd = { bundle_id : int32; flags : bundleFlags; xid : xid; message : 'a ; properties : bundleProp list } + +type packetInReasonMap = { table_miss : bool; apply_action : bool; invalid_ttl : bool; action_set : bool; + group : bool; packet_out : bool} + +type portStatusReasonMap = { add : bool; delete : bool; modify : bool } + +type flowRemovedReasonMap = { idle_timeout : bool; hard_timeout : bool; delete : bool; + group_delete : bool; meter_delete : bool; eviction : bool } + +type roleStatusReasonMap = { master_request : bool; config : bool; experimenter : bool } + +type tableStatusReasonMap = { vacancy_down : bool; vacancy_up : bool} + +type requestedForwardReasonMap = { group_mod : bool; meter_mod : bool } + +type asyncProp = + | AsyncReasonPacketInSlave of packetInReasonMap + | AsyncReasonPacketInMaster of packetInReasonMap + | AsyncReasonPortStatusSlave of portStatusReasonMap + | AsyncReasonPortStatusMaster of portStatusReasonMap + | AsyncReasonFlowRemovedSlave of flowRemovedReasonMap + | AsyncReasonFlowRemovedMaster of flowRemovedReasonMap + | AsyncReasonRoleStatusSlave of roleStatusReasonMap + | AsyncReasonRoleStatusMaster of roleStatusReasonMap + | AsyncReasonTableStatusSlave of tableStatusReasonMap + | AsyncReasonTableStatusMaster of tableStatusReasonMap + | AsyncReasonRequestedForwardSlave of requestedForwardReasonMap + | AsyncReasonRequestedForwardMaster of requestedForwardReasonMap + | AsyncExperimenterSlave of experimenter + | AsyncExperimenterMaster of experimenter + +type asyncConfig = asyncProp list + +type packetInReason = + | NoMatch + | ExplicitSend + | InvalidTTL + | ActionSet + | Group + | PacketOut + +type packetIn = { pi_total_len : int16; pi_reason : packetInReason; + pi_table_id : tableId; pi_cookie : int64; + pi_ofp_match : oxmMatch; pi_payload : payload } + +type portStatus = OpenFlow0x04_Core.portStatus + +type roleStatusReason = + | RSRMasterRequest + | RSRConfig + | RSRExperimenter + +type roleStatusProp = + | RSPExperimenter of experimenter + +type roleStatus = { role : controllerRole; reason : roleStatusReason; generation_id : int64; + properties : roleStatusProp list } + +type tableStatusReason = + | VacancyDown + | VacancyUp + +type tableStatus = { reason : tableStatusReason; table : tableDescReply} + +type 'a requestForward = xid * 'a diff --git a/lib/OpenFlow0x05_Core.mli b/lib/OpenFlow0x05_Core.mli new file mode 100644 index 0000000..784298f --- /dev/null +++ b/lib/OpenFlow0x05_Core.mli @@ -0,0 +1,463 @@ +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 } + +type groupMod = OpenFlow0x04_Core.groupMod + +type meterMod = OpenFlow0x04_Core.meterMod + +type capabilities = OpenFlow0x04_Core.capabilities + +type switchFeatures = { datapath_id : int64; num_buffers : int32; + num_tables : int8; aux_id : int8; + supported_capabilities : capabilities } + +type switchConfig = OpenFlow0x04_Core.switchConfig + +type flowRequest = OpenFlow0x04_Core.flowRequest + +type queueRequest = OpenFlow0x04_Core.queueRequest + +type tableFeatures = OpenFlow0x04_Core.tableFeatures + +type queueDescRequest = { port_no : pseudoPort; queue_id : int32 } + +type flowMonitorFlags = { fmInitial : bool; fmAdd : bool; fmRemoved : bool; fmModify : bool; + fmInstructions : bool; fmNoAbvrev : bool; fmOnlyOwn : bool } + +type flowMonitorCommand = + | FMonAdd + | FMonModify + | FMonDelete + +type flowMonitorReq = { fmMonitor_id : int32; fmOut_port : pseudoPort; fmOut_group : int32; + fmFlags : flowMonitorFlags; fmTable_id : int16; fmCommand : + flowMonitorCommand; fmMatch : oxmMatch} + +type multipartType = + | SwitchDescReq + | PortsDescReq + | FlowStatsReq of flowRequest + | AggregFlowStatsReq of flowRequest + | TableStatsReq + | PortStatsReq of portId + | QueueStatsReq of queueRequest + | GroupStatsReq of int32 + | GroupDescReq + | GroupFeatReq + | MeterStatsReq of int32 + | MeterConfReq of int32 + | MeterFeatReq + | TableFeatReq of (tableFeatures list) option + | ExperimentReq of experimenter + | TableDescReq + | QueueDescReq of queueDescRequest + | FlowMonitorReq of flowMonitorReq + +type multipartRequest = { mpr_type : multipartType; mpr_flags : bool } + +type switchDesc = OpenFlow0x04_Core.switchDesc + +type flowStats = OpenFlow0x04_Core.flowStats + +type aggregStats = OpenFlow0x04_Core.aggregStats + +type tableStats = OpenFlow0x04_Core.tableStats + +type portStatsPropEthernet = { rx_frame_err : int64; rx_over_err : int64; rx_crc_err : int64; + collisions : int64 } + +type portStatsOpticalFlag = { rx_tune : bool; tx_tune : bool; tx_pwr : bool; rx_pwr : bool; + tx_bias : bool; tx_temp : bool } + +type portStatsPropOptical = { flags : portStatsOpticalFlag; tx_freq_lmda : int32; + tx_offset : int32; tx_grid_span : int32; rx_freq_lmda : int32; + rx_offset : int32; rx_grid_span : int32; tx_pwr : int16; rx_pwr : int16; + bias_current : int16; temperature : int16 } + +type portStatsProp = + | PortStatsPropEthernet of portStatsPropEthernet + | PortStatsPropOptical of portStatsPropOptical + | PortStatsPropExperimenter of experimenter + +type portStats = { psPort_no : portId; duration_sec : int32; duration_nsec : int32 ; + rx_packets : int64; tx_packets : int64; + rx_bytes : int64; tx_bytes : int64; rx_dropped : int64; + tx_dropped : int64; rx_errors : int64; tx_errors : int64; + properties : portStatsProp list} + +type queueStatsProp = + | ExperimenterQueueStats of experimenter + +type queueStats = { qsPort_no : portId; queue_id : int32; tx_bytes : int64; tx_packets : int64; + tx_errors : int64; duration_sec : int32; duration_nsec : int32; + properties : queueStatsProp list } + +type groupStats = OpenFlow0x04_Core.groupStats + +type groupDesc = OpenFlow0x04_Core.groupDesc + +type groupFeatures = OpenFlow0x04_Core.groupFeatures + +type meterStats = OpenFlow0x04_Core.meterStats + +type meterConfig = OpenFlow0x04_Core.meterConfig + +type meterFeatures = OpenFlow0x04_Core.meterFeatures + +type tableDescReply = tableMod + +type rateQueue = + | Rate of int16 + | Disabled + +type queueDescProp = + | QueueDescPropMinRate of rateQueue + | QueueDescPropMaxRate of rateQueue + | QueueDescPropExperimenter of experimenter + +type queueDescReply = { port_no : portId; queue_id : int32; properties : queueDescProp list } + +type updateEvent = + | InitialUpdate + | AddedUpdate + | RemovedUpdate + | ModifiedUpdate + +type flowReason = + | FlowIdleTimeout + | FlowHardTiemout + | FlowDelete + | FlowGroupDelete + | FlowMeterDelete + | FlowEviction + +type flowRemoved = { cookie : int64; priority : int16; reason : flowReason; + table_id : tableId; duration_sec : int32; duration_nsec : int32; + idle_timeout : timeout; hard_timeout : timeout; packet_count : int64; + byte_count : int64; oxm : oxmMatch } + +type fmUpdateFull = { event : updateEvent; table_id : tableId; reason : flowReason; + idle_timeout : timeout; hard_timeout : timeout; priority : int16; + cookie : int64; updateMatch : oxmMatch; instructions : instruction list} + +type pauseEvent = + | Pause + | Resume + +type flowMonitorReply = + | FmUpdateFull of fmUpdateFull + | FmAbbrev of int32 + | FmPaused of pauseEvent + +type multipartReplyTyp = + | PortsDescReply of portDesc list + | SwitchDescReply of switchDesc + | FlowStatsReply of flowStats list + | AggregateReply of aggregStats + | TableReply of tableStats list + | TableFeaturesReply of tableFeatures list + | PortStatsReply of portStats list + | QueueStatsReply of queueStats list + | GroupStatsReply of groupStats list + | GroupDescReply of groupDesc list + | GroupFeaturesReply of groupFeatures + | MeterReply of meterStats list + | MeterConfig of meterConfig list + | MeterFeaturesReply of meterFeatures + | TableDescReply of tableDescReply list + | QueueDescReply of queueDescReply list + | FlowMonitorReply of flowMonitorReply list + + +type multipartReply = {mpreply_typ : multipartReplyTyp; mpreply_flags : bool} + +type packetOut = OpenFlow0x04_Core.packetOut + +type controllerRole = OpenFlow0x04_Core.controllerRole + +type roleRequest = OpenFlow0x04_Core.roleRequest + +type bundleCtrlTyp = + | OpenReq + | OpenReply + | CloseReq + | CloseReply + | CommitReq + | CommitReply + | DiscardReq + | DiscardReply + +type bundleFlags = { atomic : bool; ordered : bool} + +type bundleProp = + | BundleExperimenter of experimenter + +type bundleCtrl = { bundle_id : int32; typ : bundleCtrlTyp; flags : bundleFlags; properties : bundleProp list } + +type 'a bundleAdd = { bundle_id : int32; flags : bundleFlags; xid : xid; message : 'a; properties : bundleProp list } + +type packetInReasonMap = { table_miss : bool; apply_action : bool; invalid_ttl : bool; action_set : bool; + group : bool; packet_out : bool} + +type portStatusReasonMap = { add : bool; delete : bool; modify : bool } + +type flowRemovedReasonMap = { idle_timeout : bool; hard_timeout : bool; delete : bool; + group_delete : bool; meter_delete : bool; eviction : bool } + +type roleStatusReasonMap = { master_request : bool; config : bool; experimenter : bool } + +type tableStatusReasonMap = { vacancy_down : bool; vacancy_up : bool} + +type requestedForwardReasonMap = { group_mod : bool; meter_mod : bool } + +type asyncProp = + | AsyncReasonPacketInSlave of packetInReasonMap + | AsyncReasonPacketInMaster of packetInReasonMap + | AsyncReasonPortStatusSlave of portStatusReasonMap + | AsyncReasonPortStatusMaster of portStatusReasonMap + | AsyncReasonFlowRemovedSlave of flowRemovedReasonMap + | AsyncReasonFlowRemovedMaster of flowRemovedReasonMap + | AsyncReasonRoleStatusSlave of roleStatusReasonMap + | AsyncReasonRoleStatusMaster of roleStatusReasonMap + | AsyncReasonTableStatusSlave of tableStatusReasonMap + | AsyncReasonTableStatusMaster of tableStatusReasonMap + | AsyncReasonRequestedForwardSlave of requestedForwardReasonMap + | AsyncReasonRequestedForwardMaster of requestedForwardReasonMap + | AsyncExperimenterSlave of experimenter + | AsyncExperimenterMaster of experimenter + +type asyncConfig = asyncProp list + +type packetInReason = + | NoMatch + | ExplicitSend + | InvalidTTL + | ActionSet + | Group + | PacketOut + +type packetIn = { pi_total_len : int16; pi_reason : packetInReason; + pi_table_id : tableId; pi_cookie : int64; + pi_ofp_match : oxmMatch; pi_payload : payload } + +type portStatus = OpenFlow0x04_Core.portStatus + +type roleStatusReason = + | RSRMasterRequest + | RSRConfig + | RSRExperimenter + +type roleStatusProp = + | RSPExperimenter of experimenter + +type roleStatus = { role : controllerRole; reason : roleStatusReason; generation_id : int64; + properties : roleStatusProp list } + +type tableStatusReason = + | VacancyDown + | VacancyUp + +type tableStatus = { reason : tableStatusReason; table : tableDescReply} + +(* Only group and meter are forwarded *) +type 'a requestForward = xid * 'a 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_OpenFlow0x04.ml b/quickcheck/Arbitrary_OpenFlow0x04.ml index bed168f..f394259 100644 --- a/quickcheck/Arbitrary_OpenFlow0x04.ml +++ b/quickcheck/Arbitrary_OpenFlow0x04.ml @@ -766,7 +766,7 @@ end module MultipartReq = struct open Gen open OpenFlow0x04_Core - module TableFeatures = struct + module TableFeature = struct module TableFeatureProp = struct type t = TableFeatureProp.t @@ -798,7 +798,7 @@ module MultipartReq = struct ret_gen PushPbbHdr; ret_gen PopPbbHdr; ret_gen SetMplsTtlHdr; - ret_gen DecMplsTtlHdr; + ret_gen DecMplsTtlHdr; ret_gen SetQueueHdr; arbitrary_uint32 >>= (fun n -> ret_gen (ExperimenterAHdr n)) ] @@ -825,53 +825,39 @@ module MultipartReq = struct let size_of = TableFeatureProp.sizeof end - module TableFeature = struct - type t = TableFeature.t + type t = TableFeature.t - let arbitrary_config = - ret_gen Deprecated + let arbitrary_config = + ret_gen Deprecated - let calc_length tfp = - (* sizeof_ofp_table_feature = 64*) - ret_gen (64+sum (List.map TableFeatureProp.size_of tfp)) + let calc_length tfp = + (* sizeof_ofp_table_feature = 64*) + ret_gen (64+sum (List.map TableFeatureProp.size_of tfp)) - let arbitrary = - arbitrary_uint8 >>= fun table_id -> - arbitrary_stringN 32 >>= fun name -> - arbitrary_uint64 >>= fun metadata_match -> - arbitrary_uint64 >>= fun metadata_write -> - arbitrary_config >>= fun config -> - arbitrary_uint32 >>= fun max_entries -> - list1 TableFeatureProp.arbitrary >>= fun feature_prop -> - calc_length feature_prop>>= fun length -> - ret_gen { - length; - table_id; - name; - metadata_match; - metadata_write; - config; - max_entries; - feature_prop - } - - let marshal = TableFeature.marshal - let parse bits= - let p,_ = TableFeature.parse bits in - p - let to_string = TableFeature.to_string - let size_of = TableFeature.sizeof - end - - type t = TableFeatures.t - - let arbitrary = - list1 TableFeature.arbitrary >>= fun v -> - ret_gen v - let marshal = TableFeatures.marshal - let parse = TableFeatures.parse - let to_string = TableFeatures.to_string - let size_of = TableFeatures.sizeof + let arbitrary = + arbitrary_uint8 >>= fun table_id -> + arbitrary_stringN 32 >>= fun name -> + arbitrary_uint64 >>= fun metadata_match -> + arbitrary_uint64 >>= fun metadata_write -> + arbitrary_config >>= fun config -> + arbitrary_uint32 >>= fun max_entries -> + list1 TableFeatureProp.arbitrary >>= fun feature_prop -> + calc_length feature_prop>>= fun length -> + ret_gen { + length; + table_id; + name; + metadata_match; + metadata_write; + config; + max_entries; + feature_prop + } + + let marshal = TableFeature.marshal + let parse = TableFeature.parse + let to_string = TableFeature.to_string + let size_of = TableFeature.sizeof end module FlowRequest = struct @@ -918,7 +904,7 @@ module MultipartReq = struct let arbitrary_option = frequency [ (1, ret_gen None); - (3, TableFeatures.arbitrary >>= (fun v -> ret_gen (Some v))) + (3, list1 TableFeature.arbitrary >>= (fun v -> ret_gen (Some v))) ] let arbitrary_type = @@ -1391,8 +1377,8 @@ module MultipartReply = struct let size_of = MeterConfig.sizeof end - module MeterFeaturesStats = struct - type t = MeterFeaturesStats.t + module MeterFeatures = struct + type t = MeterFeatures.t let arbitrary_meterBandMaps = arbitrary_bool >>= fun drop -> @@ -1427,10 +1413,10 @@ module MultipartReply = struct max_color } - let marshal = MeterFeaturesStats.marshal - let parse = MeterFeaturesStats.parse - let to_string = MeterFeaturesStats.to_string - let size_of = MeterFeaturesStats.sizeof + let marshal = MeterFeatures.marshal + let parse = MeterFeatures.parse + let to_string = MeterFeatures.to_string + let size_of = MeterFeatures.sizeof end type t = MultipartReply.t @@ -1450,7 +1436,7 @@ module MultipartReply = struct list1 GroupDesc.arbitrary >>= (fun n -> ret_gen {mpreply_typ = (GroupDescReply n); mpreply_flags = flags}); list1 MeterStats.arbitrary >>= (fun n -> ret_gen {mpreply_typ = (MeterReply n); mpreply_flags = flags}); list1 MeterConfig.arbitrary >>= (fun n -> ret_gen {mpreply_typ = (MeterConfig n); mpreply_flags = flags}); - MeterFeaturesStats.arbitrary >>= (fun n -> ret_gen {mpreply_typ = (MeterFeaturesReply n); mpreply_flags = flags}); + MeterFeatures.arbitrary >>= (fun n -> ret_gen {mpreply_typ = (MeterFeaturesReply n); mpreply_flags = flags}); ] let marshal = MultipartReply.marshal @@ -1897,26 +1883,24 @@ module AsyncConfig = struct type t = AsyncConfig.t - let arbitrary_FlowReason = - oneof [ - ret_gen FlowIdleTimeout; - ret_gen FlowHardTiemout; - ret_gen FlowDelete; - ret_gen FlowGroupDelete] - - let arbitrary_PacketInReason = - oneof [ - ret_gen NoMatch; - ret_gen ExplicitSend; - ret_gen InvalidTTL - ] - - let arbitrary_PortStatusReason = - oneof [ - ret_gen PortAdd; - ret_gen PortDelete; - ret_gen PortModify - ] + let arbitrary_packetInReasonMap = + arbitrary_bool >>= fun table_miss -> + arbitrary_bool >>= fun apply_action -> + arbitrary_bool >>= fun invalid_ttl -> + ret_gen { table_miss; apply_action; invalid_ttl } + + let arbitrary_portStatusReasonMap = + arbitrary_bool >>= fun add -> + arbitrary_bool >>= fun delete -> + arbitrary_bool >>= fun modify -> + ret_gen { add; delete; modify } + + let arbitrary_flowRemovedReasonMap = + arbitrary_bool >>= fun idle_timeout -> + arbitrary_bool >>= fun hard_timeout -> + arbitrary_bool >>= fun delete -> + arbitrary_bool >>= fun group_delete -> + ret_gen { idle_timeout; hard_timeout; delete; group_delete } let arbitrary_mask arb = arb >>= fun m_master -> @@ -1924,9 +1908,9 @@ module AsyncConfig = struct ret_gen { m_master; m_slave } let arbitrary = - arbitrary_mask arbitrary_PacketInReason >>= fun packet_in -> - arbitrary_mask arbitrary_PortStatusReason >>= fun port_status -> - arbitrary_mask arbitrary_FlowReason >>= fun flow_removed -> + arbitrary_mask arbitrary_packetInReasonMap >>= fun packet_in -> + arbitrary_mask arbitrary_portStatusReasonMap >>= fun port_status -> + arbitrary_mask arbitrary_flowRemovedReasonMap >>= fun flow_removed -> ret_gen { packet_in; port_status; flow_removed } let marshal = AsyncConfig.marshal diff --git a/quickcheck/Arbitrary_OpenFlow0x05.ml b/quickcheck/Arbitrary_OpenFlow0x05.ml new file mode 100644 index 0000000..b5544a2 --- /dev/null +++ b/quickcheck/Arbitrary_OpenFlow0x05.ml @@ -0,0 +1,1321 @@ +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 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 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} )); + (Experimenter.arbitrary >>= fun experimenter -> + ret_gen (PropExp experimenter)) + ] + + + 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 SwitchFeatures = struct + open Gen + type t = SwitchFeatures.t + + let arbitrary = + let open Gen 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 + +end + +module FlowRemoved = struct + + open Gen + + type t = FlowRemoved.t + + let arbitrary_reason = + oneof [ + ret_gen FlowIdleTimeout; + ret_gen FlowHardTiemout; + ret_gen FlowDelete; + ret_gen FlowGroupDelete; + ret_gen FlowMeterDelete; + ret_gen FlowEviction] + + let arbitrary = + arbitrary_uint64 >>= fun cookie -> + arbitrary_uint16 >>= fun priority -> + arbitrary_reason >>= fun reason -> + arbitrary_uint8 >>= fun table_id -> + arbitrary_uint32 >>= fun duration_sec -> + arbitrary_uint32 >>= fun duration_nsec -> + arbitrary_timeout >>= fun idle_timeout -> + arbitrary_timeout >>= fun hard_timeout -> + arbitrary_uint64 >>= fun packet_count -> + arbitrary_uint64 >>= fun byte_count -> + OfpMatch.arbitrary >>= fun oxm -> + ret_gen { cookie; priority; reason; table_id; duration_sec; duration_nsec; + idle_timeout; hard_timeout; packet_count; byte_count; oxm } + + let marshal = FlowRemoved.marshal + let parse = FlowRemoved.parse + let to_string = FlowRemoved.to_string + let size_of = FlowRemoved.sizeof + +end + +module QueueDescReq = struct + open Gen + + type t = QueueDescReq.t + + let arbitrary = + PseudoPort.arbitrary_nc >>= fun port_no -> + arbitrary_uint32 >>= fun queue_id -> + ret_gen {port_no; queue_id} + + let marshal = QueueDescReq.marshal + let parse = QueueDescReq.parse + let to_string = QueueDescReq.to_string + let size_of = QueueDescReq.sizeof + +end + +module FlowMonitorRequest = struct + open Gen + + type t = FlowMonitorRequest.t + + let arbitrary_command = + oneof [ + ret_gen FMonAdd; + ret_gen FMonModify; + ret_gen FMonDelete] + + let arbitrary_flags = + arbitrary_bool >>= fun fmInitial -> + arbitrary_bool >>= fun fmAdd -> + arbitrary_bool >>= fun fmRemoved-> + arbitrary_bool >>= fun fmModify -> + arbitrary_bool >>= fun fmInstructions -> + arbitrary_bool >>= fun fmNoAbvrev -> + arbitrary_bool >>= fun fmOnlyOwn -> + ret_gen {fmInitial; fmAdd; fmRemoved; fmModify; fmInstructions; fmNoAbvrev; fmOnlyOwn} + + let arbitrary = + arbitrary_uint32 >>= fun fmMonitor_id -> + PseudoPort.arbitrary_nc >>= fun fmOut_port -> + arbitrary_uint32 >>= fun fmOut_group -> + arbitrary_flags >>= fun fmFlags -> + arbitrary_uint8 >>= fun fmTable_id -> + arbitrary_command >>= fun fmCommand -> + OfpMatch.arbitrary >>= fun fmMatch -> + ret_gen { fmMonitor_id; fmOut_port; fmOut_group; fmFlags; fmTable_id; fmCommand; fmMatch} + + let marshal = FlowMonitorRequest.marshal + let parse = FlowMonitorRequest.parse + let to_string = FlowMonitorRequest.to_string + let size_of = FlowMonitorRequest.sizeof + +end + +module MultipartReq = struct + open Gen + + type t = MultipartReq.t + + let arbitrary_type = + oneof [ + ret_gen TableDescReq; + QueueDescReq.arbitrary >>= (fun n -> ret_gen (QueueDescReq n)); + FlowMonitorRequest.arbitrary >>= (fun n -> ret_gen (FlowMonitorReq n)); + ] + let arbitrary = + arbitrary_bool >>= fun mpr_flags -> + arbitrary_type >>= fun mpr_type -> + ret_gen { + mpr_type; + mpr_flags + } + + let marshal = MultipartReq.marshal + let parse = MultipartReq.parse + let to_string = MultipartReq.to_string + let size_of = MultipartReq.sizeof + +end + +module PortStats = struct + open Gen + + type t = PortStats.t + + module Properties = struct + module Ethernet = struct + let arbitrary = + arbitrary_uint64 >>= fun rx_frame_err -> + arbitrary_uint64 >>= fun rx_over_err -> + arbitrary_uint64 >>= fun rx_crc_err -> + arbitrary_uint64 >>= fun collisions -> + ret_gen {rx_frame_err; rx_over_err; rx_crc_err; collisions} + end + + module Optical = struct + let arbitrary_flags = + arbitrary_bool >>= fun rx_tune -> + arbitrary_bool >>= fun tx_tune -> + arbitrary_bool >>= fun tx_pwr -> + arbitrary_bool >>= fun rx_pwr -> + arbitrary_bool >>= fun tx_bias -> + arbitrary_bool >>= fun tx_temp -> + ret_gen {rx_tune; tx_tune; tx_pwr; rx_pwr; tx_bias; tx_temp} + + let arbitrary = + arbitrary_flags >>= fun flags -> + arbitrary_uint32 >>= fun tx_freq_lmda -> + arbitrary_uint32 >>= fun tx_offset -> + arbitrary_uint32 >>= fun tx_grid_span -> + arbitrary_uint32 >>= fun rx_freq_lmda -> + arbitrary_uint32 >>= fun rx_offset -> + arbitrary_uint32 >>= fun rx_grid_span -> + arbitrary_uint16 >>= fun tx_pwr -> + arbitrary_uint16 >>= fun rx_pwr -> + arbitrary_uint16 >>= fun bias_current -> + arbitrary_uint16 >>= fun temperature -> + ret_gen {flags; tx_freq_lmda; tx_offset; tx_grid_span; + rx_freq_lmda; rx_offset; rx_grid_span; tx_pwr; + rx_pwr; bias_current; temperature} + end + + type t = PortStats.Properties.t + + let arbitrary = + oneof [ + (Ethernet.arbitrary >>= (fun n -> ret_gen (PortStatsPropEthernet n))); + (Optical.arbitrary >>= (fun n -> ret_gen (PortStatsPropOptical n))); + (Experimenter.arbitrary >>= (fun n -> ret_gen (PortStatsPropExperimenter n))) + ] + + + let marshal = PortStats.Properties.marshal + let parse = PortStats.Properties.parse + let to_string = PortStats.Properties.to_string + let size_of = PortStats.Properties.sizeof + + end + + let arbitrary = + arbitrary_uint32 >>= fun psPort_no -> + arbitrary_uint64 >>= fun rx_packets -> + arbitrary_uint64 >>= fun tx_packets -> + arbitrary_uint64 >>= fun rx_bytes -> + arbitrary_uint64 >>= fun tx_bytes -> + arbitrary_uint64 >>= fun rx_dropped -> + arbitrary_uint64 >>= fun tx_dropped -> + arbitrary_uint64 >>= fun rx_errors -> + arbitrary_uint64 >>= fun tx_errors -> + arbitrary_uint32 >>= fun duration_sec -> + arbitrary_uint32 >>= fun duration_nsec -> + arbitrary_list Properties.arbitrary >>= fun properties -> + ret_gen { + psPort_no; + duration_sec; + duration_nsec; + rx_packets; + tx_packets; + rx_bytes; + tx_bytes; + rx_dropped; + tx_dropped; + rx_errors; + tx_errors; + properties + } + + let marshal = PortStats.marshal + let parse = PortStats.parse + let to_string = PortStats.to_string + let size_of = PortStats.sizeof +end + +module QueueStats = struct + open Gen + + module Properties = struct + + type t = QueueStats.Properties.t + + let arbitrary = + oneof [ + (Experimenter.arbitrary >>= (fun n -> ret_gen (ExperimenterQueueStats n))) + ] + + + let marshal = QueueStats.Properties.marshal + let parse = QueueStats.Properties.parse + let to_string = QueueStats.Properties.to_string + let size_of = QueueStats.Properties.sizeof + end + + type t = QueueStats.t + + let arbitrary = + arbitrary_uint32 >>= fun qsPort_no -> + arbitrary_uint32 >>= fun queue_id -> + arbitrary_uint64 >>= fun tx_bytes -> + arbitrary_uint64 >>= fun tx_packets -> + arbitrary_uint64 >>= fun tx_errors -> + arbitrary_uint32 >>= fun duration_sec -> + arbitrary_uint32 >>= fun duration_nsec -> + arbitrary_list Properties.arbitrary >>= fun properties -> + ret_gen { + qsPort_no; + queue_id; + tx_bytes; + tx_packets; + tx_errors; + duration_sec; + duration_nsec; + properties + } + + let marshal = QueueStats.marshal + let parse = QueueStats.parse + let to_string = QueueStats.to_string + let size_of = QueueStats.sizeof + +end + +module TableDescReply = struct + + open Gen + type t = TableDescReply.t + + let arbitrary = + arbitrary_uint8 >>= fun table_id -> + TableMod.arbitrary_config >>= fun config -> + arbitrary_list TableMod.Properties.arbitrary >>= fun properties -> + ret_gen { table_id; config; properties } + + let marshal = TableDescReply.marshal + let parse = TableDescReply.parse + let to_string = TableDescReply.to_string + let size_of = TableDescReply.sizeof + +end + +module QueueDescReply = struct + open Gen + + module Properties = struct + + type t = QueueDescReply.Properties.t + + let arbitrary_rate = + frequency [ + (1, ret_gen Disabled); + (10, choose_int (0,1000) >>= fun a -> + ret_gen (Rate a)) + ] + + let arbitrary = + oneof [ + (arbitrary_rate >>= (fun n -> ret_gen (QueueDescPropMinRate n))); + (arbitrary_rate >>= (fun n -> ret_gen (QueueDescPropMaxRate n))); + (Experimenter.arbitrary >>= (fun n -> ret_gen (QueueDescPropExperimenter n))) + ] + + + let marshal = QueueDescReply.Properties.marshal + let parse = QueueDescReply.Properties.parse + let to_string = QueueDescReply.Properties.to_string + let size_of = QueueDescReply.Properties.sizeof + end + + type t = QueueDescReply.t + + let arbitrary = + arbitrary_uint32 >>= fun port_no -> + arbitrary_uint32 >>= fun queue_id -> + arbitrary_list Properties.arbitrary >>= fun properties -> + ret_gen { port_no; queue_id; properties } + + let marshal = QueueDescReply.marshal + let parse = QueueDescReply.parse + let to_string = QueueDescReply.to_string + let size_of = QueueDescReply.sizeof +end + +module FlowMonitorReply = struct + + open Gen + type t = FlowMonitorReply.t + + module UpdateFull = struct + let arbitrary event = + arbitrary_uint8 >>= fun table_id -> + FlowRemoved.arbitrary_reason >>= fun reason -> + arbitrary_timeout >>= fun idle_timeout -> + arbitrary_timeout >>= fun hard_timeout -> + arbitrary_uint16 >>= fun priority -> + arbitrary_uint64 >>= fun cookie -> + OfpMatch.arbitrary >>= fun updateMatch -> + Instructions.arbitrary >>= fun instructions -> + ret_gen { event; table_id; reason; idle_timeout; hard_timeout; priority; cookie; updateMatch; instructions } + end + + let arbitrary = + oneof [ + (UpdateFull.arbitrary InitialUpdate >>= (fun n -> ret_gen (FmUpdateFull n))); + (UpdateFull.arbitrary AddedUpdate >>= (fun n -> ret_gen (FmUpdateFull n))); + (UpdateFull.arbitrary RemovedUpdate >>= (fun n -> ret_gen (FmUpdateFull n))); + (UpdateFull.arbitrary ModifiedUpdate >>= (fun n -> ret_gen (FmUpdateFull n))); + (arbitrary_uint32 >>= (fun n -> ret_gen (FmAbbrev n))); + ret_gen (FmPaused Pause); + ret_gen (FmPaused Resume) + ] + + let marshal = FlowMonitorReply.marshal + let parse = FlowMonitorReply.parse + let to_string = FlowMonitorReply.to_string + let size_of = FlowMonitorReply.sizeof +end + +module MultipartReply = struct + open Gen + type t = MultipartReply.t + + let arbitrary_type = + arbitrary_bool >>= fun flags -> + oneof [ + (arbitrary_list TableDescReply.arbitrary >>= (fun n -> ret_gen (TableDescReply n))); + (arbitrary_list QueueDescReply.arbitrary >>= (fun n -> ret_gen (QueueDescReply n))); + (arbitrary_list FlowMonitorReply.arbitrary >>= (fun n -> ret_gen (FlowMonitorReply n))) + ] + + let arbitrary = + arbitrary_bool >>= fun mpreply_flags -> + arbitrary_type >>= fun mpreply_typ -> + ret_gen { + mpreply_typ; + mpreply_flags + } + + let marshal = MultipartReply.marshal + let parse = MultipartReply.parse + let to_string = MultipartReply.to_string + let size_of = MultipartReply.sizeof +end + +module BundleProp = struct + + open Gen + type t = BundleProp.t + + let arbitrary = + oneof [ + (Experimenter.arbitrary >>= (fun n -> ret_gen (BundleExperimenter n))) + ] + + let marshal = BundleProp.marshal + let parse = BundleProp.parse + let to_string = BundleProp.to_string + let size_of = BundleProp.sizeof + +end + +module BundleCtrl = struct + + open Gen + type t = BundleCtrl.t + + let arbitrary_typ = + oneof [ + ret_gen OpenReq; + ret_gen OpenReply; + ret_gen CloseReq; + ret_gen CloseReply; + ret_gen CommitReq; + ret_gen CommitReply; + ret_gen DiscardReq; + ret_gen DiscardReply + ] + + let arbitrary_flags = + arbitrary_bool >>= fun atomic -> + arbitrary_bool >>= fun ordered -> + ret_gen { atomic; ordered } + + let arbitrary = + arbitrary_uint32 >>= fun bundle_id -> + arbitrary_typ >>= fun typ -> + arbitrary_flags >>= fun flags -> + arbitrary_list BundleProp.arbitrary >>= fun properties -> + ret_gen { bundle_id; typ; flags; properties } + + let marshal = BundleCtrl.marshal + let parse = BundleCtrl.parse + let to_string = BundleCtrl.to_string + let size_of = BundleCtrl.sizeof + +end + +module AsyncConfig = struct + + open Gen + + module Properties = struct + + type t = AsyncConfig.Properties.t + + let arbitrary_packetInReasonMap = + arbitrary_bool >>= fun table_miss -> + arbitrary_bool >>= fun apply_action -> + arbitrary_bool >>= fun invalid_ttl -> + arbitrary_bool >>= fun action_set -> + arbitrary_bool >>= fun group -> + arbitrary_bool >>= fun packet_out -> + ret_gen { table_miss; apply_action; invalid_ttl; action_set; group; packet_out } + + let arbitrary_portStatusReasonMap = + arbitrary_bool >>= fun add -> + arbitrary_bool >>= fun delete -> + arbitrary_bool >>= fun modify -> + ret_gen { add; delete; modify } + + let arbitrary_flowRemovedReasonMap = + arbitrary_bool >>= fun idle_timeout -> + arbitrary_bool >>= fun hard_timeout -> + arbitrary_bool >>= fun delete -> + arbitrary_bool >>= fun group_delete -> + arbitrary_bool >>= fun meter_delete -> + arbitrary_bool >>= fun eviction -> + ret_gen { idle_timeout; hard_timeout; delete; group_delete; meter_delete; eviction } + + let arbitrary_roleStatusReasonMap = + arbitrary_bool >>= fun master_request -> + arbitrary_bool >>= fun config -> + arbitrary_bool >>= fun experimenter -> + ret_gen { master_request; config; experimenter } + + let arbitrary_tableStatusReasonMap = + arbitrary_bool >>= fun vacancy_down -> + arbitrary_bool >>= fun vacancy_up -> + ret_gen { vacancy_down; vacancy_up } + + let arbitrary_requestedForwardReasonMap = + arbitrary_bool >>= fun group_mod -> + arbitrary_bool >>= fun meter_mod -> + ret_gen { group_mod; meter_mod } + + let arbitrary = + oneof [ + (arbitrary_packetInReasonMap >>= (fun n -> ret_gen (AsyncReasonPacketInSlave n))); + (arbitrary_packetInReasonMap >>= (fun n -> ret_gen (AsyncReasonPacketInMaster n))); + (arbitrary_portStatusReasonMap >>= (fun n -> ret_gen (AsyncReasonPortStatusSlave n))); + (arbitrary_portStatusReasonMap >>= (fun n -> ret_gen (AsyncReasonPortStatusMaster n))); + (arbitrary_flowRemovedReasonMap >>= (fun n -> ret_gen (AsyncReasonFlowRemovedSlave n))); + (arbitrary_flowRemovedReasonMap >>= (fun n -> ret_gen (AsyncReasonFlowRemovedMaster n))); + (arbitrary_roleStatusReasonMap >>= (fun n -> ret_gen (AsyncReasonRoleStatusSlave n))); + (arbitrary_roleStatusReasonMap >>= (fun n -> ret_gen (AsyncReasonRoleStatusMaster n))); + (arbitrary_tableStatusReasonMap >>= (fun n -> ret_gen (AsyncReasonTableStatusSlave n))); + (arbitrary_tableStatusReasonMap >>= (fun n -> ret_gen (AsyncReasonTableStatusMaster n))); + (arbitrary_requestedForwardReasonMap >>= (fun n -> ret_gen (AsyncReasonRequestedForwardSlave n))); + (arbitrary_requestedForwardReasonMap >>= (fun n -> ret_gen (AsyncReasonRequestedForwardMaster n))); + (Experimenter.arbitrary >>= (fun n -> ret_gen (AsyncExperimenterSlave n))); + (Experimenter.arbitrary >>= (fun n -> ret_gen (AsyncExperimenterMaster n))) + ] + + + let marshal = AsyncConfig.Properties.marshal + let parse = AsyncConfig.Properties.parse + let to_string = AsyncConfig.Properties.to_string + let size_of = AsyncConfig.Properties.sizeof + end + + type t = AsyncConfig.t + + + let arbitrary = + arbitrary_list Properties.arbitrary >>= fun properties -> + ret_gen properties + + let marshal = AsyncConfig.marshal + let parse = AsyncConfig.parse + let to_string = AsyncConfig.to_string + let size_of = AsyncConfig.sizeof + +end + +module RoleStatus = struct + + open Gen + + module Properties = struct + + type t = RoleStatus.Properties.t + + let arbitrary = + oneof [ + (Experimenter.arbitrary >>= (fun n -> ret_gen (RSPExperimenter n))) + ] + + let marshal = RoleStatus.Properties.marshal + let parse = RoleStatus.Properties.parse + let to_string = RoleStatus.Properties.to_string + let size_of = RoleStatus.Properties.sizeof + + end + + type t = RoleStatus.t + + let arbitrary_reason = + oneof [ + ret_gen RSRMasterRequest; + ret_gen RSRConfig; + ret_gen RSRExperimenter + ] + + let arbitrary_role = + let open OpenFlow0x04_Core in + oneof [ + ret_gen NoChangeRole; + ret_gen EqualRole; + ret_gen MasterRole; + ret_gen SlaveRole + ] + + let arbitrary = + let open OpenFlow0x05_Core in + arbitrary_role >>= fun role -> + arbitrary_reason >>= fun reason -> + arbitrary_uint64 >>= fun generation_id -> + arbitrary_list Properties.arbitrary >>= fun properties -> + ret_gen { role; reason; generation_id; properties } + + let marshal = RoleStatus.marshal + let parse = RoleStatus.parse + let to_string = RoleStatus.to_string + let size_of = RoleStatus.sizeof + +end + +module TableStatus = struct + + open Gen + + type t = TableStatus.t + + let arbitrary_reason = + oneof [ + ret_gen VacancyDown; + ret_gen VacancyUp + ] + + let arbitrary = + let open OpenFlow0x05_Core in + arbitrary_reason >>= fun reason -> + TableMod.arbitrary >>= fun table -> + ret_gen { reason; table } + + let marshal = TableStatus.marshal + let parse = TableStatus.parse + let to_string = TableStatus.to_string + let size_of = TableStatus.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..c805a31 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: 2c0b69506554fa3b48f67b1373bd3dc6) *) (* Regenerated by OASIS v0.4.4 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6825,7 +6825,7 @@ let setup_t = alpha_features = []; beta_features = []; name = "openflow"; - version = "0.5.0"; + version = "0.6.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -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 "Q\191Ew\204\022\177\128\020t-ZR\242\237\n"; 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..4310107 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 @@ -323,21 +324,16 @@ module RoundTripping = struct (openflow_quickCheck GenGroupMod.arbitrary GenGroupMod.to_string GenGroupMod.parse GenGroupMod.marshal) - TEST "OpenFlow0x04 MultipartReq.TableFeatures.TableFeatureProp RoundTrip" = - let module GenTableFeatureProp = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReq.TableFeatures.TableFeatureProp) in + TEST "OpenFlow0x04 MultipartReq.TableFeature.TableFeatureProp RoundTrip" = + let module GenTableFeatureProp = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReq.TableFeature.TableFeatureProp) in (openflow_quickCheck GenTableFeatureProp.arbitrary GenTableFeatureProp.to_string GenTableFeatureProp.parse GenTableFeatureProp.marshal) - TEST "OpenFlow0x04 MultipartReq.TableFeatures.TableFeature RoundTrip" = - let module GenTableFeature = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReq.TableFeatures.TableFeature) in + TEST "OpenFlow0x04 MultipartReq.TableFeature RoundTrip" = + let module GenTableFeature = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReq.TableFeature) in (openflow_quickCheck GenTableFeature.arbitrary GenTableFeature.to_string GenTableFeature.parse GenTableFeature.marshal) - TEST "OpenFlow0x04 MultipartReq.TableFeatures RoundTrip" = - let module GenTableFeatureReq = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReq.TableFeatures) in - (openflow_quickCheck GenTableFeatureReq.arbitrary - GenTableFeatureReq.to_string GenTableFeatureReq.parse GenTableFeatureReq.marshal) - TEST "OpenFlow0x04 MultipartReq.FlowRequest RoundTrip" = let module GenTableFlowReq = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReq.FlowRequest) in (openflow_quickCheck GenTableFlowReq.arbitrary @@ -393,8 +389,8 @@ module RoundTripping = struct (openflow_quickCheck GenMeterConfigReply.arbitrary GenMeterConfigReply.to_string GenMeterConfigReply.parse GenMeterConfigReply.marshal) - TEST "OpenFlow0x04 MultipartReply.MeterFeaturesStats RoundTrip" = - let module GenMeterFeaturesReply = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReply.MeterFeaturesStats) in + TEST "OpenFlow0x04 MultipartReply.MeterFeatures RoundTrip" = + let module GenMeterFeaturesReply = Gen0x04.OpenFlow0x04_Unsize(Gen0x04.MultipartReply.MeterFeatures) in (openflow_quickCheck GenMeterFeaturesReply.arbitrary GenMeterFeaturesReply.to_string GenMeterFeaturesReply.parse GenMeterFeaturesReply.marshal) @@ -442,11 +438,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 +484,191 @@ 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 "OpenFlow0x05 MultipartReq.QueueDesc RoundTrip" = + let module GenQueueDesc = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.QueueDescReq) in + (openflow_quickCheck GenQueueDesc.arbitrary + GenQueueDesc.to_string GenQueueDesc.parse GenQueueDesc.marshal) + + TEST "OpenFlow0x05 MultipartReq.FlowMonitorRequest RoundTrip" = + let module GenFlowMonitorRequest = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.FlowMonitorRequest) in + (openflow_quickCheck GenFlowMonitorRequest.arbitrary + GenFlowMonitorRequest.to_string GenFlowMonitorRequest.parse GenFlowMonitorRequest.marshal) + + TEST "OpenFlow0x05 MultipartReq RoundTrip" = + let module GenMultipartReq = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.MultipartReq) in + (openflow_quickCheck GenMultipartReq.arbitrary + GenMultipartReq.to_string GenMultipartReq.parse GenMultipartReq.marshal) + + TEST "OpenFlow0x05 MultipartReply.PortStats RoundTrip" = + let module GenPortStats = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.PortStats) in + (openflow_quickCheck GenPortStats.arbitrary + GenPortStats.to_string GenPortStats.parse GenPortStats.marshal) + + TEST "OpenFlow0x05 MultipartReply.QueueStats RoundTrip" = + let module GenQueueStats = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.QueueStats) in + (openflow_quickCheck GenQueueStats.arbitrary + GenQueueStats.to_string GenQueueStats.parse GenQueueStats.marshal) + + TEST "OpenFlow0x05 MultipartReply.TableDescReply RoundTrip" = + let module GenTableDescReply = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.TableDescReply) in + (openflow_quickCheck GenTableDescReply.arbitrary + GenTableDescReply.to_string GenTableDescReply.parse GenTableDescReply.marshal) + + TEST "OpenFlow0x05 MultipartReply.QueueDescReply RoundTrip" = + let module GenQueueDescReply = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.QueueDescReply) in + (openflow_quickCheck GenQueueDescReply.arbitrary + GenQueueDescReply.to_string GenQueueDescReply.parse GenQueueDescReply.marshal) + + TEST "OpenFlow0x05 MultipartReply.FlowMonitorReply RoundTrip" = + let module GenFlowMonitorReply = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.FlowMonitorReply) in + (openflow_quickCheck GenFlowMonitorReply.arbitrary + GenFlowMonitorReply.to_string GenFlowMonitorReply.parse GenFlowMonitorReply.marshal) + + TEST "OpenFlow0x05 MultipartReply RoundTrip" = + let module GenMultipartReply = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.MultipartReply) in + (openflow_quickCheck GenMultipartReply.arbitrary + GenMultipartReply.to_string GenMultipartReply.parse GenMultipartReply.marshal) + + TEST "OpenFlow0x05 BundleProp RoundTrip" = + let module GenBundleProp = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.BundleProp) in + (openflow_quickCheck GenBundleProp.arbitrary + GenBundleProp.to_string GenBundleProp.parse GenBundleProp.marshal) + + TEST "OpenFlow0x05 BundleCtrl RoundTrip" = + let module GenBundleCtrl = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.BundleCtrl) in + (openflow_quickCheck GenBundleCtrl.arbitrary + GenBundleCtrl.to_string GenBundleCtrl.parse GenBundleCtrl.marshal) + + TEST "OpenFlow0x05 AsyncConfig.Properties RoundTrip" = + let module GenAsyncProp = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.AsyncConfig.Properties) in + (openflow_quickCheck GenAsyncProp.arbitrary + GenAsyncProp.to_string GenAsyncProp.parse GenAsyncProp.marshal) + + TEST "OpenFlow0x05 AsyncConfig RoundTrip" = + let module GenAsync = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.AsyncConfig) in + (openflow_quickCheck GenAsync.arbitrary + GenAsync.to_string GenAsync.parse GenAsync.marshal) + + TEST "OpenFlow0x05 RoleStatus RoundTrip" = + let module GenRoleStatus = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.RoleStatus) in + (openflow_quickCheck GenRoleStatus.arbitrary + GenRoleStatus.to_string GenRoleStatus.parse GenRoleStatus.marshal) + + TEST "OpenFlow0x05 RoleStatus RoundTrip" = + let module GenTableStatus = Gen0x05.OpenFlow0x05_Unsize(Gen0x05.TableStatus) in + (openflow_quickCheck GenTableStatus.arbitrary + GenTableStatus.to_string GenTableStatus.parse GenTableStatus.marshal) + TEST "OpenFlow Hello Test 1" = let open Message in let bs = Cstruct.create 101 in