connect.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  ### ### ### ######### ######### #########*/
/** 
 */

/*  Class for handling of active/passive connectivity.*/

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

package require snit

/*  ### ### ### ######### ######### #########*/
/*  Implementation*/

snit::type ::transfer::connect {

    /*  ### ### ### ######### ######### #########*/
    /*  API*/

    option -host localhost
    option -port 0
    option -mode active

    option -translation {}
    option -encoding    {}
    option -eofchar     {}

    ret  connect (type command) {}

    /*  active:*/
    /*  - connect to host/port*/
    /* */
    /*  passive:*/
    /*  - listen on port for connection*/

    /*  ### ### ### ######### ######### #########*/
    /*  Implementation*/

    ret  connect (type command) {
    if {$options(-mode) eq "active"} {

        set sock [socket $options(-host) $options(-port)]
        $self Setup $sock

        lappend command $self $sock
        uplevel \#0 $command
        return
    } else {
        set server [socket -server [mymethod Start $command] \
                $options(-port)]

        return [lindex [fconfigure $server -sockname] 2]
    }
    return
    }

    ret  Start (type command , type sock , type peerhost , type peerport) {
    close $server
    $self Setup $sock

    lappend command $self $sock
    uplevel \#0 $command
    return
    }

    ret  Setup (type sock) {
    foreach o {-translation -encoding -eofchar} {
        if {$options($o) eq ""} continue
        fconfigure $sock $o $options($o)
    }
    return
    }

    /*  ### ### ### ######### ######### #########*/
    /*  Internal helper commands.*/

    onconfigure -mode {newvalue} {
    upvar 0 options(-mode) value
    if {$value eq $newvalue} return
    switch -exact -- $newvalue {
        passive - active {
         value =  $newvalue
        }
        default {
        return -code error "Bad value \"$newvalue\", expected active, or passive"
        }
    }
    return
    }

    /*  ### ### ### ######### ######### #########*/
    /*  Data structures*/

    variable server {}

    /** 
     * ### ### ### ######### ######### #########
 */
}

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

package provide transfer::connect 0.1