/usr/share/tcltk/tcllib1.19/transfer/connect.tcl is in tcllib 1.19-dfsg-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | # -*- tcl -*-
# ### ### ### ######### ######### #########
##
# Class for handling of active/passive connectivity.
# ### ### ### ######### ######### #########
## Requirements
package require snit
# ### ### ### ######### ######### #########
## Implementation
snit::type ::transfer::connect {
# ### ### ### ######### ######### #########
## API
option -host -default localhost
option -port -default 0
option -mode -default active -type {snit::enum -values {active passive}}
option -socketcmd -default ::socket
option -translation -default {}
option -encoding -default {}
option -eofchar -default {}
method connect {command} {}
# active:
# - connect to host/port
#
# passive:
# - listen on port for connection
# ### ### ### ######### ######### #########
## Implementation
method connect {command} {
if {$options(-mode) eq "active"} {
set sock [Socket $options(-host) $options(-port)]
$self ConfigureTheOpenedSocket $sock $command
return
} else {
set mysock [Socket -server [mymethod IsConnected $command] \
$options(-port)]
# Return port the server socket is listening on for the
# connection.
return [lindex [fconfigure $mysock -sockname] 2]
}
return
}
# ### ### ### ######### ######### #########
## Internal helper commands.
method IsConnected {command sock peerhost peerport} {
# Accept only a one connection.
close $mysock
$self ConfigureTheOpenedSocket $sock $command
return
}
method ConfigureTheOpenedSocket {sock command} {
foreach o {-translation -encoding -eofchar} {
if {$options($o) eq ""} continue
fconfigure $sock $o $options($o)
}
after 0 [linsert $command end $self $sock]
return
}
# ### ### ### ######### ######### #########
## Internal helper commands.
proc Socket {args} {
upvar 1 options(-socketcmd) socketcmd
return [eval [linsert $args 0 $socketcmd]]
}
# ### ### ### ######### ######### #########
## Data structures
variable mysock {}
##
# ### ### ### ######### ######### #########
}
# ### ### ### ######### ######### #########
## Ready
package provide transfer::connect 0.2
|