vlan.ml

open Angstrom

let vlan_raw =
  "VLAN Name                             Status    Ports
---- -------------------------------- --------- -------------------------------
1    default                          active    Gi0/1
10   Management                       active
50   VLan50                           active    Fa0/1, Fa0/2, Fa0/3, Fa0/4, Fa0/5, Fa0/6, Fa0/7, Fa0/8, Fa0/9
                                                Fa0/10, Fa0/11, Fa0/12
60   VLan60                           active    Fa0/13, Fa0/14, Fa0/15, Fa0/16, Fa0/17, Fa0/18, Fa0/19, Fa0/20
                                                Fa0/21, Fa0/22, Fa0/23, Fa0/24
1002 fddi-default                     act/unsup
1003 token-ring-default               act/unsup
1004 fddinet-default                  act/unsup
1005 trnet-default                    act/unsup

VLAN Type  SAID       MTU   Parent RingNo BridgeNo Stp  BrdgMode Trans1 Trans2
---- ----- ---------- ----- ------ ------ -------- ---- -------- ------ ------
1    enet  100001     1500  -      -      -        -    -        0      0
10   enet  100010     1500  -      -      -        -    -        0      0
50   enet  100050     1500  -      -      -        -    -        0      0
60   enet  100060     1500  -      -      -        -    -        0      0
1002 fddi  101002     1500  -      -      -        -    -        0      0
1003 tr    101003     1500  -      -      -        -    srb      0      0
1004 fdnet 101004     1500  -      -      -        ieee -        0      0
1005 trnet 101005     1500  -      -      -        ibm  -        0      0

Remote SPAN VLANs
------------------------------------------------------------------------------


Primary Secondary Type              Ports
------- --------- ----------------- ------------------------------------------"

type vlan = {
  vlan_id : int;
  name : string;
  status : string;
  ports : string list;
}

type vlan_stat = {
  vlan_id : int;
  vl_type : string;
  said : string;
  mtu : int;
  parent : string;
  ring_no : string;
  bridge_no : string;
  stp : string;
  bridge_mode : string;
  trans1 : int;
  trans2 : int;
}

let is_whitespace = function '\x20' | '\x09' -> true | _ -> false

let whitespace = take_while is_whitespace

let whitespace1 = take_while1 is_whitespace

let is_newline = function '\x0a' | '\x0d' -> true | _ -> false

let newline = take_while is_newline

let newline1 = take_while1 is_newline

let is_digit = function '0' .. '9' -> true | _ -> false

let digit = take_while is_digit

let digit1 = take_while is_digit

let is_alpha = function
  | '_' | '-' | 'a' .. 'z' | 'A' .. 'Z' -> true
  | _ -> false

let is_iface_char = function '/' | '.' -> true | _ -> false

let is_ident c = is_alpha c || is_digit c || is_iface_char c

let ident = take_while is_ident

let ident1 = take_while1 is_ident

let vl_header =
  Angstrom.string "VLAN" *> take_while1 is_whitespace *> string_ci "name"
  *> take_while1 is_whitespace *> string_ci "status"
  *> take_while1 is_whitespace *> string_ci "ports" *> take_while is_whitespace
  *> newline

let sep_row = Angstrom.string "--" *> take_till is_newline *> skip_many newline1

let vl_stat_header =
  Angstrom.string "VLAN" *> whitespace *> string_ci "type" *> whitespace
  *> string_ci "said" *> whitespace *> string_ci "mtu" *> take_till is_newline
  *> newline

let iface_list = sep_by (string ", ") ident1 <* newline1

(* VLAN Name Status Ports *)
let vl_data_row =
  digit1 <* whitespace1 >>= fun vid ->
  ident1 <* whitespace1 >>= fun name ->
  ident1 <* whitespace >>= fun status ->
  iface_list >>= fun ifaces ->
  many (whitespace1 *> iface_list) >>= fun add_ifaces ->
  return
    {
      vlan_id = vid |> int_of_string;
      name;
      status;
      ports = List.append ifaces (List.flatten add_ifaces);
    }

(* VLAN Type SAID MTU Parent RingNo BridgeNo Stp BrdgMode Trans1 Trans2 *)
let vl_stats_row =
  digit1 <* whitespace1 >>= fun vid ->
  ident1 <* whitespace1 >>= fun vtype ->
  ident1 <* whitespace1 >>= fun said ->
  ident1 <* whitespace1 >>= fun mtu ->
  ident1 <* whitespace1 >>= fun parent ->
  ident1 <* whitespace1 >>= fun ringno ->
  ident1 <* whitespace1 >>= fun brno ->
  ident1 <* whitespace1 >>= fun stp ->
  ident1 <* whitespace1 >>= fun brmode ->
  ident1 <* whitespace1 >>= fun t1 ->
  ident1 <* whitespace1 <* skip_many newline1 >>= fun t2 ->
  return
    {
      vlan_id = vid |> int_of_string;
      vl_type = vtype;
      said;
      mtu = mtu |> int_of_string;
      parent;
      ring_no = ringno;
      bridge_no = brno;
      stp;
      bridge_mode = brmode;
      trans1 = t1 |> int_of_string;
      trans2 = t2 |> int_of_string;
    }

let vlan_info = vl_header *> sep_row *> many vl_data_row <* skip_many newline1

let vlan_stats =
  vl_stat_header *> sep_row *> many vl_stats_row <* skip_many any_char

let p =
  match
    Angstrom.parse_string ~consume:All
      ( vlan_info >>= fun vli ->
        vlan_stats >>= fun vls -> return (vli, vls) )
      vlan_raw
  with
  | Ok v -> v
  | Error msg -> failwith msg