From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Marco Pessotto Newsgroups: gmane.emacs.devel Subject: [PATCH] rcirc: support TLS/SSL and arbitrary connection method Date: Mon, 30 May 2011 23:46:30 +0200 Message-ID: <87fwnvvp3d.fsf@universe.krase.net> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1306795732 12931 80.91.229.12 (30 May 2011 22:48:52 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 30 May 2011 22:48:52 +0000 (UTC) Cc: rcyeske@gmail.com To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue May 31 00:48:48 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QRBGR-0003Y0-Vj for ged-emacs-devel@m.gmane.org; Tue, 31 May 2011 00:48:48 +0200 Original-Received: from localhost ([::1]:50485 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QRBGR-0004HN-J7 for ged-emacs-devel@m.gmane.org; Mon, 30 May 2011 18:48:47 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:35477) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QRAIN-0004yE-58 for emacs-devel@gnu.org; Mon, 30 May 2011 17:46:44 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QRAIL-0000wZ-Fk for emacs-devel@gnu.org; Mon, 30 May 2011 17:46:43 -0400 Original-Received: from mail-fx0-f41.google.com ([209.85.161.41]:40304) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QRAIL-0000wS-89 for emacs-devel@gnu.org; Mon, 30 May 2011 17:46:41 -0400 Original-Received: by fxm18 with SMTP id 18so3247699fxm.0 for ; Mon, 30 May 2011 14:46:40 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:from:to:cc:subject:date:message-id:user-agent :mime-version:content-type; bh=AmqFy7u2EpXAjOJwODafep8935ahyPmDkBAT6xfWFXE=; b=W+4YFPGIWTOnrrInSp8KsKwgg2YpoRf+fWGi044t0ri83PgN4HWNuyVE/g0zicQC0S Sbec3tXJVsMuwIkIvmYJJOTJrUSFSDRjLDw1sRRJXutV5paTyreKOwN0o/FHW+GIIHdC mJNN43t3BmLswtsClkiZvAVcG56DnNGnuGoIg= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=from:to:cc:subject:date:message-id:user-agent:mime-version :content-type; b=ku4emABNymb4stYTYUOiUeUfYU7gkaM1Ha26E7Mqa//nbt7ZZvujBOZnHlBSZxMRb1 SgsZrK99++Cal8IWJtmjC91s98xpyOobhlEJfo2WYhXKYtHBeNIrWSxnuED3kGYkEPcb UVrJ9hzLC2doURpaOwbbR2jGOmTKqONb6Yg8c= Original-Received: by 10.223.77.92 with SMTP id f28mr2044990fak.37.1306791998307; Mon, 30 May 2011 14:46:38 -0700 (PDT) Original-Received: from localhost (93-137-160-95.adsl.net.t-com.hr [93.137.160.95]) by mx.google.com with ESMTPS id n15sm868536fag.42.2011.05.30.14.46.36 (version=TLSv1/SSLv3 cipher=OTHER); Mon, 30 May 2011 14:46:37 -0700 (PDT) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 209.85.161.41 X-Mailman-Approved-At: Mon, 30 May 2011 18:48:45 -0400 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:139919 Archived-At: --=-=-= 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=ssl-custom-function.patch Content-Description: patch to support tls 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) --=-=-=--