/usr/share/tcltk/tcllib1.17/ident/ident.tcl is in tcllib 1.17-dfsg-1.
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 | # ident.tcl --
#
# Implemetation of the client side of the ident protocol.
# See RFC 1413 for details on the protocol.
#
# Copyright (c) 2004 Reinhard Max <max@tclers.tk>
#
# -------------------------------------------------------------------------
# This software is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the file 'license.terms' for
# more details.
# -------------------------------------------------------------------------
# RCS: @(#) $Id: ident.tcl,v 1.2 2004/07/12 14:01:04 patthoyts Exp $
package provide ident 0.42
namespace eval ident {
namespace export query configure
}
proc ident::parse {string} {
# remove all white space for easier parsing
regsub -all {\s} $string "" s
if {[regexp {^\d+,\d+:(\w+):(.*)} $s -> resptype addinfo]} {
switch -exact -- $resptype {
USERID {
if { [regexp {^([^,]+)(,([^:]+))?:} \
$addinfo -> opsys . charset]
} then {
# get the user-if from the original string, because it
# is allowed to contain white space.
set index [string last : $string]
incr index
set userid [string range $string $index end]
if {$charset != ""} {
set (user-id) \
[encoding convertfrom $charset $userid]
}
set answer [list resp-type USERID opsys $opsys \
user-id $userid]
}
}
ERROR {
set answer [list resp-type ERROR error $addinfo]
}
}
}
if {![info exists answer]} {
set answer [list resp-type FATAL \
error "Unexpected response:\"$string\""]
}
return $answer
}
proc ident::Callback {sock command} {
gets $sock answer
close $sock
lappend command [parse $answer]
eval $command
}
proc ident::query {socket {command {}}} {
foreach {sock_ip sock_host sock_port} [fconfigure $socket -sockname] break
foreach {peer_ip peer_host peer_port} [fconfigure $socket -peername] break
set blocking [string equal $command ""]
set failed [catch {socket $peer_ip ident} sock]
if {$failed} {
set result [list resp-type FATAL error $sock]
if {$blocking} {
return $result
} else {
after idle [list $command $result]
return
}
}
fconfigure $sock -encoding binary -buffering line -blocking $blocking
puts $sock "$peer_port,$sock_port"
if {$blocking} {
gets $sock answer
close $sock
return [parse $answer]
} else {
fileevent $sock readable \
[namespace code [list Callback $sock $command]]
}
}
|