#
# netinfo -- Protocol, service, network and host info
#
# January 2004
#
# Copyright 2004 Stuart Cassoff
#
# More work May 2006
#
# October 2006
# Added more functionality, improvements, docs, etc.
#
# January 2007
# Changed name to 'netinfo'.
# Made things much cleaner and more uniform.
# Rewrote most of it.
#
# July 2007
# Version 0.4
# Added 'networks'
# Changed '-type' to '-protocol'
# Changed order of fields
#
# September 2007
# Final adjustments to prog and docs, release
#
# September 2009
# Version 0.5
# Added 'ethers' database, netinfoDatabases command
#
# October 2014
# Version 0.6
# Finish up a bunch of small things that were sitting around since 2012
#   Minimum Tcl: 8.5
#   Redo tests a la tcltest 2
#   Switch license to ISC (essentially the same)
#   Rename nit.tcl to nid.tcl
# New
#   Put everything inside [namespace eval] instead of doing ns::proc
#


[namespace eval netinfo {

# netinfoInit --
#
#	Initialize/create variables, procs, exports, package.
#
# Arguments:
#	none
#
# Results:
#	none
#
proc netinfoInit {} {
	namespace export netinfoDatabases
	variable netinfoDatabases [list protocol service network host ether]
	foreach what $netinfoDatabases {
		variable ${what}DataFilename [file join / etc ${what}s]
		variable ${what}s [list ]
		variable ${what}Fields [list ]
		variable ${what}Indexes

		eval [string map [list @what@ $what] {
			proc @what@ {field value args} {
				set args [linsert $args 0 $field $value]
				variable @what@s
				variable @what@Indexes
				set cmd [list Lgetrows $@what@s]
				foreach {fld val} $args {
					lappend cmd $val [set @what@Indexes($fld)]
				}
				return [eval $cmd]
			}
			namespace export @what@
		}]

		eval [string map [list @what@ $what] {
			proc @what@Data {@what@Info name args} {
				variable @what@Indexes
				if {[llength $args] == 0} {
					set result [lindex $@what@Info $@what@Indexes($name)]
				} else {
					set args [linsert $args 0 $name]
					set result {}
					foreach e $args {
						lappend result [lindex $@what@Info $@what@Indexes($e)]
					}
				}
				return $result
			}
			namespace export @what@Data
		}]

		eval [string map [list @what@ $what] {
			proc @what@Fields {} {
				variable @what@Fields
				return $@what@Fields
			}
			namespace export @what@Fields
		}]

		eval [string map [list @what@ $what] {
			proc @what@DataFilename {{fileName {}}} {
				variable @what@DataFilename
				set fn $@what@DataFilename
				if {$fileName ne {}} {
					set @what@DataFilename $fileName
				}
				return $fn
			}
			namespace export @what@DataFilename
		}]
	}

	foreach what [list protocol network ether] \
		fields [list	{[list -name -aliases -comment -number]} \
				{[list -name -aliases -comment -number]} \
				{[list -name -address -comment]}] {
		eval [string map [list @what@ $what @What@ [string totitle $what] @fields@ $fields] {
			proc load@What@Data {} {
				LoadDataFile @what@
			}
			namespace export load@What@Data
			set @what@Fields @fields@
		}]
	}

	foreach what [list service host] \
		fields [list	{[list -name -aliases -comment -port -protocol]} \
				{[list -name -aliases -comment -address -domain]}] \
		sortField [list -protocol -domain] {

		eval [string map [list @what@ $what @What@ [string totitle $what] @fields@ $fields @sortField@ $sortField] {
			proc load@What@Data {} {
				variable @what@s
				variable @what@Indexes
				LoadDataFile @what@
				set @what@s [lsort -index $@what@Indexes(@sortField@) $@what@s]
				return {}
			}
			namespace export load@What@Data
			set @what@Fields @fields@
		}]
	}

	package provide netinfo 0.6
}
###



# netinfoDatabases --
#
#	List netinfo databases.
#
# Arguments:
#	none
#
# Results:
#	list	List of netinfo databases.
#
proc netinfoDatabases {} {
	variable netinfoDatabases
	return $netinfoDatabases
}
###



# ProtocolParseLine --
#
#	Parses a line of protocol data
#	into an internal format, ready for querying.
#
# Arguments:
#	line	Line of protocol data to parse.
#
# Results:
#	none
#
proc ProtocolParseLine {line} {
	variable protocols
	if {![regexp {(\S+)\s+(\S+)\s+(.*)\#\s*(.*)$} $line -> name number aliases comment]} {
		return
	}
	set aliases [join $aliases]
	lappend protocols [list $name $aliases $comment $number]
}
###



# ServiceParseLine --
#
#	Parses a line of service data
#	into an internal format, ready for querying.
#
# Arguments:
#	line	Line of service data to parse.
#
# Results:
#	none
#
proc ServiceParseLine {line} {
	variable services
	if {![regexp {^(\S+)\s+(\S+)\s*?(.*)$} $line -> name port aliases_comment]} {
		return
	}
	lassign [StrDivideAtStr $aliases_comment] aliases comment
	set aliases [join $aliases]
	set comment [string trim $comment]
	lassign [split $port /] port protocol
	lappend services [list $name $aliases $comment $port $protocol]
}
###



# NetworkParseLine --
#
#	Parses a line of network data
#	into an internal format, ready for querying.
#
# Arguments:
#	line	Line of network data to parse.
#
# Results:
#	none
#
proc NetworkParseLine {line} {
	variable networks
	if {![regexp {^(\S+)\s+(\S+)\s*?(.*)$} $line -> name number aliases_comment]} {
		return
	}
	lassign [StrDivideAtStr $aliases_comment] aliases comment
	set aliases [join $aliases]
	set comment [string trim $comment]
	lappend networks [list $name $aliases $comment $number]
}
###



# HostParseLine --
#
#	Parses a line of host data
#	into an internal format, ready for querying.
#
# Arguments:
#	line	Line of host data to parse.
#
# Results:
#	none
#
proc HostParseLine {line} {
	variable hosts
	if {![regexp {^(\S+)\s+(\S+)\s*?(.*)$} $line -> address name aliases_comment]} {
		return
	}
	lassign [StrDivideAtStr $aliases_comment] aliases comment
	set aliases [join $aliases]
	set comment [string trim $comment]
	set domain [expr {[string first {:} $address] == -1 ? {inet} : {inet6}}]
	lappend hosts [list $name $aliases $comment $address $domain]
}
###



# EtherParseLine --
#
#	Parses a line of ether data
#	into an internal format, ready for querying.
#
# Arguments:
#	line	Line of ether data to parse.
#
# Results:
#	none
#
proc EtherParseLine {line} {
	variable ethers
	if {![regexp {^(\S+)\s+(\S+)\s*?(.*)$} $line -> address name comment]} {
		return
	}
	lassign [StrDivideAtStr $comment] unused comment
	set comment [string trim $comment]
	lappend ethers [list $name $address $comment]
}
###



# LoadDataFile --
#
#	Parses data file
#	into an internal format, ready for querying.
#
# Arguments:
#	none
#
# Results:
#	none
#
proc LoadDataFile {what} {
	variable ${what}DataFilename
	variable ${what}s
	variable ${what}Fields
	variable ${what}Indexes


	set f [open [set ${what}DataFilename] r]
	set d [read $f]
	close $f

	set ${what}s [list ]
	array unset ${what}Indexes
	set i 0
	foreach f [set ${what}Fields] {
		set ${what}Indexes($f) $i
		incr i
	}

	set callout [string totitle ${what}]ParseLine
	foreach line [split $d \n] {
		set line [string trim $line]
		if {$line eq {} || [string index $line 0] eq {#}} {
			continue
		}
		$callout $line
	}
}
###



# Lgetrows --
#
#	Returns a list of lists matched
#	based on criteria.
#
# Arguments:
#	list
#	value
#	index
#	args
#
# Results:
#	list
#
proc Lgetrows {list value index args} {
	set args [linsert $args 0 $value $index]

	set single [expr {
		[lsearch -glob $args {*\**}] == -1 &&
		[lsearch -glob $args {*\?*}] == -1 &&
		[lsearch -glob $args {*\[*\]*}] == -1
	}]

	set rows {}
	foreach row $list {
		set ok 1
		foreach {val ind} $args {
			if {[lsearch -glob [lindex $row $ind] $val] == -1} {
				set ok 0
				break
			}
		}
		if {$ok} {
			if {$single} {
				return $row
			}
			lappend rows $row
		}
	}
	return $rows
}
###



# StrDivideAtStr --
#
#	Divide string into two strings at index containing
#	divider string (default #).
#	Part of string containing divider string is discarded.
#
# Arguments:
#	str	String to divide.
#	divStr	String to match for division index.
#
# Results:
#	Always returns a list of two strings.
#	 str          result
#	----------------------------
#	 "abc#def"    {"abc" "def"}
#	 "abc"        {"abc" ""}
#	 "abc#"       {"abc" ""}
#	 "#def"       {"" "def"}
#
proc StrDivideAtStr {str {divStr {#}}} {
	set index [string first $divStr $str]
	if {$index == -1} {
		return [list $str ""]
	}
	set s1 [string range $str 0 [incr index -1]]
	incr index [string length $divStr]
	set s2 [string range $str [incr index] end]
	return [list $s1 $s2]
}
###


namespace current}]::netinfoInit


# EOF
