Anonymous avatar Anonymous committed 1ec35a4

2003-05-02 Steve Youngs <youngs@xemacs.org>;

* tls.el: New.

* Makefile (ELCS): Add tls.elc.

* package-info.in (provides): Add tls.

Comments (0)

Files changed (4)

+2003-05-02  Steve Youngs  <youngs@xemacs.org>
+
+	* tls.el: New.
+
+	* Makefile (ELCS): Add tls.elc.
+
+	* package-info.in (provides): Add tls.
+
 2003-03-09  Ben Wing  <ben@xemacs.org>
 
 	* Makefile:
 	mail-abbrevs.elc mail-extr.elc \
 	mail-utils.elc mailheader.elc reporter.elc rfc2104.elc rfc822.elc \
 	rmail-mini.elc rmailout.elc sendmail.elc smtpmail.elc pop3.elc \
-	starttls.elc base64.elc netrc.elc
+	starttls.elc base64.elc netrc.elc tls.elc
 
 EXPLICIT_DOCS = smtpmail.texi
 
    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (base64 browse-url-xemacs browse-url highlight-headers mail-abbrevs mail-extr mail-utils mailheader netrc pop3 reporter rfc2104 rfc822 rmail rmail-mini rmailout sendmail smtpmail starttls)
+   provides (base64 browse-url-xemacs browse-url highlight-headers mail-abbrevs mail-extr mail-utils mailheader netrc pop3 reporter rfc2104 rfc822 rmail rmail-mini rmailout sendmail smtpmail starttls tls)
    requires (REQUIRES)
    type regular
 ))
+;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
+
+;; Copyright (C) 2003 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, 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-program '("gnutls-cli -p %p %h"
+			 "gnutls-cli -p %p %h --protocols ssl3")
+  "List of strings containing commands to start TLS stream to a host.
+Each entry in the list is tried until a connection is successful.
+%s 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)
+  :group 'tls)
+
+(defcustom tls-process-connection-type nil
+  "*Value for `process-connection-type' to use when starting process."
+  :type 'boolean
+  :group 'tls)
+
+(defcustom tls-success "- Handshake was completed"
+  "*Regular expression indicating completed TLS handshakes.
+The default is what GNUTLS's \"gnutls-cli\" outputs."
+  :type 'regexp
+  :group 'tls)
+
+(defun open-tls-stream (name buffer host service)
+  "Open a TLS connection for a service 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 SERVICE.
+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 SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+  (let ((cmds tls-program) cmd done)
+    (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)
+	     (process (start-process
+		       name buffer shell-file-name shell-command-switch
+		       (format-spec
+			cmd
+			(format-spec-make
+			 ?h host
+			 ?p (if (integerp service)
+				(int-to-string service)
+			      service)))))
+	     response)
+	(while (and process
+		    (memq (process-status process) '(open run))
+		    (save-excursion
+		      (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+		      (goto-char (point-min))
+		      (not (setq done (re-search-forward tls-success nil t)))))
+	  (accept-process-output process 1)
+	  (sit-for 1))
+	(message "Opening TLS connection with `%s'...%s" cmd
+		 (if done "done" "failed"))
+	(if done
+	    (setq done process)
+	  (delete-process process))))
+    (message "Opening TLS connection to `%s'...%s"
+	     host (if done "done" "failed"))
+    done))
+
+(provide 'tls)
+
+;;; tls.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.