/[emacs]/emacs/lisp/net/tls.el
ViewVC logotype

Diff of /emacs/lisp/net/tls.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.6.2 by miles, Thu Sep 9 09:36:33 2004 UTC revision 1.1.6.3 by miles, Thu Oct 14 08:49:58 2004 UTC
# Line 1  Line 1 
1  ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS  ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
2    
3  ;; Copyright (C) 2003 Free Software Foundation, Inc.  ;; Copyright (C) 1996-1999, 2003, 2004 Free Software Foundation, Inc.
4    
5  ;; Author: Simon Josefsson <simon@josefsson.org>  ;; Author: Simon Josefsson <simon@josefsson.org>
6  ;; Keywords: comm, tls, gnutls, ssl  ;; Keywords: comm, tls, gnutls, ssl
# Line 76  The default is what GNUTLS's \"gnutls-cl Line 76  The default is what GNUTLS's \"gnutls-cl
76    :type 'regexp    :type 'regexp
77    :group 'tls)    :group 'tls)
78    
79    (defcustom tls-certtool-program (executable-find "certtool")
80      "Name of  GnuTLS certtool.
81    Used by `tls-certificate-information'."
82      :type '(repeat string)
83      :group 'tls)
84    
85    (defun tls-certificate-information (der)
86      "Parse X.509 certificate in DER format into an assoc list."
87      (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
88                                 (base64-encode-string der)
89                                 "\n-----END CERTIFICATE-----\n"))
90            (exit-code 0))
91        (with-current-buffer (get-buffer-create " *certtool*")
92          (erase-buffer)
93          (insert certificate)
94          (setq exit-code (condition-case ()
95                              (call-process-region (point-min) (point-max)
96                                                   tls-certtool-program
97                                                   t (list (current-buffer) nil) t
98                                                   "--certificate-info")
99                            (error -1)))
100          (if (/= exit-code 0)
101              nil
102            (let ((vals nil))
103              (goto-char (point-min))
104              (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
105                (push (cons (match-string 1) (match-string 2)) vals))
106              (nreverse vals))))))
107    
108  (defun open-tls-stream (name buffer host service)  (defun open-tls-stream (name buffer host service)
109    "Open a TLS connection for a service to a host.    "Open a TLS connection for a service to a host.
110  Returns a subprocess-object to represent the connection.  Returns a subprocess-object to represent the connection.

Legend:
Removed from v.1.1.6.2  
changed lines
  Added in v.1.1.6.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26