summaryrefslogtreecommitdiffstats
path: root/tcllib/modules/ident
diff options
context:
space:
mode:
Diffstat (limited to 'tcllib/modules/ident')
-rw-r--r--tcllib/modules/ident/ChangeLog101
-rw-r--r--tcllib/modules/ident/ident.man54
-rw-r--r--tcllib/modules/ident/ident.pcx27
-rw-r--r--tcllib/modules/ident/ident.tcl90
-rw-r--r--tcllib/modules/ident/ident.test54
-rw-r--r--tcllib/modules/ident/pkgIndex.tcl13
6 files changed, 339 insertions, 0 deletions
diff --git a/tcllib/modules/ident/ChangeLog b/tcllib/modules/ident/ChangeLog
new file mode 100644
index 0000000..4382fd1
--- /dev/null
+++ b/tcllib/modules/ident/ChangeLog
@@ -0,0 +1,101 @@
+2013-03-11 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * rfc1413.txt: Removed copies of RFC documents. Keep only links.
+
+2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.15 ========================
+ *
+
+2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.14 ========================
+ *
+
+2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.13 ========================
+ *
+
+2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.12 ========================
+ *
+
+2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.11.1 ========================
+ *
+
+2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.11 ========================
+ *
+
+2008-06-14 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * ident.pcx: New file. Syntax definitions for the public commands
+ of the ident package.
+
+2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.10 ========================
+ *
+
+2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * ident.man: Fixed all warnings due to use of now deprecated
+ commands. Added a section about how to give feedback.
+
+2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.9 ========================
+ *
+
+2006-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * ident.test: More boilerplate simplified via use of test support.
+
+2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * ident.test: Hooked into the new common test support code.
+
+2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.8 ========================
+ *
+
+2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.7 ========================
+ *
+
+2004-07-19 Andreas Kupries <andreask@activestate.com>
+
+ * ident.man: Polishing the docs (added link to RFC, a 'title', and
+ keywords).
+
+2004-07-10 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * pkgIndex.tcl: Specify Tcl >= 8.2
+ * ident.test: Added cleanupTests so it reports the test stats.
+ * ident.tcl: Changed the package name to 'ident' to correspond
+ with the namespace name. Added license declaration.
+
+2004-07-09 Reinhard Max <max@suse.de>
+
+ * ident.tcl: Ident client implementation, test suite,
+ * ident.test: and documentation
+ * ident.man:
+
+ * rfc1413.txt: RFC describing the Identification Protocol
diff --git a/tcllib/modules/ident/ident.man b/tcllib/modules/ident/ident.man
new file mode 100644
index 0000000..a5d418a
--- /dev/null
+++ b/tcllib/modules/ident/ident.man
@@ -0,0 +1,54 @@
+[comment {-*- Tcl -*- doctools manpage}]
+[manpage_begin ident n 0.42]
+[keywords ident]
+[keywords identification]
+[keywords {rfc 1413}]
+[copyright {2004 Reinhard Max <max@tclers.tk>}]
+[titledesc {Ident protocol client}]
+[moddesc {Identification protocol client}]
+[category Networking]
+[require Tcl 8.3]
+[require ident [opt 0.42]]
+[description]
+
+The [package ident] package provides a client implementation of the ident
+protocol as defined in
+
+RFC 1413 ([uri http://www.rfc-editor.org/rfc/rfc1413.txt]).
+
+[list_begin definitions]
+[call [cmd ::ident::query] [arg socket] [opt [arg callback]]]
+
+This command queries the ident daemon on the remote side of the given
+socket, and returns the result of the query as a dictionary.
+
+Interpreting the dictionary as list the first key will always be
+[const resp-type], and can have one of the values [const USERID],
+[const ERROR], and [const FATAL]. These [term {response types}] have
+the following meanings:
+
+[list_begin definitions]
+[def USERID]
+
+This indicates a successful response. Two more keys and associated
+values are returned, [const opsys], and [const user-id].
+
+[def ERROR]
+
+This means the ident server has returned an error. A second key named
+[const error] is present whose value contains the [const error-type]
+field from the server response.
+
+[def FATAL]
+
+Fatal errors happen when no ident server is listening on the remote
+side, or when the ident server gives a response that does not conform
+to the RFC. A detailed error message is returned under the
+[const error] key.
+
+[list_end]
+[list_end]
+
+[vset CATEGORY ident]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/ident/ident.pcx b/tcllib/modules/ident/ident.pcx
new file mode 100644
index 0000000..e64415c
--- /dev/null
+++ b/tcllib/modules/ident/ident.pcx
@@ -0,0 +1,27 @@
+# -*- tcl -*- ident.pcx
+# Syntax of the commands provided by package ident.
+#
+# For use by TclDevKit's static syntax checker (v4.1+).
+# See http://www.activestate.com/solutions/tcl/
+# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api
+# for the specification of the format of the code in this file.
+#
+
+package require pcx
+pcx::register ident
+pcx::tcldep 0.42 needs tcl 8.2
+
+namespace eval ::ident {}
+
+#pcx::message FOO {... text ...} type
+#pcx::scan <VERSION> <NAME> <RULE>
+
+pcx::check 0.42 std ::ident::query \
+ {checkSimpleArgs 2 2 {
+ checkChannelID
+ {checkProcCall 1}
+ }}
+
+# Initialization via pcx::init.
+# Use a ::ident::init procedure for non-standard initialization.
+pcx::complete
diff --git a/tcllib/modules/ident/ident.tcl b/tcllib/modules/ident/ident.tcl
new file mode 100644
index 0000000..72e0c7c
--- /dev/null
+++ b/tcllib/modules/ident/ident.tcl
@@ -0,0 +1,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]]
+ }
+}
diff --git a/tcllib/modules/ident/ident.test b/tcllib/modules/ident/ident.test
new file mode 100644
index 0000000..e6dc03d
--- /dev/null
+++ b/tcllib/modules/ident/ident.test
@@ -0,0 +1,54 @@
+# ident.test -- -*- tcl -*-
+#
+# Tests for the ident package
+#
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.2
+testsNeedTcltest 1.0
+
+testing {
+ useLocal ident.tcl ident
+}
+
+# -------------------------------------------------------------------------
+# Tests
+# -------------------------------------------------------------------------
+
+# good responses
+test {ident-1.0} {normal response} {
+ ident::parse "8888 , 9999 : USERID : UNIX :max"
+} {resp-type USERID opsys UNIX user-id max}
+
+test {ident-1.1} {response with charset} {
+ ident::parse "8888 , 9999 : USERID : UNIX , utf-8 :max"
+} {resp-type USERID opsys UNIX user-id max}
+
+test {ident-1.2} {response with spaces in the user-id} {
+ ident::parse "8888 , 9999 : USERID : UNIX , utf-8 : foo bar "
+} {resp-type USERID opsys UNIX user-id { foo bar }}
+
+# errors from the server
+test {ident-2.0} {error response} {
+ ident::parse "2222,3333 : ERROR : NO-USER"
+} {resp-type ERROR error NO-USER}
+
+# fatal errors
+test {ident-3.0} {empty response} {
+ ident::parse ""
+} {resp-type FATAL error {Unexpected response:""}}
+
+test {ident-3.1} {nonsense} {
+ ident::parse "sadf liubsv"
+} {resp-type FATAL error {Unexpected response:"sadf liubsv"}}
+
+# -------------------------------------------------------------------------
+
+testsuiteCleanup
+
+# -------------------------------------------------------------------------
diff --git a/tcllib/modules/ident/pkgIndex.tcl b/tcllib/modules/ident/pkgIndex.tcl
new file mode 100644
index 0000000..1ffdeb0
--- /dev/null
+++ b/tcllib/modules/ident/pkgIndex.tcl
@@ -0,0 +1,13 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+package ifneeded ident 0.42 [list source [file join $dir ident.tcl]]
+
generated by cgit v0.12 at 2025-08-30 14:18:32 (GMT)