summaryrefslogtreecommitdiffstats
path: root/emacs.d/lisp/rudel/.svn/text-base/rudel-tls.el.svn-base
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--emacs.d/lisp/rudel/.svn/text-base/rudel-tls.el.svn-base201
1 files changed, 201 insertions, 0 deletions
diff --git a/emacs.d/lisp/rudel/.svn/text-base/rudel-tls.el.svn-base b/emacs.d/lisp/rudel/.svn/text-base/rudel-tls.el.svn-base
new file mode 100644
index 0000000..a770851
--- /dev/null
+++ b/emacs.d/lisp/rudel/.svn/text-base/rudel-tls.el.svn-base
@@ -0,0 +1,201 @@
+;;; rudel-tls.el --- Start TLS protocol.
+;;
+;; Copyright (C) 2008, 2009 Jan Moringen
+;;
+;; Author: Jan Moringen <scymtym@users.sourceforge.net>
+;; Keywords: Rudel, TLS, encryption, starttls, gnutls
+;; X-RCS: $Id:$
+;;
+;; This file is part of Rudel.
+;;
+;; Rudel 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 of the License, or
+;; (at your option) any later version.
+;;
+;; Rudel 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 rudel. If not, see <http://www.gnu.org/licenses>.
+
+
+;;; Commentary:
+;;
+;; This contains a simple implementation of the so calls Start TLS
+;; protocol, which means enabling TLS encryption for an existing
+;; network connection.
+
+
+;;; History:
+;;
+;; 0.1 - Initial revision.
+
+
+;;; Code:
+;;
+
+(require 'format-spec)
+
+(require 'rudel)
+(require 'rudel-util)
+
+
+;;; Customization
+;;
+
+(defcustom rudel-tls-client-program
+ "gnutls-cli"
+ "The gnutls client program to use for encrypted connections."
+ :group 'rudel
+ :type 'file)
+
+(defcustom rudel-tls-client-arguments
+ "--starttls --kx ANON_DH --port %p %h"
+ "Arguments passed to the gnutls client program."
+ :group 'rudel
+ :type 'string)
+
+
+;;; TLS functions
+;;
+
+(defun rudel-tls-make-process (&rest args)
+ "Make a network process with keyword arguments ARGS.
+This function works similar to `make-network-process'. Supported
+keyword arguments are :name (ignore), :host, :port, :filter
+and :sentinel. The returned process object is suitable for
+start-TLS. Once the enclosing protocol indicates TLS encryption
+should start, `rudel-tls-start-tls' can be called to enabled TLS
+for the network connection."
+ (let* ((host (plist-get args :host)) ;; TODO clumsy
+ (port (plist-get args :service))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ ;; Compile the command to start the TLS binary.
+ (arguments (format-spec rudel-tls-client-arguments
+ (format-spec-make
+ ?h host
+ ?p (number-to-string port))))
+ ;; Start the TLS program.
+ (process (apply #'start-process
+ (format "*tls-%s*" host) nil
+ rudel-tls-client-program
+ (split-string arguments " "))))
+
+ ;; Store filter function and attach proxy filter to handle TLS
+ ;; handshake.
+ (when filter
+ (rudel-set-process-object process filter :old-filter))
+ (set-process-filter process #'rudel-tls-wait-init)
+
+ ;; Attach sentinel function.
+ (when sentinel
+ (set-process-sentinel process sentinel))
+
+ ;; Mark the process as supporting TLS encryption
+ (rudel-set-process-object process t :supports-tls)
+
+ process)
+ )
+
+(defun rudel-tls-start-tls (process)
+ "Enable TLS encryption for the network connection PROCESS.
+This only works if PROCESS has been created by
+`rudel-tls-make-process'."
+ ;; Save current filter function.
+ (rudel-set-process-object
+ process (process-filter process) :old-filter)
+ ;; Install TLS handshake filter function and signal program to start
+ ;; TLS handshake.
+ (message "tls-start-tls: switching to \"handshake\" filter")
+ (set-process-filter process #'rudel-tls-wait-handshake)
+ (signal-process process 'sigalrm)
+ )
+
+(defun rudel-tls-wait-init (process data)
+ "Is installed as process filter on PROCESS until gnutls is done printing messages."
+ ;; Retrieve complete lines.
+ (let ((buffer (rudel-process-object process :buffer)))
+ (rudel-assemble-line-fragments data buffer)
+ (rudel-set-process-object process buffer :buffer))
+
+ (let ((client-data)
+ (old-filter (rudel-process-object process :old-filter))
+ (client-mode))
+
+ ;; Assemble lines that were not generated by gnutls. It is very
+ ;; brittle to wait for last line of gnutls output like, but it
+ ;; cannot be helped.
+ (rudel-loop-lines data line
+ (if client-mode
+ (setq client-data (concat client-data line "\n"))
+ (when (string-match-p "- Simple Client Mode.*" line)
+ (setq client-mode t))))
+
+ ;; When there are any lines not generated by gnutls,
+ ;; initialization is over. Process the data and install the old
+ ;; filter function.
+ (when client-data
+ (funcall old-filter process client-data))
+ (when client-mode
+ (message "tls-wait-init: switching back to old filter")
+ (set-process-filter process old-filter)))
+ )
+
+(defun rudel-tls-wait-handshake (process data)
+ "Is installed as process filter on PROCESS while gnutls is doing the TLS handshake."
+ ;; Retrieve complete lines.
+ (let ((buffer (rudel-process-object process :buffer)))
+ (rudel-assemble-line-fragments data buffer)
+ (rudel-set-process-object process buffer :buffer))
+
+ (let ((client-data)
+ (old-filter (rudel-process-object process :old-filter))
+ (client-mode))
+
+ ;; Assemble lines that were not generated by gnutls. It is very
+ ;; brittle to wait for last line of gnutls output like, but it
+ ;; cannot be helped.
+ (rudel-loop-lines data line
+ (if client-mode
+ (setq client-data (concat client-data line "\n"))
+ (when (string-match-p "- Compression.*" line)
+ (setq client-mode t))))
+
+ ;; When there are any lines not generated by gnutls, handshake is
+ ;; over. Process the data and install `established' filter
+ ;; function.
+ (when client-data
+ (funcall old-filter process client-data))
+ (when client-mode
+ (message "tls-wait-handshake: switching to \"established\" filter")
+ (set-process-filter process #'rudel-tls-established)
+ (rudel-set-process-object process t :encryption)))
+ )
+
+(defun rudel-tls-established (process data)
+ "Is installed as process filter on PROCESS after gnutls has established TLS encryption."
+ ;; Retrieve complete lines.
+ (let ((buffer (rudel-process-object process :buffer)))
+ (rudel-assemble-line-fragments data buffer)
+ (rudel-set-process-object process buffer :buffer))
+
+ (let ((client-data)
+ (old-filter (rudel-process-object process :old-filter)))
+
+ ;; Assemble lines that were not generated by gnutls.
+ (rudel-loop-lines data line
+ (unless (string-match-p "- Peer has closed the GNUTLS connection" line)
+ (setq client-data (concat client-data line "\n"))))
+
+ ;; When there are any lines not generated by gnutls, pass those to
+ ;; the old filter function.
+ (when client-data
+ (funcall old-filter process client-data)))
+ )
+
+(provide 'rudel-tls)
+;;; rudel-tls.el ends here