emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] rcirc: support TLS/SSL and arbitrary connection method


From: Marco Pessotto
Subject: [PATCH] rcirc: support TLS/SSL and arbitrary connection method
Date: Mon, 30 May 2011 23:46:30 +0200
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux)

Hello there.

I'm writing you to submit a patch for rcirc.el to give it support for
SSL connections. 

For example, the following 2 servers will connect with SSL, one using a
custom function (which can be anything, and re-implements this idea
https://github.com/nealey/rcirc/wiki ), one simply adding :use-tls t.

(setq rcirc-server-alist '(("irc.freenode.net" 
                            :nick "nick"
                            :user-name "username"
                            :port 6697
                            ;; use open-tls-stream as function to connect
                            :custom-connect-function open-tls-stream 
                            :channels ("#rcirc" "#emacs"))
                           ("irc.otherserver.org" 
                            :nick "nick"
                            :username "username"
                            ;; just say use-tls, more intuitive
                            ;; also prompted when C-u M-x rcirc
                            :use-tls t
                            :port 7000
                            :channels ("#channel1" "#channel 2"))))


The last 2 chunks of the patch are meant to strip the IRC colors. Not
really part of the "connection" patch, but IMHO useful.

In case you're interested, I signed the emacs papers some years ago.

Bests

        Marco

diff --git a/rcirc.el b/rcirc.el
index 093892a..a0bcaf1 100644
--- a/rcirc.el
+++ b/rcirc.el
@@ -46,6 +46,7 @@
 (require 'ring)
 (require 'time-date)
 (eval-when-compile (require 'cl))
+(require 'tls)
 
 (defgroup rcirc nil
   "Simple IRC client."
@@ -76,6 +77,19 @@ for this connection.
 VALUE must be a number or string.  If absent,
 `rcirc-default-port' is used.
 
+`:use-tls'
+
+VALUE is a boolean. If true, the connection will be established
+using the tls.el library. If absent, `rcirc-default-use-tls' is
+used, which in turn default to nil (false).
+
+`:custom-connect-function'
+
+VALUE is a custom function to open the connection and must take
+the same arguments of `open-network-stream' If you set this,
+the :use-tls parameter is ignored (as you are supposed to set the
+connection by yourself)
+
 `:user-name'
 
 VALUE must be a string.  If absent, `rcirc-default-user-name' is
@@ -102,6 +116,8 @@ connected to automatically."
                                             (:user-name string)
                                             (:password string)
                                             (:full-name string)
+                                            (:use-tls boolean)
+                                            (:custom-connect-function function)
                                             (:channels (repeat string)))))
   :group 'rcirc)
 
@@ -110,6 +126,11 @@ connected to automatically."
   :type 'integer
   :group 'rcirc)
 
+(defcustom rcirc-default-use-tls nil
+  "Use SSL/TLS by default?"
+  :type 'boolean
+  :group 'rcirc)
+
 (defcustom rcirc-default-nick (user-login-name)
   "Your nick."
   :type 'string
@@ -409,6 +430,7 @@ If ARG is non-nil, instead prompt for connection 
parameters."
                                      'rcirc-user-name-history))
             (password (read-passwd "IRC Password: " nil
                                     (plist-get server-plist :password)))
+            (use-tls (yes-or-no-p "Use SSL/TLS? "))
             (channels (split-string
                        (read-string "IRC Channels: "
                                     (mapconcat 'identity
@@ -418,7 +440,7 @@ If ARG is non-nil, instead prompt for connection 
parameters."
                        "[, ]+" t)))
        (rcirc-connect server port nick user-name
                       rcirc-default-full-name
-                      channels password))
+                      channels password use-tls))
     ;; connect to servers in `rcirc-server-alist'
     (let (connected-servers)
       (dolist (c rcirc-server-alist)
@@ -430,6 +452,9 @@ If ARG is non-nil, instead prompt for connection 
parameters."
              (full-name (or (plist-get (cdr c) :full-name)
                             rcirc-default-full-name))
              (channels (plist-get (cdr c) :channels))
+             (use-tls (or (plist-get (cdr c) :use-tls)
+                      rcirc-default-use-tls))
+             (custom-connect-function (plist-get (cdr c) 
:custom-connect-function))
               (password (plist-get (cdr c) :password)))
          (when server
            (let (connected)
@@ -439,13 +464,15 @@ If ARG is non-nil, instead prompt for connection 
parameters."
              (if (not connected)
                  (condition-case e
                      (rcirc-connect server port nick user-name
-                                    full-name channels password)
+                                    full-name channels password use-tls
+                                    custom-connect-function)
                    (quit (message "Quit connecting to %s" server)))
                (with-current-buffer (process-buffer connected)
+                 (if (process-contact (get-buffer-process
+                                       (current-buffer)) :host)
                  (setq connected-servers
-                       (cons (process-contact (get-buffer-process
-                                               (current-buffer)) :host)
-                             connected-servers))))))))
+                       (cons (process-name connected)
+                             connected-servers)))))))))
       (when connected-servers
        (message "Already connected to %s"
                 (if (cdr connected-servers)
@@ -471,7 +498,8 @@ If ARG is non-nil, instead prompt for connection 
parameters."
 
 ;;;###autoload
 (defun rcirc-connect (server &optional port nick user-name
-                             full-name startup-channels password)
+                             full-name startup-channels password use-tls
+                            custom-connect-function)
   (save-excursion
     (message "Connecting to %s..." server)
     (let* ((inhibit-eol-conversion)
@@ -484,7 +512,16 @@ If ARG is non-nil, instead prompt for connection 
parameters."
           (user-name (or user-name rcirc-default-user-name))
           (full-name (or full-name rcirc-default-full-name))
           (startup-channels startup-channels)
-           (process (make-network-process :name server :host server :service 
port-number)))
+           (process))
+      (if (functionp custom-connect-function)
+         (setq process (funcall custom-connect-function server nil server 
port-number))
+       (if use-tls
+           (setq process (open-tls-stream server nil server port-number))
+         (setq process (open-network-stream server nil server port-number))))
+      (unless process
+       (error (concat 
+              (format "Couldn't connect to %s on %d " server port-number)
+              (when use-tls "using TLS/SSL"))))
       ;; set up process
       (set-process-coding-system process 'raw-text 'raw-text)
       (switch-to-buffer (rcirc-generate-new-buffer-name process nil))
@@ -698,7 +735,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and 
LINE.")
   "Send PROCESS a STRING plus a newline."
   (let ((string (concat (encode-coding-string string 
rcirc-encode-coding-system)
                         "\n")))
-    (unless (eq (process-status process) 'open)
+    (unless (member (process-status process) '(open run))
       (error "Network connection to %s is not open"
              (process-name process)))
     (rcirc-debug process string)
@@ -1401,7 +1438,8 @@ Returns nil if the information is not recorded."
       (- rcirc-current-line last-activity-line))))
 
 (defvar rcirc-markup-text-functions
-  '(rcirc-markup-attributes
+  '(rcirc-markup-strip-irc-colors
+    rcirc-markup-attributes
     rcirc-markup-my-nick
     rcirc-markup-urls
     rcirc-markup-keywords
@@ -2302,6 +2340,10 @@ keywords when no KEYWORD is given."
   (insert (rcirc-facify (format-time-string rcirc-time-format)
                        'rcirc-timestamp)))
 
+(defun rcirc-markup-strip-irc-colors (sender response)
+  (while (re-search-forward "\C-c\\([0-9][0-9]?\\(,[0-9][0-9]?\\)?\\)?" nil t)
+    (delete-region (match-beginning 0) (match-end 0))))
+
 (defun rcirc-markup-attributes (sender response)
   (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
     (rcirc-add-face (match-beginning 0) (match-end 0)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]