[cl-irc-cvs] r203 - trunk

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sun Apr 29 14:08:22 2007
New Revision: 203

Modified:
   trunk/command.lisp
   trunk/utility.lisp
   trunk/variable.lisp
Log:
Add SSL support for IRC connections, only if CL+SSL is available when calling
connect.

Modified: trunk/command.lisp
==============================================================================
--- trunk/command.lisp	(original)
+++ trunk/command.lisp	Sun Apr 29 14:08:22 2007
@@ -247,13 +247,29 @@
                      (password nil)
                      (mode 0)
                      (server *default-irc-server*)
-                     (port *default-irc-server-port*)
+                     (port :default)
                      (connection-type 'connection)
+                     (connection-security :none)
                      (logging-stream t))
-  "Connect to server and return a connection object."
-  (let* ((socket (usocket:socket-connect server port
+  "Connect to server and return a connection object.
+
+`port' and `connection-security' have a relation: when `port' equals
+`:default' `*default-irc-server-port*' is used to find which port to
+connect to.  `connection-security' determines which port number is found.
+
+`connection-security' can be either `:none' or `:ssl'.  When passing
+`:ssl', the cl+ssl library must have been loaded by the caller.
+"
+  (let* ((port (if (eq port :default)
+                   ;; get the default port for this type of connection
+                   (getf *default-irc-server-port* connection-security)
+                 port))
+         (socket (usocket:socket-connect server port
                                          :element-type 'flexi-streams:octet))
-         (stream (usocket:socket-stream socket))
+         (stream (if (eq connection-security :ssl)
+                     (dynfound-funcall (make-ssl-client-stream :cl+ssl)
+                                       (usocket:socket-stream socket))
+                   (usocket:socket-stream socket)))
          (connection (make-connection :connection-type connection-type
                                       :socket socket
                                       :network-stream stream

Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp	(original)
+++ trunk/utility.lisp	Sun Apr 29 14:08:22 2007
@@ -181,6 +181,30 @@
                 buf-len))
       (try-decode-line buf *default-incoming-external-formats*))))
 
+(defmacro dynfound-funcall ((symbol-name &optional package) &rest parameters)
+  (let ((package-sym (gensym))
+        (symbol-sym (gensym))
+        (fun-sym (gensym)))
+    `(let* ((,package-sym ,(if package package *package*))
+            (,symbol-sym ,(if (symbolp symbol-name)
+                              `',symbol-name
+                            symbol-name))
+            (,symbol-sym (find-symbol
+                          ,(if (symbolp symbol-name)
+                               `(symbol-name ,symbol-sym)
+                             `(if (symbolp ,symbol-sym)
+                                  (symbol-name ,symbol-sym)
+                                ,symbol-sym))
+                          ,package-sym))
+            (,fun-sym (when (and ,symbol-sym (fboundp ,symbol-sym))
+                        (symbol-function ,symbol-sym))))
+       (unless ,symbol-sym
+         (error "Can't resolve symbol ~A in package ~A"
+                ,symbol-sym ,package-sym))
+       (if ,fun-sym
+           (funcall ,fun-sym , at parameters)
+         (error "Symbol ~A in package ~A isn't fbound"
+                ,symbol-sym ,package-sym)))))
 
 (defun substring (string start &optional end)
   (let* ((end-index (if end end (length string)))

Modified: trunk/variable.lisp
==============================================================================
--- trunk/variable.lisp	(original)
+++ trunk/variable.lisp	Sun Apr 29 14:08:22 2007
@@ -22,7 +22,9 @@
 
 (defvar *default-nickname* "cl-irc")
 (defvar *default-irc-server* "irc.freenode.net")
-(defvar *default-irc-server-port* 6667)
+(defvar *default-irc-server-port* '(:none 6667  ;; most used for normal IRC
+                                    :ssl  6679  ;; most used for SSL IRC
+                                    ))
 (defvar *default-quit-message*
   "Common Lisp IRC library - http://common-lisp.net/project/cl-irc")