nns_auto.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  ### ### ### ######### ######### #########*/
/*  Name Service - Client side connection monitor*/

/*  ### ### ### ######### ######### #########*/
/*  Requirements*/

package require nameserv ; /*  Name service client-side core*/
package require uevent   ; /*  Watch for connection-loss*/

namespace ::nameserv::auto {}

/*  ### ### ### ######### ######### #########*/
/*  API: Write, Read, Search*/

/*  TODO - Keep after handle, ensure that only one poll is running.*/
/*  Factor into smaller commands with descriptive names ... We have*/
/*  several near-replicated pieces of code (error handling).*/

ret  ::nameserv::auto::bind (type name , type data) {
    # See nameserv::bind. Remembers the information, for re-binding
    # when the connection was lost, and later restored.

    variable bindings
    variable delay

    # Watch base client for loss of connection.
    uevent::bind nameserv lost-connection ::nameserv::auto::Reconnect

    if {[catch {
    nameserv::bind $name $data
    } msg]} {
    if {[string match *No name server*]} {
        # No nameserver. Remember, and start reconnect polling.
        set bindings($name) $data
        after $delay ::nameserv::auto::Reconnect
        return
    }
    # Name is bound already, lost immediately, generate
    # standard event.

    uevent::generate nameserv lost-name [list name $name data $data]
    return
    }

    # Success. Remember for possible loss of connection.
    set bindings($name) $data
    return
}

ret  ::nameserv::auto::Reconnect (type args) {
    # args = <>|<tags event details>
    # <tag,event> = <'nameserv','lost'>
    #     details = dict ('reason' -> string)

    if {![catch {
    ::nameserv::server_features
    }]} {Rebind ; return}

    variable delay
    after   $delay ::nameserv::auto::Reconnect
    return
}

ret  ::nameserv::auto::Rebind () {
    variable bindings

    foreach {name data} [array get bindings] {
    if {[catch {
        nameserv::bind $name $data
    } msg]} {
        # Lost server while rebinding names. Abort and wait for
        # the reconnect to try again.
        if {[string match *No name server*]} break

        # Other error => (name already bound) That means someone
        # else took the name while we were not connected to the
        # service. Best effort we can do: Deliver total loss of
        # this binding to observers via event.

        uevent::generate nameserv lost-name [list name $name data $data]
    }
    }
    return
}

/*  ### ### ### ######### ######### #########*/
/*  Initialization - System state*/

namespace ::nameserv::auto {
    /*  In-memory database of bindings to restore after connection was*/
    /*  lost and restored.*/

    variable bindings ; array  bindings =  {}
}

/*  ### ### ### ######### ######### #########*/
/*  API: Configuration management (host, port)*/

ret  ::nameserv::auto::cget (type option) {
    return [configure $option]
}

ret  ::nameserv::auto::configure (type args) {
    variable delay

    if {![llength $args]} {
    return [list -delay $delay]
    }
    if {[llength $args] == 1} {
    # cget
    set opt [lindex $args 0]
    switch -exact -- $opt {
        -delay { return $delay }
        default {
        return -code error "bad option \"$opt\", expected -delay"
        }
    }
    }

    while {[llength $args]} {
    set opt [lindex $args 0]
    switch -exact -- $opt {
        -delay {
        if {[llength $args] % 2 == 1} {
            return -code error "value for \"$opt\" is missing"
        }
        # TODO: check integer > 0
        set delay [lindex $args 1]
        set args  [lrange $args 2 end]
        }
        default {
        return -code error "bad option \"$opt\", expected -delay"
        }
    }
    }
    return
}

/*  ### ### ### ######### ######### #########*/
/*  Initialization - Tracing, Configuration*/

logger::initNamespace ::nameserv::auto
namespace        ::nameserv::auto {
    /*  Interval between reconnection attempts when connection was lost.*/

    variable delay 1000 ; /*  One second*/
}

/*  ### ### ### ######### ######### #########*/
/*  Ready*/

package provide nameserv::auto 0.1

/** 
 * ### ### ### ######### ######### #########