#!/bin/sh
# \
exec wish "$0" ${1+"$@"}

## isdnmon - monitor status for isdn4linux channels


## Original author: 	Fritz Elfert
## Current version:	Roderich Schupp (roderich@syntec.m.eunet.de)


## First some legalese, just in case...
## 
## This software is copyrighted by the authors.
## 
## The authors hereby grant permission to use, copy, modify, distribute,
## and license this software and its documentation for any purpose, provided
## that existing copyright notices are retained in all copies and that this
## notice is included verbatim in any distributions. No written agreement,
## license, or royalty fee is required for any of the authorized uses.
## Modifications to this software may be copyrighted by their authors
## and need not follow the licensing terms described here, provided that
## the new terms are clearly indicated on the first page of each file where
## they apply.
## 
## IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
## FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
## ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
## DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
## POSSIBILITY OF SUCH DAMAGE.
## 
## THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
## FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
## IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
## NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
## MODIFICATIONS.

## Usage:
##
## The only user interaction is a popup menu available by clicking the right
## button anywhere in isdnmon:
##   "Recheck ISDN status"	- closes and reopens /dev/isdninfo
##   "Reread <config file>"	- rereads the config file (e.g. after you
##				  have added some alias definitions)
##   "Quit"			- quits isdnmon

## Customization:
##
## Isdnmon appearance, state-change actions, local area code etc
## may be configured by setting elements of the Config array
## (described below). Either change the isdnmon source itself or
## (recommended) put the settings in to one of the files sourced at
## startup:
##	- /etc/isdnlog/isdnmonrc (or whatever you set Config(isdnmonrc) to)
##	- ~/.isdnmonrc
##
## Mandatory Config elements:
##
## Config(ldprefix)	long distance prefix (0 in Germany)
##			
## Config(myprefix)	my area code (including long distance prefix)
##			(may be omitted if a valid isdnlog config file
##			is specified with Config(isdnlog,conf))
##
## Config(isdninfo)	isdn info device (usually /dev/isdninfo)
##			
## Config(action,STATE)	actions (triggered when a channel's state 
##			changes to STATE), STATE=offline|incoming|outgoing
##			
## Config(online,STATE)	appearance of "online" label for a channel
##			(depending on channel STATE); should be list of valid
##			"configure" options for a label widget;
##			STATE=offline|incoming|outgoing|init, where
##			INIT options are configured only at widget
##			creation time
##			
## Config(usage,USAGE)	appearance of "usage" label for a channel
##			(depending on channel USAGE); should be list of valid
##			"configure" options for a label widget;
##			USAGE=none|raw|modem|net|voice|fax|init, where
##			INIT options are configured only at widget
##			creation time
##			
## Config(phone,init)	initial options for "phone" label for a channel;
##			a -textvariable option will be added and this
##			variable will be set to the remote phone number 
##			(or an alias) of a connected channel (or to the
##			empty string if the channel is offline)
##			
## Config(header)	whether we want a header row identifying the driver
##			atop the rows of its channels (1) or a driver column
##			to the left of and spanning the rows of its channels (0)
##			
## Optional Config elements:
##
## Config(isdnmonrc)	initialization file to be source'd at startup
##
## Config(isdnlog,conf)	location of isdnlog's config file (usually
##			/etc/isdnlog/isdnlog.conf)
##			
## Config(isdnlog,avon)	location of isdnlog's avon text file
##			(usually /etc/isdnlog/avon)

array set Config {
  ldprefix		0

  isdninfo		/dev/isdninfo

  action,offline	{}
  action,incoming	{}
  action,outgoing	{}

  online,init		{ -text ? -width 3 -anchor w }
  online,offline	{ -text No  -bg green }
  online,incoming	{ -text Yes -bg yellow }
  online,outgoing	{ -text Yes -bg red }

  usage,init		{ -text ? -width 5 -anchor w }
  usage,none		{ -text None }
  usage,raw		{ -text Raw }
  usage,modem		{ -text Modem }
  usage,net		{ -text Net }
  usage,voice		{ -text Voice }
  usage,fax		{ -text Fax }

  phone,init		{ -text ? -width 20 -anchor w }

  header		1

  isdnmonrc		/etc/isdnlog/isdnmonrc
  isdnlog,conf		/etc/isdnlog/isdnlog.conf
  isdnlog,avon		/etc/isdnlog/avon
}


## get_info - read one set of data from isdninfo into Info array
## Reads 6 lines from Info(fd) and sets Info(MAP) for 
## MAP=idmap,chmap,drmap,usage,flags,phone.
proc get_info {} {
  global Config Info

  foreach info {idmap chmap drmap usage flags phone} {
    if {[gets $Info(fd) line] == -1} {
      puts stderr "getinfo: can't read $Config(isdninfo)"
      exit 1
    }
    if {[string compare "$info:" [lindex $line 0]]} {
      puts stderr "get_info: out of sync with $Config(isdninfo)"
      exit 1
    }
    set Info($info) [lreplace $line 0 0]
  }
}


# isdnlog configuration file (/etc/isdnlog/isdnlog.conf)
# (cf. isdn4k-utils-2.0/tools/isdnlog-2.41/README)
#  
# general format: 
#	- "#" starts comment, extends to end of line
#	- empty lines are ignored
#	- "\" at end of line continues on next line
#	- characters that must be quoted: "\\$@;,#"
#
# two type of lines:
#	- variable definition, format
#
#		NAME = VALUE 
#
#	  from the isdnlog source: recognized and parsed with 
#		sscanf(string,"%[a-zA-Z0-9] = %[^\n]",s1,s2) == 2
#	  variables include:
#
#	    MYPREFIX	my area code including leading long distance prefix 
#			("0" for Germany)
#
#	    MYMSNS	count of phone numbers assigned to my ISDN connection
#
#	- alias definition, format (fields separated by whitespace)
#
#		PHONE_NUMBER ALIAS  ... 
#
#	  the first MYMSNS aliases define my MSNs (their PHONE_NUMBERs
#	  don't include a prefix (area code), but may specify a trailing 
#	  "service", seperated by comma from the phone number proper)
#	  all other PHONE_NUMBERs must include a prefix (area code +
#	  long distance prefix)

## read_conf - read and parse isdnlog config file.
## Currently we only use the following information from isdnlog.conf:
## MYPREFIX		- set Config(myprefix) MYPREFIX
## PHONE_NUMBER ALIAS	- set Alias(PHONE_NUMBER) ALIAS
proc read_conf {} {
  global Config Alias AliasCache

  catch {unset Alias}				;# purge old information
  catch {unset AliasCache}			;# purge alias_lookup cache

  set Config(isdnlog,mymsns) 0
  set Config(isdnlog,msns)   {}

  if {[info exists Config(isdnlog,conf)] &&
      ![catch {set fd [open $Config(isdnlog,conf) r]}]} {
    set msns 0
    while {![eof $fd]} {
      set contd ""
      while {[gets $fd line] >= 0} {
	append contd $line
	if ![string match *\\ $contd] break
	set contd [string trimright $contd \\]
      }
      regsub {#.*$} $contd "" line
      if {[scan $line "%\[a-zA-Z0-9] = %\[^\n]" name value] == 2} {
	set value [string trimright $value]
	switch $name {
	  MYPREFIX	{ set Config(myprefix) $value }
	  MYMSNS	{ set Config(isdnlog,mymsns) $value }
	}
      } elseif {[scan $line "%s %s" phone alias] == 2} {
	if {$msns < $Config(isdnlog,mymsns)} {
	  regsub {,.*$} $phone "" phone		;# strip service indicator
	  lappend Config(isdnlog,msns) $phone
	  set phone "$Config(myprefix)$phone"
	  set alias "MSN$msns"
	  incr msns
	} else {
	  regsub -all "_" $alias " " alias	;# looks nicer
	}
	if {![string match "*\[?*\[\{]*" $phone]} {
	  set AliasCache($phone) $alias		;# contains no glob, cache it
	} else {
	  set Alias($phone) $alias
	}
      }
    }
    close $fd
  }
}


## alias_lookup - lookup the alias for a phone number 
## Tries AliasCache, aliases learned from isdnlog.conf, and area code 
## from isdnlog AVON file, in that order.
# ARGS: phone	- phone number (including area code and long distance prefix) 
# Returns:	alias or PHONE if no alias was found
##
proc alias_lookup {phone} {
  global AliasCache		
  if [catch {set alias $AliasCache($phone)}] {	;# not in cache
    set alias [conf_lookup $phone]		;# first look up in isdnlog.conf
    if {[string compare $alias $phone] == 0} {
      set alias [avon_lookup $phone]		;# then look up (prefix) in avon
    }
    set AliasCache($phone) $alias		;# cache the result
  }
  return $alias
}


## conf_lookup - lookup the alias for a phone number using isdnlog.conf
# ARGS: phone	- phone number (including area code and long distance prefix)
# Returns:	alias or PHONE if no alias was found 
##
proc conf_lookup {phone} {
  global Alias
  set alias $phone
  if [array exists Alias] {
    # NOTE: keys in Alias may be globs so we can't just index into Alias
    set idx [array startsearch Alias]
    while {[array anymore Alias $idx]} {
      set pat [array nextelement Alias $idx]
      if [string match $pat $phone] {
	set alias $Alias($pat)
	break
      }
    }
    array donesearch Alias $idx
  }
  return $alias
}

## avon_lookup - lookup alias for a phone number using isdnlog avon
# ARGS: phone	- phone number (including area code and long distance prefix)
# Returns: {alias rest} if a prefix of PHONE matches in avon
#	or PHONE if no prefix matches, where
#       ALIAS	- name corresponding to matched prefix of PHONE
#       REST	- rest of PHONE after prefix
##
proc avon_lookup {phone} {
  global Config
  set alias $phone
  if {[info exists Config(isdnlog,avon)] &&
      ![catch {set fd [open $Config(isdnlog,avon) r]}]} {
    # NOTE: this parses the AVON text file and is very slow;
    #	using the AVON ndbm (or gdbm) file generated by isdnlog
    #	would be faster, but all existing *dbm extensions for
    #	Tcl won't work unchanged on this file 
    while {[gets $fd line] >= 0} {
      set line [split $line :]
      if [string match [lindex $line 0]* $phone] {
	set prefix [lindex $line 0]
	set alias [list [lindex $line 1] \
			[string range $phone [string length $prefix] end]]
	break
      }
    }
    close $fd
  }
  return $alias
}

# This is how avon_lookup using the AVON [ng]dbm file would look like.
#	set alias $phone
# 	set len [expr [string length $phone]-1]
#	dbm_open ...
#	while {$len > 0} {
#	    set prefix 
#	    set fetch [dbm_fetch ...  [string range $phone 0 $len]]
#	    if success {
#		set alias [list $fetch [string range $phone [expr $len+1] end]]
#		break
#	    }
#	    incr $len -1
#	}
#	dbm_close ...
#	return $alias


## action - exec action triggered by a change in connection state
# ARGS: online	- new connection state, one of "incoming", "outgoing", "offline"
#       phone	- phone number (or its alias) of channel that changed state
# exec's (in background) the contents of Config(action,ONLINE);
# a "%s" in Config(action,ONLINE) will be replaced by PHONE
##
proc action {online phone} {
  global Config

  set action $Config(action,$online)
  if {[llength $action]==0} return

  switch $online {
    incoming -
    outgoing {
      if {[string first %s $action]!=-1} {set action [format $action $phone]}
    }
  }

  catch {eval exec $action < /dev/null &}
}


## check_status - open isdninfo and register fileevent
## Registers update_status to be called when isdninfo becomes readable.
## If isdninfo is already open, it will be closed and reopened.
proc check_status {} {
  global Config Info

  if [info exists Info(fd)] {
    fileevent $Info(fd) readable {}
    close $Info(fd)
  }

  set Info(fd) [open $Config(isdninfo) r]
  fileevent $Info(fd) readable [list update_status $Config(widget)]
}


## check_drivers - count installed drivers according to current Info(drmap)
# Returns:	number of installed drivers
##
proc check_drivers {} {
  global Info

  foreach dr $Info(drmap) ch $Info(chmap) {
    if {$dr >= 0 && $ch >= 0} {
      set drivers($dr) 1
    }
  }
  return [array size drivers]
}


## update_status - update display with information from Info(drmap) etc
## If number of installed drivers has changed since display was constructed
## (e.g. at  isdnmon startup) rebuild display.
# ARGS: w	- name of container widget for isdnmon display
## 
proc update_status {w} {
  global Config Info

  get_info

  # check whether number of installed drivers has changed
  if {[check_drivers] != $Info(drivers)} {build_table $w}

  # configure label widgets
  foreach dr $Info(drmap) ch $Info(chmap) us $Info(usage) ph $Info(phone) {
    if {$dr >= 0 && $ch >= 0} {
      set wdr      "$w.dr$dr"
      set usage    [expr $us & 7]
      set outgoing [expr $us & 128]
      set oldstate $Info(online$dr,$ch)

      if $usage {
	if $outgoing {
	  set newstate outgoing
	  # prepend MYPREFIX if its a local call
	  if {![string match "$Config(ldprefix)*" $ph]} {
	    set ph "$Config(myprefix)$ph"
	  }
	} else {
	  set newstate incoming
	  # Euro ISDN always shows incoming calls 
	  # with area code, but without long distance prefix
	  set ph "$Config(ldprefix)$ph"
	}
	set ph [alias_lookup $ph]
      } else {
	set newstate offline
	set ph ""
      }

      set Info(phone$dr,$ch) $ph	;# updates ${wdr}ph$i
      eval ${wdr}on$ch configure $Config(online,$newstate)
      eval ${wdr}us$ch configure $Config(usage,[lindex {none raw modem net voice fax ? ?} $usage])

      # if state changed trigger action
      if {[string compare $oldstate $newstate] != 0} {
	action $newstate $ph
      }
      set Info(online$dr,$ch) $newstate
    }
  }
}


## build_table - construct display
# ARGS: w	- name of container widget for isdnmon display
## 
proc build_table {w} {
  global Config Info

  # NOTE: we assume that all channels for a driver are
  #       consecutively numbered starting with 0
  foreach dr $Info(drmap) ch $Info(chmap) id $Info(idmap) {
    if {$dr >= 0 && $ch >= 0} {
      set driver($dr) $id
      if {![info exists channels($dr)]} {set channels($dr) 0}
      incr channels($dr)
    }
  }

  set Info(drivers) [array size channels]

  catch {destroy $w}
  frame $w

  foreach dr [array names channels] {
    set wdr "$w.dr$dr"

    # create header row (or column) for this driver
    label $wdr -relief raised -text "$driver($dr)"
    if $Config(header) {
      grid $wdr -columnspan 3 -sticky ew
    } else {
      grid $wdr -sticky ns
    }

    # for each channel of this driver create a row consisting
    # of three label widgets:
    # 	- online indicator
    #   - phone number (or alias) display
    #   - usage indicator
    for {set ch 0} {$ch < $channels($dr)} {incr ch} {
      # make sure Info(phone$dr,$ch) exists
      set Info(phone$dr,$ch)  ""
      set Info(online$dr,$ch) init

      eval label ${wdr}on$ch $Config(online,init)
      eval label ${wdr}ph$ch -textvariable Info(phone$dr,$ch) \
			     $Config(phone,init)
      eval label ${wdr}us$ch $Config(usage,init)

      if $Config(header) {
	grid ${wdr}on$ch ${wdr}ph$ch ${wdr}us$ch 
      } else {
	grid ^ ${wdr}on$ch ${wdr}ph$ch ${wdr}us$ch 
      }
    }
  }

  grid $w -sticky ew
}


set Config(widget) .tbl	;# name of frame holding status display
set Info(drivers) 0	;# forces build_table on first call to update_status

# source initialization file(s):
# (1) Config(isdnmonrc) 
# (2) $HOME/.isdnmonrc
if {[info exists Config(isdnmonrc)]} {lappend rcfiles $Config(isdnmonrc)}
if {[info exists env(HOME)]}         {lappend rcfiles $env(HOME)/.isdnmonrc}
foreach rc $rcfiles {
  if {[file readable $rc]}           {source $rc}
}

menu .pop -tearoff 0 -transient 1
.pop add command -label "Recheck ISDN status" -command "check_status"
if [info exists Config(isdnlog,conf)] {
  .pop add command -label "Reread $Config(isdnlog,conf)" \
                   -command "read_conf ; check_status"
}
.pop add command -label "Quit" -command "destroy ."
bind . <3> "tk_popup .pop %X %Y"

wm title . "ISDN-Status of [exec hostname]"

# get things going
read_conf
check_status
