Tk Library Source Code

Artifact 4f774d8dc93006793ae7d52dd3e5d0c89a080351:

Attachment "0001-Recognize-ircs-in-irc-URL-to-tell-us-that-a-secure-c.patch" to ticket [3427858fff] added by karll 2011-10-24 22:05:45. Also attachment "0001-Recognize-ircs-in-irc-URL-to-tell-us-that-a-secure-c.patch" to ticket [3304371fff] added by karll 2011-05-19 10:39:52.

---

From c78a9cf451c6117e0ed57a2555f664ebd625683c Mon Sep 17 00:00:00 2001
From: Karl Lehenbauer <[email protected]>
Date: Wed, 11 May 2011 11:41:29 -0500
Subject: [PATCH] Recognize ircs:// in irc URL to tell us that a secure connection is
 requested.

If a secure connection is requested and no port is specified, use port 994
instead of 6667.

Add ::picoirc::tls_status to get the TLS connection status.

Add ::picoirc::tls_status to get the TLS connection status.

Update docs.
---
 picoirc.man |   10 ++++++++--
 picoirc.tcl |   40 +++++++++++++++++++++++++++++++++-------
 2 files changed, 41 insertions(+), 9 deletions(-)

diff --git a/picoirc.man b/picoirc.man
index 06094b8..c0ae313 100644
--- a/picoirc.man
+++ b/picoirc.man
@@ -48,8 +48,9 @@ sequences and then sent.
 [call [cmd ::picoirc::splituri] [arg uri]]
 
 Splits an IRC scheme uniform resource indicator into its component
-parts. Returns a list of server, port and channel. The default port is
-6667 and there is no default channel.
+parts. Returns a list of server, port, channel, and secure, where secure
+is 1 if a secured session (ircs:) was requested. The default port is
+6667 (994 if secured) and there is no default channel.
 
 [call [cmd ::picoirc::send] [arg context] [arg line]]
 
@@ -61,6 +62,11 @@ desired to return a break error code to halt further processing. In
 this way the application can override the default send via the
 callback procedure.
 
+[call [cmd ::picoirc::tls_status] [arg context]]
+
+Return the TLS connection status as list of key-value pairs, returning
+an empty list for non-secure connections.
+
 [list_end]
 
 [section CALLBACK]
diff --git a/picoirc.tcl b/picoirc.tcl
index e0f33b5..3f8f44b 100644
--- a/picoirc.tcl
+++ b/picoirc.tcl
@@ -31,12 +31,23 @@ namespace eval ::picoirc {
 }
 
 proc ::picoirc::splituri {uri} {
-    foreach {server port channel} {{} {} {}} break
-    if {![regexp {^irc://([^:/]+)(?::([^/]+))?(?:/([^,]+))?} $uri -> server port channel]} {
-        regexp {^(?:([^@]+)@)?([^:]+)(?::(\d+))?} $uri -> channel server port
+    foreach {server port channel secure} {{} {} {} 0} break
+    set baseExp {//([^:/]+)(?::([^/]+))?(?:/([^,]+))?}
+    if {![regexp "^irc:$baseExp" $uri -> server port channel]} {
+	if {[regexp "^ircs:$baseExp" $uri -> server port channel]} {
+	    set secure 1
+	} else {
+	    regexp {^(?:([^@]+)@)?([^:]+)(?::(\d+))?} $uri -> channel server port
+	}
     }
-    if {$port eq {}} { set port 6667 }
-    return [list $server $port $channel]
+    if {$port eq {}} { 
+        if {$secure} {
+	    set port 994
+	} else {
+	    set port 6667
+	}
+    }
+    return [list $server $port $channel $secure]
 }
 
 proc ::picoirc::connect {callback nick args} {
@@ -52,20 +63,35 @@ proc ::picoirc::connect {callback nick args} {
     set context [namespace current]::irc[incr uid]
     upvar #0 $context irc
     array set irc $defaults
-    foreach {server port channel} [splituri $url] break
+    foreach {server port channel secure} [splituri $url] break
     if {[info exists channel] && $channel ne ""} {set irc(channel) $channel}
     if {[info exists server] && $server ne ""} {set irc(server) $server}
     if {[info exists port] && $port ne ""} {set irc(port) $port}
     if {[info exists passwd] && $passwd ne ""} {set irc(passwd) $passwd}
+    if {[info exists secure] && $secure ne ""} {set irc(secure) $secure}
     set irc(callback) $callback
     set irc(nick) $nick
     Callback $context init
-    set irc(socket) [socket -async $irc(server) $irc(port)]
+    if {$irc(secure)} {
+        package require tls
+	set irc(socket) [::tls::socket -async $irc(server) $irc(port)]
+    } else {
+	set irc(socket) [socket -async $irc(server) $irc(port)]
+    }
     fileevent $irc(socket) readable [list [namespace origin Read] $context]
     fileevent $irc(socket) writable [list [namespace origin Write] $context]
     return $context
 }
 
+proc ::picoirc::tls_status {context} {
+    upvar #0 $context irc
+    if {!$irc(secure)} {
+        return [list]
+    }
+
+    return [::tls::status $irc(socket)]
+}
+
 proc ::picoirc::Callback {context state args} {
     upvar #0 $context irc
     if {[llength $irc(callback)] > 0
-- 
1.7.4.1