head	1.2;
access;
symbols
	tcllib-1-13:1.2
	tcllib-1-12:1.2
	tklib-0-5:1.2
	tcllib-1-11-1:1.2
	tcllib-1-11:1.2;
locks; strict;
comment	@# @;


1.2
date	2008.05.06.03.52.17;	author andreas_kupries;	state Exp;
branches;
next	1.1;

1.1
date	2008.05.01.07.06.32;	author andreas_kupries;	state Exp;
branches;
next	;


desc
@@


1.2
log
@
	* ../../apps/nns: Switched to use of nameserv::auto to handle the
	* ../../apps/nnslog: loss and restoration of the server
	  automatically. Got rid of the colorization frills.

	* server.tcl (::nameserv::server::bind): Small extension of log
	* pkgIndex.tcl: output for failure case of bind. Added log output
	* nns_server.man: to trace searches. Bumped package version to 0.3.2.

	* nns_auto.tcl: Refactored the bind and restore code, put the
	* nns_auto.man: commonalities into shared commands. Extended the
	* pkgIndex.tcl: API to become a full drop-in replacement for
	  'nameserv', just with the persistence feature. Extended the
	  persistence to continuous and unfulfilled async searches. Now
	  exporting the API commands. Bumped package version to 0.3.

	* nns.tcl: Factored the argument processing for searches into a
	* pkgIndex.tcl: separate command. Pseudo-public. Undocumented, but
	* nns_client.man: can be used by other nameserver packages. Fixed
	  leak when encountering a missing name server during creation of
	  a continuous or async search. Fixed async destruction of a
	  continous search from receiver object. Now exporting the API
	  commands. Bumped package version to 0.4.
@
text
@#! /bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@@"}

# @@@@ Meta Begin
# Application nnslog 1.1
# Meta platform     tcl
# Meta summary      Nano Name Service Logger
# Meta description  This application connects to a name service demon
# Meta description  and then continuously logs all changes (new/removed
# Meta description  definitions) to the standard output. It will survive
# Meta description  the loss of the nameserver and automatically reconnect
# Meta description  and continue when it comes back.
# Meta subject      {name service} client log
# Meta require      {Tcl 8.4}
# Meta require      logger
# Meta require      nameserv::auto
# Meta author       Andreas Kupries
# Meta license      BSD
# @@@@ Meta End

package provide nnslog 1.0

# nns - Nano Name Service Logger
# === = ========================
#
# Use cases
# ---------
# 
# (1)	Continuously monitor a nameservice for changes.
#
# Command syntax
# --------------
#
# (Ad 1) nnslog ?-host NAME|IP? ?-port PORT? ?-color BOOL?
#
#       Monitor a name server. If no port is specified the default
# 	port 38573 is used to connect to it. If no host is specified
# 	the default (localhost) is used to connect to it.

# ### ### ### ######### ######### #########
## Requirements

lappend auto_path [file join [file dirname [file dirname \
			[file normalize [info script]]]] modules]

package require nameserv::auto 0.3 ;# Need auto-restoring search.

logger::initNamespace ::nnslog
namespace eval        ::nnslog { log::setlevel info }

# ### ### ### ######### ######### #########
## Process application command line

proc ::nnslog::ProcessCommandLine {} {
    global argv

    # Process the options, perform basic validation.
    set xcolor 0

    if {[llength $argv] < 1} return

    while {[llength $argv]} {
	set opt [lindex $argv 0]
	if {![string match "-*" $opt]} break

	switch -exact -- $opt {
	    -host {
		if {[llength $argv] < 2} Usage

		set host [lindex $argv 1]
		set argv [lrange $argv 2 end]

		nameserv::configure -host $host
	    }
	    -port {
		if {[llength $argv] < 2} Usage

		# Todo: Check non-zero unsigned short integer
		set port [lindex $argv 1]
		set argv [lrange $argv 2 end]

		nameserv::configure -port $port
	    }
	    -debug {
		# Undocumented. Activate the logger services provided
		# by various packages.
		logger::setlevel debug
		set argv [lrange $argv 1 end]
	    }
	    default Usage
	}
    }

    # Additional validation. no arguments should be left over.
    if {[llength $argv] > 1} Usage
    return
}

proc ::nnslog::Usage {{sfx {}}} {
    global argv0 ; append argv0 $sfx
    puts stderr "$argv0 wrong#args, expected: ?-host NAME|IP? ?-port PORT?"
    exit 1
}

proc ::nnslog::ArgError {text} {
    global argv0
    puts stderr "$argv0: $text"
    #puts $::errorInfo
    exit 1
}

# ### ### ### ######### ######### #########
## Setup a text|graphical report

proc ::nnslog::My {} {
    # Quick access to format the identity of the name service the
    # client talks to.
    return "[nameserv::auto::cget -host] @@[nameserv::auto::cget -port]"
}

proc ::nnslog::Connection {message args} {
    # args = tag event details, ignored
    log::info $message
    return
}

proc ::nnslog::MonitorConnection {} {
    uevent::bind nameserv lost-connection [list ::nnslog::Connection "Disconnected name service at [My]"]
    uevent::bind nameserv re-connection   [list ::nnslog::Connection "Reconnected2 name service at [My]"]
    return
}

# ### ### ### ######### ######### #########
## Main

proc ::nnslog::Do.search {} {
    MonitorConnection
    set contents [nameserv::auto::search -continuous *]
    $contents configure -command [list ::nnslog::Do.search.change $contents]

    log::info "Logging      name service at [My]"
    vwait ::forever
    # Not reached.
    return
}

namespace eval ::nnslog {
    variable  map
    array set map {
	add    +++
	remove ---
    }
}

proc ::nnslog::Do.search.change {res type response} {
    variable map

    if {$type eq "stop"} {
	# Cannot happen for nameserv::auto client, we are free to panic.
	$res destroy
	log::critical {Bad event 'stop' <=> Lost connection, search closed}
	return
    }
    # Print events ...
    foreach {name value} $response {
	log::info "$map($type) : [list $name = $value]"
    }
    return
}

# ### ### ### ######### ######### #########
## Invoking the functionality.

::nnslog::ProcessCommandLine
if {[catch {
    ::nnslog::Do.search
} msg]} {
    ::nnslog::ArgError $msg
}

# ### ### ### ######### ######### #########
exit
@


1.1
log
@
	* ../../apps/nns (::nns::ProcessCommandLine): Fixed inccorrect
	* ../../apps/nns.man: checking for wrong#args in the code handling
	* ../../apps/nnsd.man: the options -host and -port. Reworked
	  the descriptiond of the applications a bit.

	* ../../apps/nnslog: New application and its documentation, a
	* ../../apps/nnslog.man: stripped down form of 'nns search
	  -continuous *' with different output (log of events).
@
text
@d6 1
a6 1
# Application nnslog 1.0
d11 3
a13 1
# Meta description  definitions) to the standard output.
a15 1
# Meta require      comm
d17 1
a17 5
# Meta require      nameserv
# Meta require      nameserv::common
# Meta require      term::ansi::code::attr
# Meta require      term::ansi::code::ctrl
# Meta require      snit
d41 3
d47 1
a47 1
package require nameserv
d49 2
a50 2
package require term::ansi::code::attr
package require term::ansi::code::ctrl
d52 2
a53 14
::term::ansi::code::ctrl::import ::nnslog sda_bg* sda_reset

namespace eval ::nnslog {
    variable  map
    array set map {
	add    +++
	remove ---
    }
    variable  cmap
    array set cmap {
	add    sda_bgcyan
	remove sda_bgmagenta
    }
}
d56 1
a56 1
    global argv xcolor
a84 9
	    -color {
		if {[llength $argv] < 2} Usage

		set flag [lindex $argv 1]
		set argv [lrange $argv 2 end]

		if {![string is boolean -strict $flag]} Usage
		set xcolor $flag
	    }
d116 4
a119 3
proc ::nnslog::Exit {args} {
    puts {Exiting client due to loss of connection with service}
    exit 0
d122 5
a126 1
# ### ### ### ######### ######### #########
d128 4
a131 5
proc ::nnslog::Color {type text} {
    variable cmap
    global xcolor
    if {!$xcolor} { return $text }
    return [$cmap($type)]$text[sda_reset]
d138 2
a139 1
    set contents [nameserv::search -continuous *]
d142 1
a142 1
    uevent::bind nameserv lost-connection ::nnslog::Exit
d148 8
a157 2
    # Ignoring the arguments, we simply print the full results every
    # time.
d160 1
d162 1
a162 1
	puts {Lost connection, search closed}
a165 1
    set now [clock format [clock seconds]]
d167 1
a167 1
	puts  stdout [Color $type "\[$now\] $map($type)\t$name = $value"]
a168 1
    flush stdout
@

