Permalink
Browse files

Support HTTPS connection with `tls' library.

* twittering-mode.el: Support HTTPS with `tls' library.
(twittering-tls-program): new variable.
(twittering-connection-type-table): register
`twittering-start-http-session-native-tls-p' as the "https" entry
for "native".
(twittering-start-http-session-native-tls-p): new function.
(twittering-start-http-session-native): call `open-tls-stream' if
`twittering-use-ssl' is non-nil.
* emacs21/tls.el: Imported from Emacs 22.2.1 on Debian 5.0 for
Emacs21 that does not include `tls.el'.
  • Loading branch information...
1 parent 4228364 commit 45104c98102a0792bf54a25aeea61359b6d82538 @cvmat cvmat committed May 9, 2010
Showing with 267 additions and 9 deletions.
  1. +11 −0 ChangeLog
  2. +2 −0 NEWS
  3. +209 −0 emacs21/tls.el
  4. +45 −9 twittering-mode.el
View
11 ChangeLog
@@ -17,6 +17,17 @@
open a connection.
(twittering-start-http-session-native): likewise.
+ * twittering-mode.el: Support HTTPS with `tls' library.
+ (twittering-tls-program): new variable.
+ (twittering-connection-type-table): register
+ `twittering-start-http-session-native-tls-p' as the "https" entry
+ for "native".
+ (twittering-start-http-session-native-tls-p): new function.
+ (twittering-start-http-session-native): call `open-tls-stream' if
+ `twittering-use-ssl' is non-nil.
+ * emacs21/tls.el: Imported from Emacs 22.2.1 on Debian 5.0 for
+ Emacs21 that does not include `tls.el'.
+
2010-05-08 Tadashi MATSUO <tad@mymail.twin.jp>
* twittering-mode.el: Add an abstract layer for Twitter API.
View
2 NEWS
@@ -49,6 +49,8 @@ existing way.
* Graphical indicators for SSL and ACTIVE/INACTIVE state on mode-line.
* Asynchronous retrieval of icon images.
* Deleting a tweet by inputting 'C-cD'.
+* HTTPS connection using `tls' library working with an external command
+ `gnutls' or `openssl' instead of `curl'.
* ...
### Bug fixes
View
209 emacs21/tls.el
@@ -0,0 +1,209 @@
+;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: comm, tls, gnutls, ssl
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This package implements a simple wrapper around "gnutls-cli" to
+;; make Emacs support TLS/SSL.
+;;
+;; Usage is the same as `open-network-stream', i.e.:
+;;
+;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563))
+;; ...
+;; #<process test>
+;; (process-send-string tmp "mode reader\n")
+;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ...
+;; nil
+;; (process-send-string tmp "quit\n")
+;; 205
+;; nil
+
+;; To use this package as a replacement for ssl.el by William M. Perry
+;; <wmperry@cs.indiana.edu>, you need to evaluate the following:
+;;
+;; (defalias 'open-ssl-stream 'open-tls-stream)
+
+;;; Code:
+
+(eval-and-compile
+ (autoload 'format-spec "format-spec")
+ (autoload 'format-spec-make "format-spec"))
+
+(defgroup tls nil
+ "Transport Layer Security (TLS) parameters."
+ :group 'comm)
+
+(defcustom tls-end-of-info
+ (concat
+ "\\("
+ ;; `openssl s_client' regexp. See ssl/ssl_txt.c lines 219-220.
+ ;; According to apps/s_client.c line 1515 `---' is always the last
+ ;; line that is printed by s_client before the real data.
+ "^ Verify return code: .+\n---\n\\|"
+ ;; `gnutls' regexp. See src/cli.c lines 721-.
+ "^- Simple Client Mode:\n"
+ "\\(\n\\|" ; ignore blank lines
+ ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715
+ ;; in `main' the handshake will start after this message. If the
+ ;; handshake fails, the programs will abort.
+ "^\\*\\*\\* Starting TLS handshake\n\\)*"
+ "\\)")
+ "Regexp matching end of TLS client informational messages.
+Client data stream begins after the last character matched by
+this. The default matches `openssl s_client' (version 0.9.8c)
+and `gnutls-cli' (version 2.0.1) output."
+ :version "22.2"
+ :type 'regexp
+ :group 'tls)
+
+(defcustom tls-program '("gnutls-cli -p %p %h"
+ "gnutls-cli -p %p %h --protocols ssl3"
+ "openssl s_client -connect %h:%p -no_ssl2")
+ "List of strings containing commands to start TLS stream to a host.
+Each entry in the list is tried until a connection is successful.
+%h is replaced with server hostname, %p with port to connect to.
+The program should read input on stdin and write output to
+stdout. Also see `tls-success' for what the program should output
+after successful negotiation."
+ :type '(repeat string)
+ :version "22.1"
+ :group 'tls)
+
+(defcustom tls-process-connection-type nil
+ "*Value for `process-connection-type' to use when starting TLS process."
+ :version "22.1"
+ :type 'boolean
+ :group 'tls)
+
+(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
+ "*Regular expression indicating completed TLS handshakes.
+The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
+\"openssl s_client\" outputs."
+ :version "22.1"
+ :type 'regexp
+ :group 'tls)
+
+(defcustom tls-certtool-program (executable-find "certtool")
+ "Name of GnuTLS certtool.
+Used by `tls-certificate-information'."
+ :version "22.1"
+ :type 'string
+ :group 'tls)
+
+(defun tls-certificate-information (der)
+ "Parse X.509 certificate in DER format into an assoc list."
+ (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
+ (base64-encode-string der)
+ "\n-----END CERTIFICATE-----\n"))
+ (exit-code 0))
+ (with-current-buffer (get-buffer-create " *certtool*")
+ (erase-buffer)
+ (insert certificate)
+ (setq exit-code (condition-case ()
+ (call-process-region (point-min) (point-max)
+ tls-certtool-program
+ t (list (current-buffer) nil) t
+ "--certificate-info")
+ (error -1)))
+ (if (/= exit-code 0)
+ nil
+ (let ((vals nil))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
+ (push (cons (match-string 1) (match-string 2)) vals))
+ (nreverse vals))))))
+
+(defun open-tls-stream (name buffer host port)
+ "Open a TLS connection for a port to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST PORT.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg PORT is an integer specifying a port to connect to."
+ (let ((cmds tls-program)
+ (use-temp-buffer (null buffer))
+ process cmd done)
+ (if use-temp-buffer
+ (setq buffer (generate-new-buffer " TLS")))
+ (with-current-buffer buffer
+ (message "Opening TLS connection to `%s'..." host)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "Opening TLS connection with `%s'..." cmd)
+ (let ((process-connection-type tls-process-connection-type)
+ response)
+ (setq process (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?h host
+ ?p (if (integerp port)
+ (int-to-string port)
+ port)))))
+ (while (and process
+ (memq (process-status process) '(open run))
+ (progn
+ (goto-char (point-min))
+ (not (setq done (re-search-forward tls-success nil t)))))
+ (unless (accept-process-output process 1)
+ (sit-for 1)))
+ (message "Opening TLS connection with `%s'...%s" cmd
+ (if done "done" "failed"))
+ (if (not done)
+ (delete-process process)
+ ;; advance point to after all informational messages that
+ ;; `openssl s_client' and `gnutls' print
+ (let ((start-of-data nil))
+ (while
+ (not (setq start-of-data
+ ;; the string matching `tls-end-of-info'
+ ;; might come in separate chunks from
+ ;; `accept-process-output', so start the
+ ;; search where `tls-success' ended
+ (save-excursion
+ (if (re-search-forward tls-end-of-info nil t)
+ (match-end 0)))))
+ (accept-process-output process 1))
+ (if start-of-data
+ ;; move point to start of client data
+ (goto-char start-of-data)))
+ (setq done process))))
+ (message "Opening TLS connection to `%s'...%s"
+ host (if done "done" "failed")))
+ (when use-temp-buffer
+ (if done (set-process-buffer process nil))
+ (kill-buffer buffer))
+ done))
+
+(provide 'tls)
+
+;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac
+;;; tls.el ends here
View
54 twittering-mode.el
@@ -47,12 +47,16 @@
(require 'xml)
(require 'parse-time)
(when (> 22 emacs-major-version)
- (add-to-list 'load-path
- (expand-file-name
- "url-emacs21" (if load-file-name
- (or (file-name-directory load-file-name)
- ".")
- ".")))
+ (setq load-path
+ (append (mapcar (lambda (dir)
+ (expand-file-name
+ dir
+ (if load-file-name
+ (or (file-name-directory load-file-name)
+ ".")
+ ".")))
+ '("url-emacs21" "emacs21"))
+ load-path))
(and (require 'un-define nil t)
;; the explicitly require 'unicode to update a workaround with
;; navi2ch. see a comment of `twittering-ucs-to-char' for more
@@ -269,12 +273,20 @@ SSL connections use 'curl' command as a backend.")
"Cache a result of `twittering-find-curl-program'.
DO NOT SET VALUE MANUALLY.")
+(defvar twittering-tls-program nil
+ "*List of strings containing commands to start TLS stream to a host.
+Each entry in the list is tried until a connection is successful.
+%h is replaced with server hostname, %p with port to connect to.
+Also see `tls-program'.
+If nil, this is initialized with a list of valied entries extracted from
+`tls-program'.")
+
(defvar twittering-connection-type-order '(curl native))
"*A list of connection methods in the preferred order."
(defvar twittering-connection-type-table
'((native (check . t)
- (https . nil)
+ (https . twittering-start-http-session-native-tls-p)
(start . twittering-start-http-session-native))
(curl (check . twittering-start-http-session-curl-p)
(https . twittering-start-http-session-curl-https-p)
@@ -2747,6 +2759,19 @@ Z70Br83gcfxaz2TE4JaY0KNA4gGK7ycH8WUBikQtBmV1UsCGECAhX2xrD2yuCRyv
curl-process)))
)
+(defun twittering-start-http-session-native-tls-p ()
+ (when (require 'tls nil t)
+ (let ((programs
+ (remove nil
+ (mapcar (lambda (cmd)
+ (when (string-match "\\`\\([^ ]+\\) " cmd)
+ (when (executable-find (match-string 1 cmd))
+ cmd)))
+ tls-program))))
+ (unless twittering-tls-program
+ (setq twittering-tls-program programs))
+ programs)))
+
;; TODO: proxy
(defun twittering-start-http-session-native (method headers host port path parameters &optional noninteractive sentinel)
(let ((request (twittering-make-http-request
@@ -2768,8 +2793,19 @@ Z70Br83gcfxaz2TE4JaY0KNA4gGK7ycH8WUBikQtBmV1UsCGECAhX2xrD2yuCRyv
(port (if twittering-proxy-use
twittering-proxy-port
(request :port)))
- (proc (open-network-stream
- "network-connection-process" temp-buffer server port))
+ (proc
+ (cond
+ (twittering-use-ssl
+ (let* ((tls-program twittering-tls-program)
+ (proc
+ (open-tls-stream
+ "network-connection-process" nil server port)))
+ (when proc
+ (set-process-buffer proc temp-buffer))
+ proc))
+ (t
+ (open-network-stream
+ "network-connection-process" temp-buffer server port))))
)
(when proc
(lexical-let ((sentinel sentinel)

0 comments on commit 45104c9

Please sign in to comment.