#!/bin/sh
# just a comment line\
   exec ibdmsh "$0" "$@"

# This program provides an incremental way to build an ibnl
# by providing lst file (with one HCA) and the name of the port
# the HCA connects to

# Usage:
proc usage {} {
   puts "Usage: lst2ibnl \[-h\]\[-v\] -l <lst file> <-p port-name> <-s sys-type>"
}

# Help message:
proc help {} {
   set helpMsg {
NAME
      lst2ibnl

SYNOPSIS
      lst2ibnl [-h][-v] -l <lst file> <-p port-name> <-s sys-type>

DESCRIPTION
      lst2ibnl provide means to create an IBNL (IB Netlist) describing a
      system made of IB switch devices. The IBNL created is representing a box
      holding the part of the fabric that is encapsulated in the explored
      switch system. This utility enables "naming" a single "front panel port"
      (FPP) of the box in each invocation. This FPP is the one connected to the
      single in the fabric HCA. Performing a sequence of runs enables refining
      the IBNL of the switch system until all FPPs (or the interesting ones)
      are named. The resulting file is named <sys-type>.ibnl. A temporary file
      which is used to accumulate data between runs is named <sys-type>.lst.

      NOTE: after building and refining the IBNL file it should be copied into
      the ibnl directory of the ibdm package. Under OFED it is in
      /usr/local/ofed/lib/ibdm1.0/ibnl or /usr/local/ofed/lib64/ibdm1.0/ibnl

ARGUMENTS (required)
      -l <lst file>
          Input fabric link listing file as generated by OpenSM
          (/tmp/subnet.lst or /var/log/osm.lst depending on the version) or
          ibdiagnet (/tmp/ibdiagnet.lst)

      -p <port-name>
          The name of the switch system front panel port connected to the
          single HCA in the fabric.

      -s <sys-type>
          Name of the switch system being discovered. The output IBNL file
          is going to describe the system with the exact given name and be
          named <sys-type>.ibnl

OPTIONS
      -v
          Verbose mode - provides much information on the process

      -h
          Provides this help message

EXAMPLE
      Here is an example series of steps required for building an IBNL for
      system named "Gnu" which have 16 FPP named L1/P1 L1/P2 .. L1/P8
      and L2/P1 .. L2/P8 :

      0. Make sure the file Gnu.lst does not exist
      1. Connect an HCA in machine we call "host" to FPP L1/P1
      2. Run ibdiagnet on the "host" machine (will create /tmp/ibdiagnet.lst)
      3. Run lst2ibnl -l /tmp/ibdiagnet.lst -s Gnu -p L1/P1
      4. Perform steps 1..3 by connecting the "host" to each one of the
         front panel ports and providing its name on the subsequent call to
         lst2ibnl

      NOTE: If you only plan to connect the system with specific set of
      ports. You can limit the refinement steps to these ports only.

    }
    puts $helpMsg
}

########################################################################
# get the list of fabric HCA ports
proc getHcaPorts {fabric} {
   global IB_SW_NODE

   set hcaPorts {}
   foreach nameNNode [IBFabric_NodeByName_get $fabric] {
      set node [lindex $nameNNode 1]
      if {[IBNode_type_get $node] != $IB_SW_NODE} {
         set numPorts [IBNode_numPorts_get $node]
         for {set pn 1} {$pn <= $numPorts} {incr pn} {
            set port [IBNode_getPort $node $pn]
            if {($port != "") && ([IBPort_p_remotePort_get $port] != "")} {
               lappend hcaPorts $port
            }
         }
      }
   }
   return $hcaPorts
}

proc copyHcaPort {port portName old} {
   global IB_CA_NODE
   # find the node accross the port
   set portNum [IBPort_num_get $port]
   set remPort [IBPort_p_remotePort_get $port]
   set remPortNum [IBPort_num_get $remPort]
   set remNode [IBPort_p_node_get $remPort]
   set nGuid [IBNode_guid_get $remNode]
   set node [IBPort_p_node_get $port]
   set nodeName [IBNode_name_get $node]
   set sys [IBNode_p_system_get $node]
   set sysName [IBSystem_name_get $sys]

   set oldRemNode [IBFabric_getNodeByGuid $old $nGuid]
   if {$oldRemNode == ""} {
      puts "-E- Failed to find matching node for $portName (by guid:$nGuid)"
      return 1
   }

   set oldRemPort [IBNode_getPort $oldRemNode $remPortNum]
   if {$oldRemPort == ""} {
      set n [IBNode_name_get $oldRemNode]
      puts "-E- Failed to get port $remPortNum on node:$n"
      return 1
   }

   # but we might already have it connected somewhere ????
   set oldRemRemPort [IBPort_p_remotePort_get $oldRemPort]
   if {$oldRemRemPort != ""} {
      set n [IBPort_getName $oldRemPort]
      set rn [IBPort_getName $oldRemRemPort]
      puts "-E- Old port:$n already connected to port:$rn"
      return 1
   }

   # ok now we are ready to make the new HCA, name it and connect:
   set oldHcaSys  [new_IBSystem $sysName $old "HCA"]
   set oldHcaNode [new_IBNode $nodeName $old $oldHcaSys $IB_CA_NODE 2]
   set oldHcaPort [IBNode_makePort $oldHcaNode $portNum]

   # copy relevant data
   IBNode_devId_set $oldHcaNode [IBNode_devId_get $node]
   IBNode_revId_set $oldHcaNode [IBNode_revId_get $node]
   IBNode_guid_set $oldHcaNode [IBNode_guid_get $node]
   IBPort_guid_set $oldHcaPort [IBPort_guid_get $port]
   IBPort_base_lid_set $oldHcaPort [IBPort_base_lid_get $port]
   IBSystem_guid_set $oldHcaSys [IBSystem_guid_get $sys]
   # have the host represent the port name given
   IBNode_attributes_set $oldHcaNode "host=$portName"

   IBPort_connect $oldHcaPort $oldRemPort
   return $oldHcaPort
}

# pad with 0 a 64 bit num
proc pad64 {val} {
   return [string range $val 2 end]
}

# provide LST file format for a single port
proc getLstStr {port} {
   global IB_CA_NODE
   set str {}

   set node [IBPort_p_node_get $port]
   set sys [IBNode_p_system_get $node]

   if {[IBNode_type_get $node] == $IB_CA_NODE} {
      lappend str "CA"
      if {![regexp {host=(.*)} [IBNode_attributes_get $node] d1 name]} {
	set name "U[getNodeIndex $node]"
      }
      set desc "$name HCA-1 JUNK"
   } else {
      lappend str "SW"
      set desc "SWITCH JUNK"
   }

   lappend str "Ports:[format %02x [IBNode_numPorts_get $node]]"
   lappend str "SystemGUID:[pad64 [IBSystem_guid_get $sys]]"
   lappend str "NodeGUID:[pad64 [IBNode_guid_get $node]]"
   lappend str "PortGUID:[pad64 [IBPort_guid_get $port]]"
   lappend str "VenID:000002C9"
   lappend str "DevID:[format %08X [IBNode_devId_get $node]]"
   lappend str "Rev:[format %08X [IBNode_revId_get $node]]"
   lappend str $desc
   lappend str "LID:[format %04x [IBPort_base_lid_get $port]]"
   lappend str "PN:[format %02x [IBPort_num_get $port]]"

   return $str
}

# reassign a unique guid to both port and node
proc reassignGuid {fabric port} {
    global RE_ASSIGNED
    if {[info exists RE_ASSIGNED($port)]} {return}
    set RE_ASSIGNED($port) 1
    set newGuid "0x[llength [IBFabric_NodeByGuid_get $fabric]]"
    if {[IBPort_guid_get $port] != $newGuid} {
       set node [IBPort_p_node_get $port]
       IBPort_guid_set $port $newGuid
       IBNode_guid_set $node $newGuid
       puts "-I- Re-Assign GUID to port [IBPort_getName $port] to $newGuid"
    }
}

# write out an lst file
proc writeLstFile {fabric fileName thisPort} {
   set f [open $fileName w]

   foreach nameNNode [IBFabric_NodeByName_get $fabric] {
      set node [lindex $nameNNode 1]
      set numPorts [IBNode_numPorts_get $node]
      for {set pn 1} {$pn <= $numPorts} {incr pn} {
         set port [IBNode_getPort $node $pn]
         if {$port == $thisPort} {
             reassignGuid $fabric $port
         }
         if {$port != ""} {
            set remPort [IBPort_p_remotePort_get $port]
            if {$remPort != ""} {
               if {$remPort == $thisPort} {
                   reassignGuid $fabric $remPort
               }
               set p1Str [getLstStr $port]
               set p2Str [getLstStr $remPort]
               puts $f "{ $p1Str } { $p2Str } PHY=4x LOG=ACT SPD=2.5"
            }
         }
      }
   }

   puts "-I- Written LST file:$fileName"
   return 0
}

# allocate device indexies for the IBNL devices
proc getNodeIndex {node} {
   global IDX_BY_NODE

   # we might already have an index is was connected
   if {[info exists IDX_BY_NODE($node)]} {
      set devIdx $IDX_BY_NODE($node)
   } else {
      set devIdx [expr [array size IDX_BY_NODE] + 1]
      set IDX_BY_NODE($node) $devIdx
   }
   return $devIdx
}

proc getPortByGuid {ports guid} {
  foreach p $ports {
    if {[IBPort_guid_get $p] == $guid} {
       return $p
    }
  }
  return ""
}

# write out an IBNL of all switches in the given fabric.
# assume every HCA represent external plug of the given node name
proc writeIBNL {fabric sysName} {
   global IB_SW_NODE
   set fileName "$sysName.ibnl"
   set f [open $fileName w]
   fconfigure $f -translation lf
   puts $f "TOPSYSTEM $sysName\n"

   foreach nameNNode [IBFabric_NodeByName_get $fabric] {
      set node [lindex $nameNNode 1]
      set name [lindex $nameNNode 0]
      set devIdx [getNodeIndex $node]
      if {[IBNode_type_get $node] != $IB_SW_NODE} {
         # WE SHOULD ONLY ADD THE EXTERNAL CONNS!
         if {[regexp {^U} $name]} {
            set numPorts [IBNode_numPorts_get $node]
            set devId "MT[IBNode_devId_get $node]"
            puts $f "NODE CA $numPorts $devId U$devIdx"
         } else {
            set numPorts 0
         }
      } else {
         set numPorts [IBNode_numPorts_get $node]
         if {$numPorts == 8} {
            set devId MT43132
         } elseif {$numPorts == 24} {
            set devId MT47396
         } else {
            set devId UNKNOWN
         }
         puts $f "NODE SW $numPorts $devId U$devIdx"
      }

      for {set pn 1} {$pn <= $numPorts} {incr pn} {
         set port [IBNode_getPort $node $pn]
         if {$port != ""} {
            set remPort [IBPort_p_remotePort_get $port]
            if {$remPort != ""} {
               # figure out if it connects to an HCA or SW
               set remNode [IBPort_p_node_get $remPort]
               if {[IBNode_type_get $remNode] != $IB_SW_NODE} {
                  set atts [IBNode_attributes_get $remNode]
                  if {![regexp {host=(.*)} $atts d1 name]} {
                     set remIdx [getNodeIndex $remNode]
                     set remPortNum [IBPort_num_get $remPort]
                     puts $f "    $pn -> U$remIdx $remPortNum"
                  } else {
                     puts $f "    $pn -> $name"
                  }
               } else {
                  set remIdx [getNodeIndex $remNode]
                  set remPortNum [IBPort_num_get $remPort]
                  puts $f "    $pn -> U$remIdx $remPortNum"
               }
            }
            # has remote port
         }
         # is a port
      }
      # every port num

      puts $f ""
   }
   # all nodes
   puts "-I- Written IBNL file:$fileName"
   return 0
}

########################################################################
#
# GETOPTS
#
set optind 0

proc getopt { argslist optstring optret argret } {
	global optind optindc
	upvar $optret retvar
	upvar $argret optarg

	# default settings for a normal return
	set optarg ""
	set retvar ""
	set retval 0

	# check if we are in a single char mode or support long
	# option string
	if {[string match "* *" $optstring]} {
		set longOptMode 1
	} else {
		set longOptMode 0
	}

	# check if we're past the end of the args list
	if { $optind < [ llength $argslist ] } then {

		# if we got -- or an option that doesn't begin with -, return (skipping
		# the --).  otherwise process the option arg.
		switch -glob -- [ set arg [ lindex $argslist $optind ]] {
			"--" {
				incr optind
			}

			"-" {
            set optarg "Illegal option: '-'"
            set retvar $optarg
            set retval -1
			}

			"-*" {
				# opt needs to return the name of the option
				regexp -- {-([^:]+):?} $arg d1 opt
				incr optind

				if {$longOptMode} {
					# options are defined as words optionaly containing ":"
					if { [ lsearch -regexp $optstring "^$opt:?\$" ] >= 0 } then {
						set retvar $opt
						set retval 1
						if { [ lsearch -regexp $optstring "^$opt:\$" ] >= 0 } then {
							if { $optind < [ llength $argslist ] } then {
								set optarg [lindex $argslist $optind]
								incr optind
							} else {
								set optarg "Option requires an argument -- $opt"
								set retvar $optarg
								set retval -1
							}
						}
					} else {
						set optarg "Illegal option -- $opt"
						set retvar $optarg
						set retval -1
					}
				} else {
					# traditional single char options
					if { [ string match "*$opt*" $optstring ] } then {
						set retvar $opt
						set retval 1
						if { [ string match "*$opt:*" $optstring ] } then {
							if { $optind < [ llength $argslist ] } then {
								set optarg [lindex $argslist $optind]
								incr optind
							} else {
								set optarg "Option requires an argument -- $opt"
								set retvar $optarg
								set retval -1
							}
						}
					} else {
						set optarg "Illegal option -- $opt"
						set retvar $optarg
						set retval -1
					}
				}
			}
		}
	}

	return $retval
}

########################################################################
#
# MAIN FLOW:
#

set found(l) 0
set found(s) 0
set found(p) 0
set found(g) 0

while { [ set err [ getopt $argv "vhl:p:s:g:" opt optarg ]] } {
  if { $err < 0 } then {
    puts stderr "$argv0: $arg"
    usage
  } else {
    switch -exact $opt {
		 g {
			 set found(g) 1
			 set portGuid $optarg
		 }
		 p {
			 set found(p) 1
			 set portName $optarg
		 }
		 s {
			 set found(s) 1
			 set sysName $optarg
		 }
		 l {
			 set found(l) 1
			 set lstFile $optarg
		 }
		 v {
			 set verboseMode 1
		 }
		 h {
			 help
			 exit 0
		 }
    }
  }
}

set argv [ lrange $argv $optind end ]

if { ! ($found(s) && $found(l) && $found(p) && $found(g))} then {
	puts stdout "Error: missing mandatory arguments"
	usage
	exit 1
}

set old [new_IBFabric]
set new [new_IBFabric]

set sysLstFile "$sysName.lst"
set sysIBNLFile "$sysName.ibnl"

puts "-I- Parsing new system lst for port:$portName"
IBFabric_parseSubnetLinks $new $lstFile

set hcaPorts [getHcaPorts $new]
#set nHcas [llength $hcaPorts]
#if {$nHcas != 1} {
#   puts "-E- Given lst file should have exactly one HCA (got $nHcas)"
#   exit 1
#}
set thisPort [getPortByGuid $hcaPorts $portGuid]
if {$thisPort == ""} {
   puts "-E- Given port guid is not found in subnet"
   exit 1
}
if {[file exist $sysLstFile]} {
   IBFabric_parseSubnetLinks $old $sysLstFile
   set thisPort [copyHcaPort $thisPort $portName $old]
} else {
   set old $new
   set node [IBPort_p_node_get $thisPort]
   IBNode_attributes_set $node host=$portName
}

# write lst file
if {[file exists $sysLstFile]} {
   file copy $sysLstFile $sysLstFile.[pid]
}
writeLstFile $old $sysLstFile $thisPort

# write IBNL
writeIBNL $old $sysName

exit 0

