unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] rcirc: support TLS/SSL and arbitrary connection method
@ 2011-05-30 21:46 Marco Pessotto
  2011-05-31  1:24 ` Stefan Monnier
                   ` (2 more replies)
  0 siblings, 3 replies; 15+ messages in thread
From: Marco Pessotto @ 2011-05-30 21:46 UTC (permalink / raw)
  To: emacs-devel; +Cc: rcyeske

[-- Attachment #1: Type: text/plain, Size: 1101 bytes --]


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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch to support tls --]
[-- Type: text/x-diff, Size: 6234 bytes --]

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)

^ permalink raw reply related	[flat|nested] 15+ messages in thread
end of thread, other threads:[~2011-06-08 14:22 UTC | newest]

Thread overview: 15+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-05-30 21:46 [PATCH] rcirc: support TLS/SSL and arbitrary connection method Marco Pessotto
2011-05-31  1:24 ` Stefan Monnier
2011-05-31 12:16   ` Julien Danjou
2011-05-31 12:58     ` Deniz Dogan
2011-05-31 14:21     ` Marco Pessotto
2011-05-31 14:57       ` Stefan Monnier
2011-05-31 15:35         ` Marco Pessotto
2011-05-31  8:07 ` Julien Danjou
2011-05-31  8:52   ` Marco Pessotto
2011-05-31  9:55 ` Ted Zlatanov
2011-05-31 11:16   ` Marco Pessotto
2011-06-07 22:27   ` Philipp Haselwarter
2011-06-08  3:32     ` Ted Zlatanov
2011-06-08  8:52       ` Julien Danjou
2011-06-08 14:22         ` auth-source for ERC (was: [PATCH] rcirc: support TLS/SSL and arbitrary connection method) Ted Zlatanov

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).