@@ -397,9 +397,156 @@ let format_flowTable (fmt:Format.formatter) (l:flowTable) : unit =
397
397
format_flow fmt f;
398
398
true ) false l in
399
399
Format. fprintf fmt " ]@]"
400
-
400
+
401
401
let string_of_action = make_string_of format_action
402
402
let string_of_seq = make_string_of format_seq
403
403
let string_of_par = make_string_of format_par
404
404
let string_of_flow = make_string_of format_flow
405
405
let string_of_flowTable = make_string_of format_flowTable
406
+
407
+ let string_of_vlan (x : int ) : string =
408
+ Format. sprintf " Vlan = %d" x
409
+
410
+ let string_of_vlanpcp (x : dlVlanPcp ) : string =
411
+ Format. sprintf " VlanPcp = %d" x
412
+
413
+ let string_of_ethType (x : dlTyp ) : string =
414
+ let extra = if x = 0x800 then " (ip)"
415
+ else if x = 0x806 then " (arp)"
416
+ else " "
417
+ in
418
+ Format. sprintf " EthType = 0x%x%s" x extra
419
+
420
+ let string_of_ipProto (x : nwProto ) : string =
421
+ let extra = match x with
422
+ | 0x01 -> " (icmp)"
423
+ | 0x02 -> " (igmp)"
424
+ | 0x06 -> " (tcp)"
425
+ | 0x11 -> " (udp)"
426
+ | _ -> " "
427
+ in
428
+ Format. sprintf " ipProto = 0x%x%s" x extra
429
+
430
+ let string_of_ethSrc (x : dlAddr ) : string =
431
+ Format. sprintf " EthSrc = %s" (Packet. string_of_mac x)
432
+
433
+ let string_of_ethDst (x : dlAddr ) : string =
434
+ Format. sprintf " EthDst = %s" (Packet. string_of_mac x)
435
+
436
+ let string_of_ip4src (x : Pattern.Ip.t ) : string =
437
+ Format. sprintf " IP4Src = %s" (Pattern.Ip. string_of x)
438
+
439
+ let string_of_ip4dst (x : Pattern.Ip.t ) : string =
440
+ Format. sprintf " IP4Dst = %s" (Pattern.Ip. string_of x)
441
+
442
+ let string_of_tcpSrcPort (x : tpPort ) : string =
443
+ Format. sprintf " TCPSrcPort = %d" x
444
+
445
+ let string_of_tcpDstPort (x : tpPort ) : string =
446
+ Format. sprintf " TCPDstPort = %d" x
447
+
448
+ let string_of_inPort (x : portId ) : string =
449
+ Format. sprintf " In Port = %lu" x
450
+
451
+ let check (string_of : 'a -> string )
452
+ (x : 'a option )
453
+ (acc : string list ) : string list =
454
+ match x with
455
+ | None -> acc
456
+ | Some x' -> (string_of x') :: acc
457
+
458
+ (* Builds up a list of strings one for each pattern *)
459
+ let pattern_list (p : Pattern.t ) : string list =
460
+ check string_of_ethSrc p.dlSrc [] |>
461
+ check string_of_ethDst p.dlDst |>
462
+ check string_of_ethType p.dlTyp |>
463
+ check string_of_vlan p.dlVlan |>
464
+ check string_of_vlanpcp p.dlVlanPcp |>
465
+ check string_of_ip4src p.nwSrc |>
466
+ check string_of_ip4dst p.nwDst |>
467
+ check string_of_ipProto p.nwProto |>
468
+ check string_of_tcpSrcPort p.tpSrc |>
469
+ check string_of_tcpDstPort p.tpDst |>
470
+ check string_of_inPort p.inPort
471
+
472
+ (* Given a flow, return a pair of list of strings where the first list
473
+ * contains the strings of the pattern and the second list contains
474
+ * the strings of the actions associated with the pattern. *)
475
+ let to_entry (f : flow ) : (string list) * (string list) =
476
+ let open Core.Std.List in
477
+ let pattern_list = pattern_list f.pattern in
478
+ let action_list = map (concat (concat f.action)) string_of_action in
479
+ (pattern_list, action_list)
480
+
481
+ (* Pads a string with spaces so that it is atleast `len` characters. *)
482
+ let pad (len : int ) (e : string ) : string =
483
+ let padding_size = max 0 (len - (String. length e)) in
484
+ let padding = String. make padding_size ' ' in
485
+ Core.Std.String. concat [e; padding]
486
+
487
+ (* Given a list of entries to be displayed in the table, calculate a pair
488
+ * containing the max characters in a pattern string and action string *)
489
+ let table_size (sw_id : switchId ) (entries : ((string list) * (string list) ) list ) : int * int =
490
+ let open Core.Std.List in
491
+ let patterns = map entries fst |> concat in
492
+ let actions = map entries snd |> concat in
493
+ let max_p = max_elt (map patterns String. length) (- ) |> Core.Std. uw in
494
+ let max_a = max_elt (map actions String. length) (- ) |> Core.Std. uw in
495
+ (max max_p ((Int64. to_string sw_id |> String. length) + 3 + (String. length " Pattern" )), max max_a (String. length " Action" ))
496
+
497
+ (* Create the top edge of the table *)
498
+ let top max_p max_a : string =
499
+ let open Char in
500
+ let fill = String. make (max_p + max_a + 5 ) '-' in
501
+ Format. sprintf " +%s+\n " fill
502
+
503
+ (* Create the bottom edge of the table *)
504
+ let bottom max_p max_a : string =
505
+ let fill = String. make (max_p + max_a + 5 ) '-' in
506
+ Format. sprintf " +%s+\n " fill
507
+
508
+ (* Create a divider between entries *)
509
+ let div max_p max_a : string =
510
+ let fill = String. make (max_p + max_a + 5 ) '-' in
511
+ Format. sprintf " |%s|\n " fill
512
+
513
+ (* Create the columns of the table *)
514
+ let title sw_id max_p max_a : string =
515
+ let pattern = pad max_p (Format. sprintf " %Ld | Pattern" sw_id) in
516
+ let action = pad max_a " Action" in
517
+ Format. sprintf " | %s | %s |\n " pattern action
518
+
519
+ (* Create a row in the table *)
520
+ let string_of_entry (max_p : int ) (max_a : int ) (e : (string list) * (string list) ) : string =
521
+ let open Core.Std.List in
522
+ let padded_patterns = map (fst e) (pad max_p) in
523
+ let padded_actions = map (snd e) (pad max_a) in
524
+ let blank_action = String. make max_a ' ' in
525
+ let blank_pattern = String. make max_p ' ' in
526
+ let rec helper pats acts acc =
527
+ match pats, acts with
528
+ | [] , [] -> if (length acc) = 1
529
+ then (Format. sprintf " | %s | %s |\n " blank_pattern blank_action) :: acc
530
+ else acc
531
+ | (p ::ps ), [] ->
532
+ let acc' = (Format. sprintf " | %s | %s |\n " p blank_action) :: acc in
533
+ helper ps [] acc'
534
+ | [] , (a ::rest ) ->
535
+ let acc' = (Format. sprintf " | %s | %s |\n " blank_pattern a) :: acc in
536
+ helper [] rest acc'
537
+ | (p ::ps ), (a ::rest ) ->
538
+ let acc' = (Format. sprintf " | %s | %s |\n " p a) :: acc in
539
+ helper ps rest acc'
540
+ in
541
+ helper padded_patterns padded_actions [(div max_p max_a)]
542
+ |> rev |> Core.Std.String. concat
543
+
544
+ (* Given a switch id and a flowTable, returns an ascii flowtable *)
545
+ let ascii_of_flowTable (sw_id : switchId ) (tbl : flowTable ) : string =
546
+ let entries = Core.Std.List. map tbl to_entry in
547
+ let (max_p, max_a) = table_size sw_id entries in
548
+ let t = (top max_p max_a) in
549
+ let l = (title sw_id max_p max_a) in
550
+ let entry_strings = Core.Std.List. map entries (string_of_entry max_p max_a) in
551
+ let b = bottom max_p max_a in
552
+ Core.Std.String. concat (t :: l :: (Core.Std.List. append entry_strings [b]))
0 commit comments