;;; 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