Merge pull request #187 from frenetic-lang/gorges-tables

Gorges tables

Author: arjunguha

lib/SDN_Types.ml

@@ -397,9 +397,170 @@ let format_flowTable (fmt:Format.formatter) (l:flowTable) : unit =
         format_flow fmt f;
         true) false l in
   Format.fprintf fmt "]@]"
-
+		
 let string_of_action = make_string_of format_action
 let string_of_seq = make_string_of format_seq
 let string_of_par = make_string_of format_par
 let string_of_flow = make_string_of format_flow
-let string_of_flowTable = make_string_of format_flowTable
+
+let string_of_vlan (x : int) : string = 
+  Format.sprintf "Vlan = %d" x
+		 
+let string_of_vlanpcp (x : dlVlanPcp) : string =
+  Format.sprintf "VlanPcp = %d" x
+		 
+let string_of_ethType (x : dlTyp) : string =
+  let extra = if x = 0x800 then " (ip)" 
+	      else if x = 0x806 then " (arp)"
+	      else ""
+  in
+  Format.sprintf "EthType = 0x%x%s" x extra
+		 
+let string_of_ipProto (x : nwProto) : string =
+  let extra = match x with
+    | 0x01 -> " (icmp)"
+    | 0x02 -> " (igmp)"
+    | 0x06 -> " (tcp)"
+    | 0x11 -> " (udp)"
+    | _ -> ""
+  in
+  Format.sprintf "ipProto = 0x%x%s" x extra
+		 
+let string_of_ethSrc (x : dlAddr) : string =
+  Format.sprintf "EthSrc = %s" (Packet.string_of_mac x)
+		 
+let string_of_ethDst (x : dlAddr) : string =
+  Format.sprintf "EthDst = %s" (Packet.string_of_mac x)
+		 
+let string_of_ip4src (x : Pattern.Ip.t) : string =
+  Format.sprintf "IP4Src = %s" (Pattern.Ip.string_of x)
+		 
+let string_of_ip4dst (x : Pattern.Ip.t) : string =
+  Format.sprintf "IP4Dst = %s" (Pattern.Ip.string_of x)
+		 
+let string_of_tcpSrcPort (x : tpPort) : string =
+  Format.sprintf "TCPSrcPort = %d" x
+		 
+let string_of_tcpDstPort (x : tpPort) : string =
+  Format.sprintf "TCPDstPort = %d" x
+		 
+let string_of_inPort (x : portId) : string =
+  Format.sprintf "InPort = %lu" x
+		 
+let check (string_of : 'a -> string) 
+	  (x : 'a option) 
+	  (acc : string list) : string list =
+  match x with
+  | None -> acc
+  | Some x' -> (string_of x') :: acc
+				   
+(* Builds up a list of strings one for each pattern *)
+let pattern_list (p : Pattern.t) : string list =
+  check string_of_ethSrc p.dlSrc [] |>
+    check string_of_ethDst p.dlDst |>
+    check string_of_ethType p.dlTyp |>
+    check string_of_vlan p.dlVlan |>
+    check string_of_vlanpcp p.dlVlanPcp |>
+    check string_of_ip4src p.nwSrc |>
+    check string_of_ip4dst p.nwDst |>
+    check string_of_ipProto p.nwProto |>
+    check string_of_tcpSrcPort p.tpSrc |>
+    check string_of_tcpDstPort p.tpDst |>
+    check string_of_inPort p.inPort
+	  
+(* Given a flow, return a pair of list of strings where the first list
+ * contains the strings of the pattern and the second list contains
+ * the strings of the actions associated with the pattern. *)
+let to_entry (f : flow) : (string list) * (string list) =
+  let open Core.Std in
+  let open List in
+  let pattern_list = pattern_list f.pattern in
+  let action_list = map (concat (concat f.action)) string_of_action in
+  (pattern_list, action_list)
+    
+(* Pads a string with spaces so that it is atleast `len` characters. *)
+let pad (len : int) (e : string) : string =
+  let open Core.Std in
+  let padding_size = max 0 (len - (String.length e)) in
+  let padding = String.make padding_size ' ' in
+  String.concat [e; padding]
+		
+(* Helper function *)
+let unwrap x = 
+  match x with
+  | None -> 0
+  | Some x -> x
+		
+(* Given a list of entries to be displayed in the table, calculate a pair
+ * containing the max characters in a pattern string and action string *)
+let table_size (label : string) (entries : ((string list) * (string list)) list) : int * int =
+  let open Core.Std in
+  let open List in
+  let patterns = map entries fst |> concat in
+  let actions = map entries snd |> concat in
+  let max_p =  max_elt (map patterns String.length) (-) |> unwrap in
+  let max_a = max_elt (map actions String.length) (-) |> unwrap in
+  (max max_p ((String.length label) + 3 + (String.length "Pattern")), max max_a (String.length "Action"))
+    
+(* Create the top edge of the table *)
+let top max_p max_a : string =
+  let open Core.Std in
+  let open Char in
+  let fill = String.make (max_p + max_a + 5) '-' in
+  Format.sprintf "+%s+\n" fill
+		 
+(* Create the bottom edge of the table *)
+let bottom max_p max_a : string=
+  let open Core.Std in
+  let fill = String.make (max_p + max_a + 5) '-' in
+  Format.sprintf "+%s+\n" fill
+		 
+(* Create a divider between entries *)
+let div max_p max_a : string =
+  let open Core.Std in
+  let fill = String.make (max_p + max_a + 5) '-' in
+  Format.sprintf "|%s|\n" fill
+		 
+(* Create the columns of the table *)
+let title label max_p max_a : string =
+  let open Core.Std in
+  let pattern = pad max_p (Format.sprintf "%s | Pattern" label) in
+  let action = pad max_a "Action" in
+  Format.sprintf "| %s | %s |\n" pattern action
+		 
+(* Create a row in the table *)
+let string_of_entry (max_p : int) (max_a : int) (e : (string list) * (string list)) : string =
+  let open Core.Std in
+  let open List in
+  let padded_patterns = map (fst e) (pad max_p) in 
+  let padded_actions = map (snd e) (pad max_a) in 
+  let blank_action = String.make max_a ' ' in
+  let blank_pattern = String.make max_p ' ' in
+  let rec helper pats acts acc =
+    match pats, acts with
+    | [], [] -> if (length acc) = 1
+		then (Format.sprintf "| %s | %s |\n" blank_pattern blank_action) :: acc
+		else acc
+    | (p::ps), [] ->
+       let acc' = (Format.sprintf "| %s | %s |\n" p blank_action) :: acc in
+       helper ps [] acc'
+    | [], (a::rest) -> 
+       let acc' = (Format.sprintf "| %s | %s |\n" blank_pattern a) :: acc in
+       helper [] rest acc'
+    | (p::ps), (a::rest) -> 
+       let acc' = (Format.sprintf "| %s | %s |\n" p a) :: acc in
+       helper ps rest acc'
+  in 
+  helper padded_patterns padded_actions [(div max_p max_a)]
+  |> rev |> String.concat
+	      
+(* Given a label and a flowTable, returns an ascii flowtable *)
+let string_of_flowTable ?(label="") (tbl : flowTable) : string =
+  let open Core.Std in
+  let entries = List.map tbl to_entry in
+  let (max_p, max_a) = table_size label entries in
+  let t = (top max_p max_a) in
+  let l = (title label max_p max_a) in
+  let entry_strings = List.map entries (string_of_entry max_p max_a) in
+  let b = bottom max_p max_a in
+  String.concat (t :: l :: (List.append entry_strings [b]))

lib/SDN_Types.mli

@@ -217,4 +217,4 @@ val string_of_action : action -> string
 val string_of_seq : seq -> string
 val string_of_par : par -> string
 val string_of_flow : flow -> string
-val string_of_flowTable : flowTable -> string
+val string_of_flowTable : ?label:string -> flowTable -> string