|
| 1 | +open Async.Std |
| 2 | +open Core.Std |
| 3 | + |
| 4 | +open OpenFlow0x04 |
| 5 | +open OpenFlow0x04_Core |
| 6 | +open OpenFlow0x04.Message |
| 7 | + |
| 8 | +module OF0x04Controller = Async_OpenFlow0x04.Controller |
| 9 | + |
| 10 | +module SwitchTable = Map.Make(OF0x04Controller.Client_id) |
| 11 | + |
| 12 | +module EthTable = Map.Make(struct |
| 13 | + type t = Int64.t sexp_opaque with sexp |
| 14 | + let compare = Pervasives.compare |
| 15 | +end) |
| 16 | + |
| 17 | +type switchTable = portId EthTable.t SwitchTable.t |
| 18 | + |
| 19 | +let switch |
| 20 | + (ctl : OF0x04Controller.t) |
| 21 | + (tbl : switchTable) |
| 22 | + evt = |
| 23 | + let ensure result response = |
| 24 | + begin match response with |
| 25 | + | `Sent _ -> return result |
| 26 | + | `Drop exn -> raise exn |
| 27 | + end in |
| 28 | + |
| 29 | + let learn c_id pi = |
| 30 | + let pkt = parse_payload pi.pi_payload in |
| 31 | + let rec findPort oxmMatch = |
| 32 | + match oxmMatch with |
| 33 | + | [] -> failwith "no PhysicalPort" |
| 34 | + | (OxmInPort t)::q |
| 35 | + | (OxmInPhyPort t)::q -> t |
| 36 | + | t::q -> findPort q in |
| 37 | + let eth, port = pkt.Packet.dlSrc, (findPort pi.pi_ofp_match) in |
| 38 | + let tbl', present = match SwitchTable.find tbl c_id with |
| 39 | + | None -> (SwitchTable.add tbl c_id (EthTable.singleton eth port), false) |
| 40 | + | Some e_tbl -> |
| 41 | + match EthTable.find e_tbl eth with |
| 42 | + | None -> (SwitchTable.add tbl c_id (EthTable.add e_tbl eth port), false) |
| 43 | + | Some port' when port = port' -> (tbl, true) |
| 44 | + | _ -> failwith "Inconsistent topology" in (* XXX(seliopou): exn *) |
| 45 | + if present then |
| 46 | + return (true, tbl') |
| 47 | + else |
| 48 | + let fwd, buf = match pi.pi_payload with |
| 49 | + | Buffered (b_id, _) -> (false, Some b_id) |
| 50 | + | NotBuffered _ -> (true, None) in |
| 51 | + OF0x04Controller.send ctl c_id |
| 52 | + (1l, FlowModMsg ( |
| 53 | + { mfCookie = val_to_mask 0L |
| 54 | + ; mfTable_id = 0 |
| 55 | + ; mfCommand = AddFlow |
| 56 | + ; mfIdle_timeout = Permanent |
| 57 | + ; mfHard_timeout = Permanent |
| 58 | + ; mfPriority = 5 |
| 59 | + ; mfBuffer_id = buf |
| 60 | + ; mfOut_port = None |
| 61 | + ; mfOut_group = None |
| 62 | + ; mfFlags = { fmf_send_flow_rem = false |
| 63 | + ; fmf_check_overlap = false |
| 64 | + ; fmf_reset_counts = false |
| 65 | + ; fmf_no_pkt_counts = false |
| 66 | + ; fmf_no_byt_counts = false } |
| 67 | + ; mfOfp_match = ([OxmEthDst {m_value = eth; m_mask = None}]) |
| 68 | + ; mfInstructions = ([ApplyActions [Output(PhysicalPort port)]]) |
| 69 | + } |
| 70 | + )) |
| 71 | + (* XXX(seliopu): can ensure asynchronously if not buffered, or if the |
| 72 | + * buffering is ignored completely. |
| 73 | + * *) |
| 74 | + >>= ensure (fwd, tbl') in |
| 75 | + |
| 76 | + let forward (tbl : switchTable) c_id t_id pi = |
| 77 | + let dst = (parse_payload pi.pi_payload).Packet.dlDst in |
| 78 | + let rec findPort oxmMatch = |
| 79 | + match oxmMatch with |
| 80 | + | [] -> failwith "no PhysicalPort" |
| 81 | + | (OxmInPort t)::q |
| 82 | + | (OxmInPhyPort t)::q -> t |
| 83 | + | t::q -> findPort q in |
| 84 | + let port = findPort pi.pi_ofp_match in |
| 85 | + let out = |
| 86 | + match EthTable.find (SwitchTable.find_exn tbl c_id) dst with |
| 87 | + | None -> Flood |
| 88 | + | Some(p) -> PhysicalPort(p) in |
| 89 | + OF0x04Controller.send ctl c_id |
| 90 | + (t_id, PacketOutMsg { |
| 91 | + po_payload = pi.pi_payload; |
| 92 | + po_port_id = Some(port); |
| 93 | + po_actions = [ Output(out) ] }) in |
| 94 | + |
| 95 | + begin match evt with |
| 96 | + | `Connect c_id -> |
| 97 | + OF0x04Controller.send ctl c_id |
| 98 | + (0l, FlowModMsg (add_flow 1 |
| 99 | + ([]) |
| 100 | + ([ApplyActions [Output(Controller 1024)]])) |
| 101 | + ) |
| 102 | + >>= ensure (SwitchTable.add tbl c_id EthTable.empty) |
| 103 | + | `Disconnect (c_id, _) -> |
| 104 | + return (SwitchTable.remove tbl c_id) |
| 105 | + | `Message (c_id, msg) -> |
| 106 | + let t_id, msg = msg in |
| 107 | + begin match msg with |
| 108 | + | PacketInMsg pi -> |
| 109 | + learn c_id pi |
| 110 | + >>= (function |
| 111 | + | (true , tbl') -> forward tbl' c_id t_id pi >>= ensure tbl' |
| 112 | + | (false, tbl') -> return tbl') |
| 113 | + | Error err -> failwith (Error.to_string err) |
| 114 | + | PortStatusMsg ps -> |
| 115 | + let open PortStatus in |
| 116 | + let port = ps.desc.port_no in |
| 117 | + begin match ps.reason with |
| 118 | + | PortDelete -> |
| 119 | + let tbl' = SwitchTable.change tbl c_id (function |
| 120 | + | None -> None |
| 121 | + | Some eth_tbl -> |
| 122 | + Some(EthTable.filter eth_tbl (fun ~key:_ ~data:v -> v = port))) in |
| 123 | + return tbl' |
| 124 | + | PortAdd |
| 125 | + | PortModify -> return tbl |
| 126 | + end |
| 127 | + | _ -> failwith "WHAT MESSAGE IS THIS???" |
| 128 | + end |
| 129 | + end |
| 130 | + |
| 131 | +let main () = |
| 132 | + let open OF0x04Controller in |
| 133 | + create 6633 () |
| 134 | + >>= fun t -> |
| 135 | + Pipe.fold (listen t) ~init:SwitchTable.empty ~f:(switch t) |
| 136 | + |
| 137 | +let _ = main () |
| 138 | +let _ = never_returns (Scheduler.go ()) |
0 commit comments