Commit | Line | Data |
---|---|---|
8af55556 TZ |
1 | ;;; gnutls.el --- Support SSL and TLS connections through GnuTLS |
2 | ;; Copyright (C) 2010 Free Software Foundation, Inc. | |
3 | ||
4 | ;; Author: Ted Zlatanov <tzz@lifelogs.com> | |
5 | ;; Keywords: comm, tls, ssl, encryption | |
6 | ;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/) | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; This package provides language bindings for the GnuTLS library | |
26 | ;; using the corresponding core functions in gnutls.c. | |
27 | ||
28 | ;; Simple test: | |
29 | ;; | |
30 | ;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443)) | |
31 | ;; (process-send-string jas "GET /\r\n\r\n") | |
32 | ||
33 | ;;; Code: | |
34 | ||
8ed70bf3 LMI |
35 | (defgroup gnutls nil |
36 | "Emacs interface to the GnuTLS library." | |
37 | :prefix "gnutls-" | |
38 | :group 'net-utils) | |
39 | ||
df7fcaff | 40 | (defcustom gnutls-log-level 0 |
8ed70bf3 LMI |
41 | "Logging level to be used by `starttls-negotiate' and GnuTLS." |
42 | :type 'integer | |
43 | :group 'gnutls) | |
44 | ||
8af55556 TZ |
45 | (defun open-ssl-stream (name buffer host service) |
46 | "Open a SSL connection for a service to a host. | |
47 | Returns a subprocess-object to represent the connection. | |
48 | Input and output work as for subprocesses; `delete-process' closes it. | |
49 | Args are NAME BUFFER HOST SERVICE. | |
50 | NAME is name for process. It is modified if necessary to make it unique. | |
51 | BUFFER is the buffer (or `buffer-name') to associate with the process. | |
52 | Process output goes at end of that buffer, unless you specify | |
53 | an output stream or filter function to handle the output. | |
54 | BUFFER may be also nil, meaning that this process is not associated | |
55 | with any buffer | |
56 | Third arg is name of the host to connect to, or its IP address. | |
57 | Fourth arg SERVICE is name of the service desired, or an integer | |
58 | specifying a port number to connect to." | |
59 | (let ((proc (open-network-stream name buffer host service))) | |
60 | (starttls-negotiate proc nil 'gnutls-x509pki))) | |
61 | ||
62 | ;; (open-ssl-stream "tls" "tls-buffer" "yourserver.com" "https") | |
63 | (defun starttls-negotiate (proc &optional priority-string | |
64 | credentials credentials-file) | |
65 | "Negotiate a SSL or TLS connection. | |
66 | PROC is the process returned by `starttls-open-stream'. | |
67 | PRIORITY-STRING is as per the GnuTLS docs. | |
68 | CREDENTIALS is `gnutls-x509pki' or `gnutls-anon'. | |
69 | CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS." | |
70 | (let* ((credentials (or credentials 'gnutls-x509pki)) | |
71 | (credentials-file (or credentials-file | |
72 | "/etc/ssl/certs/ca-certificates.crt" | |
73 | ;"/etc/ssl/certs/ca.pem" | |
74 | )) | |
75 | ||
76 | (priority-string (or priority-string | |
77 | (cond | |
78 | ((eq credentials 'gnutls-anon) | |
79 | "NORMAL:+ANON-DH:!ARCFOUR-128") | |
80 | ((eq credentials 'gnutls-x509pki) | |
81 | "NORMAL")))) | |
82 | ret) | |
83 | ||
84 | (gnutls-message-maybe | |
8ed70bf3 LMI |
85 | (setq ret (gnutls-boot proc priority-string |
86 | credentials credentials-file | |
87 | nil nil gnutls-log-level)) | |
8af55556 TZ |
88 | "boot: %s") |
89 | ||
df7fcaff | 90 | proc)) |
8af55556 TZ |
91 | |
92 | (defun starttls-open-stream (name buffer host service) | |
93 | "Open a TLS connection for a service to a host. | |
94 | Returns a subprocess-object to represent the connection. | |
95 | Input and output work as for subprocesses; `delete-process' closes it. | |
96 | Args are NAME BUFFER HOST SERVICE. | |
97 | NAME is name for process. It is modified if necessary to make it unique. | |
98 | BUFFER is the buffer (or `buffer-name') to associate with the process. | |
99 | Process output goes at end of that buffer, unless you specify | |
100 | an output stream or filter function to handle the output. | |
101 | BUFFER may be also nil, meaning that this process is not associated | |
102 | with any buffer | |
103 | Third arg is name of the host to connect to, or its IP address. | |
104 | Fourth arg SERVICE is name of the service desired, or an integer | |
105 | specifying a port number to connect to." | |
106 | (open-network-stream name buffer host service)) | |
107 | ||
108 | (defun gnutls-message-maybe (doit format &rest params) | |
109 | "When DOIT, message with the caller name followed by FORMAT on PARAMS." | |
110 | ;; (apply 'debug format (or params '(nil))) | |
111 | (when (gnutls-errorp doit) | |
112 | (message "%s: (err=[%s] %s) %s" | |
113 | "gnutls.el" | |
114 | doit (gnutls-error-string doit) | |
115 | (apply 'format format (or params '(nil)))))) | |
116 | ||
117 | (provide 'ssl) | |
118 | (provide 'gnutls) | |
119 | (provide 'starttls) | |
120 | ||
121 | ;;; gnutls.el ends here |