Merge from mainline.
This commit is contained in:
Paul Eggert
commit
53a35e81c9
10 changed files with 180 additions and 91 deletions
|
|
@ -1,4 +1,4 @@
|
|||
2011-05-03 Peter Münster <pmlists@free.fr>
|
||||
2011-05-03 Peter Münster <pmlists@free.fr> (tiny change)
|
||||
|
||||
* gnus.texi (Summary Buffer Lines):
|
||||
gnus-summary-user-date-format-alist does not exist.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,39 @@
|
|||
2011-05-04 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* calendar/diary-lib.el (diary-fancy-date-pattern): Turn it into a
|
||||
function, so it follows changes in calendar-date-style.
|
||||
(diary-fancy-date-matcher): New function.
|
||||
(diary-fancy-font-lock-keywords): Use diary-fancy-date-matcher.
|
||||
(diary-fancy-font-lock-fontify-region-function):
|
||||
Use diary-fancy-date-pattern as a function.
|
||||
|
||||
* calendar/diary-lib.el (diary-fancy-date-pattern): Do not use
|
||||
non-numbers for `year' etc pseudo-variables. (Bug#8583)
|
||||
|
||||
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* net/gnutls.el (gnutls-negotiate): Use CL-style keyword arguments
|
||||
instead of positional arguments. Allow :keylist and :crlfiles
|
||||
arguments.
|
||||
(open-gnutls-stream): Call it.
|
||||
|
||||
* net/network-stream.el (network-stream-open-starttls): Adjust to
|
||||
call `gnutls-negotiate' with :process and :hostname arguments.
|
||||
|
||||
2011-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* minibuffer.el (completion--message): New function.
|
||||
(completion--do-completion, minibuffer-complete)
|
||||
(minibuffer-force-complete, minibuffer-complete-word): Use it.
|
||||
(completion--do-completion): Don't ignore completion-auto-help when in
|
||||
icomplete-mode.
|
||||
|
||||
* whitespace.el (whitespace-trailing-regexp): Don't rely on the
|
||||
internal encoding (e.g. tibetan zero is not whitespace).
|
||||
(global-whitespace-mode): Prefer save-current-buffer.
|
||||
(whitespace-trailing-regexp): Remove useless save-match-data.
|
||||
(whitespace-empty-at-bob-regexp): Minor simplification.
|
||||
|
||||
2011-05-03 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* emacs-lisp/autoload.el (generated-autoload-file): Doc fix (Bug#7989).
|
||||
|
|
|
|||
|
|
@ -2090,7 +2090,7 @@ Optional symbol TYPE is either `monthly' or `yearly'."
|
|||
'(day " " monthname))
|
||||
(t '(monthname " " day))))
|
||||
;; Iso cannot contain "-", because this form used eg by
|
||||
;; insert-anniversary-diary-entry.
|
||||
;; diary-insert-anniversary-entry.
|
||||
(t (cond ((eq calendar-date-style 'iso)
|
||||
'((format "%s %.2d %.2d" year
|
||||
(string-to-number month) (string-to-number day))))
|
||||
|
|
@ -2364,36 +2364,45 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
|
|||
|
||||
;;; Fancy Diary Mode.
|
||||
|
||||
;; FIXME does not update upon changes to the name-arrays.
|
||||
(defvar diary-fancy-date-pattern
|
||||
(defun diary-fancy-date-pattern ()
|
||||
"Return a regexp matching the first line of a fancy diary date header.
|
||||
This depends on the calendar date style."
|
||||
(concat
|
||||
(let ((dayname (diary-name-pattern calendar-day-name-array nil t))
|
||||
(monthname (diary-name-pattern calendar-month-name-array nil t))
|
||||
(day "[0-9]+")
|
||||
(month "[0-9]+")
|
||||
(year "-?[0-9]+"))
|
||||
(mapconcat 'eval calendar-date-display-form ""))
|
||||
(day "1")
|
||||
(month "2")
|
||||
;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
|
||||
(year "3"))
|
||||
;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
|
||||
;; string form"; eg the iso version calls string-to-number on some.
|
||||
;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
|
||||
;; Assumes no integers in c-day/month-name-array.
|
||||
(replace-regexp-in-string "[0-9]+" "[0-9]+"
|
||||
(mapconcat 'eval calendar-date-display-form "")
|
||||
nil t))
|
||||
;; Optional ": holiday name" after the date.
|
||||
"\\(: .*\\)?")
|
||||
"Regular expression matching a date header in Fancy Diary.")
|
||||
"\\(: .*\\)?"))
|
||||
|
||||
(defun diary-fancy-date-matcher (limit)
|
||||
"Search for a fancy diary data header, up to LIMIT."
|
||||
;; Any number of " other holiday name" lines, followed by "==" line.
|
||||
(when (re-search-forward
|
||||
(format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t)
|
||||
t))
|
||||
|
||||
(define-obsolete-variable-alias 'fancy-diary-font-lock-keywords
|
||||
'diary-fancy-font-lock-keywords "23.1")
|
||||
|
||||
(defvar diary-fancy-font-lock-keywords
|
||||
(list
|
||||
(list
|
||||
;; Any number of " other holiday name" lines, followed by "==" line.
|
||||
(concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$")
|
||||
'(0 (progn (put-text-property (match-beginning 0) (match-end 0)
|
||||
'font-lock-multiline t)
|
||||
diary-face)))
|
||||
'("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
|
||||
'("^.*Yahrzeit.*$" . font-lock-reference-face)
|
||||
'("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
|
||||
'("^Day.*omer.*$" . font-lock-builtin-face)
|
||||
'("^Parashat.*$" . font-lock-comment-face)
|
||||
`(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
|
||||
`((diary-fancy-date-matcher . diary-face)
|
||||
("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
|
||||
("^.*Yahrzeit.*$" . font-lock-reference-face)
|
||||
("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
|
||||
("^Day.*omer.*$" . font-lock-builtin-face)
|
||||
("^Parashat.*$" . font-lock-comment-face)
|
||||
(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
|
||||
diary-time-regexp) . 'diary-time))
|
||||
"Keywords to highlight in fancy diary display.")
|
||||
|
||||
|
|
@ -2409,7 +2418,7 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
|
|||
(while (and (looking-at " +[^ ]")
|
||||
(zerop (forward-line -1))))
|
||||
;; This check not essential.
|
||||
(if (looking-at diary-fancy-date-pattern)
|
||||
(if (looking-at (diary-fancy-date-pattern))
|
||||
(setq beg (line-beginning-position)))
|
||||
(goto-char end)
|
||||
(forward-line 0)
|
||||
|
|
|
|||
|
|
@ -558,6 +558,10 @@ candidates than this number."
|
|||
(defvar completion-fail-discreetly nil
|
||||
"If non-nil, stay quiet when there is no match.")
|
||||
|
||||
(defun completion--message (msg)
|
||||
(if completion-show-inline-help
|
||||
(minibuffer-message msg)))
|
||||
|
||||
(defun completion--do-completion (&optional try-completion-function)
|
||||
"Do the completion and return a summary of what happened.
|
||||
M = completion was performed, the text was Modified.
|
||||
|
|
@ -585,9 +589,9 @@ E = after completion we now have an Exact match.
|
|||
(cond
|
||||
((null comp)
|
||||
(minibuffer-hide-completions)
|
||||
(when (and (not completion-fail-discreetly) completion-show-inline-help)
|
||||
(unless completion-fail-discreetly
|
||||
(ding)
|
||||
(minibuffer-message "No match"))
|
||||
(completion--message "No match"))
|
||||
(minibuffer--bitset nil nil nil))
|
||||
((eq t comp)
|
||||
(minibuffer-hide-completions)
|
||||
|
|
@ -657,15 +661,13 @@ E = after completion we now have an Exact match.
|
|||
(minibuffer-hide-completions))
|
||||
;; Show the completion table, if requested.
|
||||
((not exact)
|
||||
(if (cond (icomplete-mode t)
|
||||
((null completion-show-inline-help) t)
|
||||
((eq completion-auto-help 'lazy)
|
||||
(eq this-command last-command))
|
||||
(t completion-auto-help))
|
||||
(if (case completion-auto-help
|
||||
(lazy (eq this-command last-command))
|
||||
(t completion-auto-help))
|
||||
(minibuffer-completion-help)
|
||||
(minibuffer-message "Next char not unique")))
|
||||
(completion--message "Next char not unique")))
|
||||
;; If the last exact completion and this one were the same, it
|
||||
;; means we've already given a "Next char not unique" message
|
||||
;; means we've already given a "Complete, but not unique" message
|
||||
;; and the user's hit TAB again, so now we give him help.
|
||||
((eq this-command last-command)
|
||||
(if completion-auto-help (minibuffer-completion-help))))
|
||||
|
|
@ -703,11 +705,9 @@ scroll the window of possible completions."
|
|||
t)
|
||||
(t (case (completion--do-completion)
|
||||
(#b000 nil)
|
||||
(#b001 (if completion-show-inline-help
|
||||
(minibuffer-message "Sole completion"))
|
||||
(#b001 (completion--message "Sole completion")
|
||||
t)
|
||||
(#b011 (if completion-show-inline-help
|
||||
(minibuffer-message "Complete, but not unique"))
|
||||
(#b011 (completion--message "Complete, but not unique")
|
||||
t)
|
||||
(t t)))))
|
||||
|
||||
|
|
@ -765,9 +765,8 @@ Repeated uses step through the possible completions."
|
|||
(end (field-end))
|
||||
(all (completion-all-sorted-completions)))
|
||||
(if (not (consp all))
|
||||
(if completion-show-inline-help
|
||||
(minibuffer-message
|
||||
(if all "No more completions" "No completions")))
|
||||
(completion--message
|
||||
(if all "No more completions" "No completions"))
|
||||
(setq completion-cycling t)
|
||||
(goto-char end)
|
||||
(insert (car all))
|
||||
|
|
@ -955,11 +954,9 @@ Return nil if there is no valid completion, else t."
|
|||
(interactive)
|
||||
(case (completion--do-completion 'completion--try-word-completion)
|
||||
(#b000 nil)
|
||||
(#b001 (if completion-show-inline-help
|
||||
(minibuffer-message "Sole completion"))
|
||||
(#b001 (completion--message "Sole completion")
|
||||
t)
|
||||
(#b011 (if completion-show-inline-help
|
||||
(minibuffer-message "Complete, but not unique"))
|
||||
(#b011 (completion--message "Complete, but not unique")
|
||||
t)
|
||||
(t t)))
|
||||
|
||||
|
|
|
|||
|
|
@ -35,6 +35,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup gnutls nil
|
||||
"Emacs interface to the GnuTLS library."
|
||||
:prefix "gnutls-"
|
||||
|
|
@ -72,9 +74,9 @@ This is a very simple wrapper around `gnutls-negotiate'. See its
|
|||
documentation for the specific parameters you can use to open a
|
||||
GnuTLS connection, including specifying the credential type,
|
||||
trust and key files, and priority string."
|
||||
(gnutls-negotiate (open-network-stream name buffer host service)
|
||||
'gnutls-x509pki
|
||||
host))
|
||||
(gnutls-negotiate :process (open-network-stream name buffer host service)
|
||||
:type 'gnutls-x509pki
|
||||
:hostname host))
|
||||
|
||||
(put 'gnutls-error
|
||||
'error-conditions
|
||||
|
|
@ -85,16 +87,23 @@ trust and key files, and priority string."
|
|||
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
|
||||
(declare-function gnutls-errorp "gnutls.c" (error))
|
||||
|
||||
(defun gnutls-negotiate (proc type hostname &optional priority-string
|
||||
trustfiles keyfiles verify-flags
|
||||
verify-error verify-hostname-error)
|
||||
(defun* gnutls-negotiate
|
||||
(&rest spec
|
||||
&key process type hostname priority-string
|
||||
trustfiles crlfiles keylist verify-flags
|
||||
verify-error verify-hostname-error
|
||||
&allow-other-keys)
|
||||
"Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
|
||||
|
||||
Note arguments are passed CL style, :type TYPE instead of just TYPE.
|
||||
|
||||
TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
|
||||
PROC is a process returned by `open-network-stream'.
|
||||
PROCESS is a process returned by `open-network-stream'.
|
||||
HOSTNAME is the remote hostname. It must be a valid string.
|
||||
PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
|
||||
TRUSTFILES is a list of CA bundles.
|
||||
KEYFILES is a list of client keys.
|
||||
CRLFILES is a list of CRL files.
|
||||
KEYLIST is an alist of (client key file, client cert file) pairs.
|
||||
|
||||
When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
|
||||
when the hostname does not match the presented certificate's host
|
||||
|
|
@ -141,7 +150,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
|
|||
:hostname ,hostname
|
||||
:loglevel ,gnutls-log-level
|
||||
:trustfiles ,trustfiles
|
||||
:keyfiles ,keyfiles
|
||||
:crlfiles ,crlfiles
|
||||
:keylist ,keylist
|
||||
:verify-flags ,verify-flags
|
||||
:verify-error ,verify-error
|
||||
:verify-hostname-error ,verify-hostname-error
|
||||
|
|
@ -149,14 +159,14 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
|
|||
ret)
|
||||
|
||||
(gnutls-message-maybe
|
||||
(setq ret (gnutls-boot proc type params))
|
||||
(setq ret (gnutls-boot process type params))
|
||||
"boot: %s" params)
|
||||
|
||||
(when (gnutls-errorp ret)
|
||||
;; This is a error from the underlying C code.
|
||||
(signal 'gnutls-error (list proc ret)))
|
||||
(signal 'gnutls-error (list process ret)))
|
||||
|
||||
proc))
|
||||
process))
|
||||
|
||||
(declare-function gnutls-error-string "gnutls.c" (error))
|
||||
|
||||
|
|
|
|||
|
|
@ -45,9 +45,7 @@
|
|||
(require 'tls)
|
||||
(require 'starttls)
|
||||
|
||||
(declare-function gnutls-negotiate "gnutls"
|
||||
(proc type host &optional priority-string trustfiles keyfiles
|
||||
verify-flags verify-error verify-hostname-error))
|
||||
(declare-function gnutls-negotiate "gnutls" (&rest spec))
|
||||
|
||||
;;;###autoload
|
||||
(defun open-network-stream (name buffer host service &rest parameters)
|
||||
|
|
@ -203,7 +201,7 @@ asynchronously, if possible."
|
|||
(network-stream-command stream starttls-command eoc))
|
||||
;; The server said it was OK to begin STARTTLS negotiations.
|
||||
(if (fboundp 'open-gnutls-stream)
|
||||
(gnutls-negotiate stream nil host)
|
||||
(gnutls-negotiate :process stream :hostname host)
|
||||
(unless (starttls-negotiate stream)
|
||||
(delete-process stream)))
|
||||
(if (memq (process-status stream) '(open run))
|
||||
|
|
|
|||
|
|
@ -492,7 +492,7 @@ This varies according to the value of LINE-LENGTH.
|
|||
This is used to fontify fixed-format Fortran comments."
|
||||
;; This results in a non-byte-compiled function. We could pass it through
|
||||
;; `byte-compile', but simple benchmarks indicate that it's probably not
|
||||
;; worth the trouble (about ½% of slow down).
|
||||
;; worth the trouble (about 0.5% of slow down).
|
||||
(eval ;I hate `eval', but it's hard to avoid it here.
|
||||
`(syntax-propertize-rules
|
||||
("^[cd\\*]" (0 "<"))
|
||||
|
|
|
|||
|
|
@ -800,13 +800,12 @@ Used when `whitespace-style' includes `tabs'."
|
|||
|
||||
|
||||
(defcustom whitespace-trailing-regexp
|
||||
"\\(\\(\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)$"
|
||||
"\\([\t \u00A0]+\\)$"
|
||||
"Specify trailing characters regexp.
|
||||
|
||||
If you're using `mule' package, there may be other characters besides:
|
||||
|
||||
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
|
||||
\"\\xF20\"
|
||||
\" \" \"\\t\" \"\\u00A0\"
|
||||
|
||||
that should be considered blank.
|
||||
|
||||
|
|
@ -1133,7 +1132,7 @@ See also `whitespace-style', `whitespace-newline' and
|
|||
(noninteractive ; running a batch job
|
||||
(setq global-whitespace-mode nil))
|
||||
(global-whitespace-mode ; global-whitespace-mode on
|
||||
(save-excursion
|
||||
(save-current-buffer
|
||||
(add-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
|
||||
(add-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
|
||||
(dolist (buffer (buffer-list)) ; adjust all local mode
|
||||
|
|
@ -1141,7 +1140,7 @@ See also `whitespace-style', `whitespace-newline' and
|
|||
(unless whitespace-mode
|
||||
(whitespace-turn-on-if-enabled)))))
|
||||
(t ; global-whitespace-mode off
|
||||
(save-excursion
|
||||
(save-current-buffer
|
||||
(remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
|
||||
(remove-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
|
||||
(dolist (buffer (buffer-list)) ; adjust all local mode
|
||||
|
|
@ -1526,7 +1525,7 @@ documentation."
|
|||
;; whole buffer
|
||||
(t
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(save-match-data ;FIXME: Why?
|
||||
;; PROBLEM 1: empty lines at bob
|
||||
;; PROBLEM 2: empty lines at eob
|
||||
;; ACTION: remove all empty lines at bob and/or eob
|
||||
|
|
@ -1598,7 +1597,7 @@ documentation."
|
|||
overwrite-mode ; enforce no overwrite
|
||||
tmp)
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(save-match-data ;FIXME: Why?
|
||||
;; PROBLEM 1: 8 or more SPACEs at bol
|
||||
(cond
|
||||
;; ACTION: replace 8 or more SPACEs at bol by TABs, if
|
||||
|
|
@ -1870,7 +1869,7 @@ cleaning up these problems."
|
|||
(interactive "r")
|
||||
(setq force (or current-prefix-arg force))
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(save-match-data ;FIXME: Why?
|
||||
(let* ((has-bogus nil)
|
||||
(rstart (min start end))
|
||||
(rend (max start end))
|
||||
|
|
@ -2412,9 +2411,8 @@ resultant list will be returned."
|
|||
"Match trailing spaces which do not contain the point at end of line."
|
||||
(let ((status t))
|
||||
(while (if (re-search-forward whitespace-trailing-regexp limit t)
|
||||
(save-match-data
|
||||
(= whitespace-point (match-end 1))) ;; loop if point at eol
|
||||
(setq status nil))) ;; end of buffer
|
||||
(= whitespace-point (match-end 1)) ;; Loop if point at eol.
|
||||
(setq status nil))) ;; End of buffer.
|
||||
status))
|
||||
|
||||
|
||||
|
|
@ -2428,9 +2426,7 @@ beginning of buffer."
|
|||
((= b 1)
|
||||
(setq r (and (/= whitespace-point 1)
|
||||
(looking-at whitespace-empty-at-bob-regexp)))
|
||||
(if r
|
||||
(set-marker whitespace-bob-marker (match-end 1))
|
||||
(set-marker whitespace-bob-marker b)))
|
||||
(set-marker whitespace-bob-marker (if r (match-end 1) b)))
|
||||
;; inside bob empty region
|
||||
((<= limit whitespace-bob-marker)
|
||||
(setq r (looking-at whitespace-empty-at-bob-regexp))
|
||||
|
|
@ -2441,9 +2437,7 @@ beginning of buffer."
|
|||
;; intersection with end of bob empty region
|
||||
((<= b whitespace-bob-marker)
|
||||
(setq r (looking-at whitespace-empty-at-bob-regexp))
|
||||
(if r
|
||||
(set-marker whitespace-bob-marker (match-end 1))
|
||||
(set-marker whitespace-bob-marker b)))
|
||||
(set-marker whitespace-bob-marker (if r (match-end 1) b)))
|
||||
;; it is not inside bob empty region
|
||||
(t
|
||||
(setq r nil)))
|
||||
|
|
|
|||
|
|
@ -108,6 +108,12 @@
|
|||
|
||||
* fns.c (Frandom): Let EMACS_UINT be wider than unsigned long.
|
||||
|
||||
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* gnutls.c (Fgnutls_boot): Support :keylist and :crlfiles options
|
||||
instead of :keyfiles. Give GnuTLS the keylist and the CRL lists
|
||||
as passed in.
|
||||
|
||||
2011-05-03 Jan Djärv <jan.h.d@swipnet.se>
|
||||
|
||||
* xterm.c (x_set_frame_alpha): Do not set property on anything
|
||||
|
|
|
|||
65
src/gnutls.c
65
src/gnutls.c
|
|
@ -44,7 +44,8 @@ static int gnutls_global_initialized;
|
|||
/* The following are for the property list of `gnutls-boot'. */
|
||||
static Lisp_Object Qgnutls_bootprop_priority;
|
||||
static Lisp_Object Qgnutls_bootprop_trustfiles;
|
||||
static Lisp_Object Qgnutls_bootprop_keyfiles;
|
||||
static Lisp_Object Qgnutls_bootprop_keylist;
|
||||
static Lisp_Object Qgnutls_bootprop_crlfiles;
|
||||
static Lisp_Object Qgnutls_bootprop_callbacks;
|
||||
static Lisp_Object Qgnutls_bootprop_loglevel;
|
||||
static Lisp_Object Qgnutls_bootprop_hostname;
|
||||
|
|
@ -412,7 +413,10 @@ PROPLIST is a property list with the following keys:
|
|||
|
||||
:trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
|
||||
|
||||
:keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
|
||||
:crlfiles is a list of PEM-encoded CRL lists for `gnutls-x509pki'.
|
||||
|
||||
:keylist is an alist of PEM-encoded key files and PEM-encoded
|
||||
certificates for `gnutls-x509pki'.
|
||||
|
||||
:callbacks is an alist of callback functions, see below.
|
||||
|
||||
|
|
@ -471,7 +475,8 @@ one trustfile (usually a CA bundle). */)
|
|||
/* Placeholders for the property list elements. */
|
||||
Lisp_Object priority_string;
|
||||
Lisp_Object trustfiles;
|
||||
Lisp_Object keyfiles;
|
||||
Lisp_Object crlfiles;
|
||||
Lisp_Object keylist;
|
||||
/* Lisp_Object callbacks; */
|
||||
Lisp_Object loglevel;
|
||||
Lisp_Object hostname;
|
||||
|
|
@ -486,7 +491,8 @@ one trustfile (usually a CA bundle). */)
|
|||
hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname);
|
||||
priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
|
||||
trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
|
||||
keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
|
||||
keylist = Fplist_get (proplist, Qgnutls_bootprop_keylist);
|
||||
crlfiles = Fplist_get (proplist, Qgnutls_bootprop_crlfiles);
|
||||
/* callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks); */
|
||||
loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
|
||||
verify_flags = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
|
||||
|
|
@ -614,15 +620,41 @@ one trustfile (usually a CA bundle). */)
|
|||
}
|
||||
}
|
||||
|
||||
for (tail = keyfiles; !NILP (tail); tail = Fcdr (tail))
|
||||
for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
|
||||
{
|
||||
Lisp_Object keyfile = Fcar (tail);
|
||||
if (STRINGP (keyfile))
|
||||
Lisp_Object crlfile = Fcar (tail);
|
||||
if (STRINGP (crlfile))
|
||||
{
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ",
|
||||
SSDATA (keyfile));
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
|
||||
SSDATA (crlfile));
|
||||
ret = gnutls_certificate_set_x509_crl_file
|
||||
(x509_cred,
|
||||
SSDATA (crlfile),
|
||||
file_format);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("Sorry, GnuTLS can't use non-string CRL file %s",
|
||||
SDATA (crlfile));
|
||||
}
|
||||
}
|
||||
|
||||
for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
|
||||
{
|
||||
Lisp_Object keyfile = Fcar (Fcar (tail));
|
||||
Lisp_Object certfile = Fcar (Fcdr (tail));
|
||||
if (STRINGP (keyfile) && STRINGP (certfile))
|
||||
{
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
|
||||
SSDATA (keyfile));
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
|
||||
SSDATA (certfile));
|
||||
ret = gnutls_certificate_set_x509_key_file
|
||||
(x509_cred,
|
||||
SSDATA (certfile),
|
||||
SSDATA (keyfile),
|
||||
file_format);
|
||||
|
||||
|
|
@ -631,8 +663,12 @@ one trustfile (usually a CA bundle). */)
|
|||
}
|
||||
else
|
||||
{
|
||||
error ("Sorry, GnuTLS can't use non-string keyfile %s",
|
||||
SDATA (keyfile));
|
||||
if (STRINGP (keyfile))
|
||||
error ("Sorry, GnuTLS can't use non-string client cert file %s",
|
||||
SDATA (certfile));
|
||||
else
|
||||
error ("Sorry, GnuTLS can't use non-string client key file %s",
|
||||
SDATA (keyfile));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -868,8 +904,11 @@ syms_of_gnutls (void)
|
|||
Qgnutls_bootprop_trustfiles = intern_c_string (":trustfiles");
|
||||
staticpro (&Qgnutls_bootprop_trustfiles);
|
||||
|
||||
Qgnutls_bootprop_keyfiles = intern_c_string (":keyfiles");
|
||||
staticpro (&Qgnutls_bootprop_keyfiles);
|
||||
Qgnutls_bootprop_keylist = intern_c_string (":keylist");
|
||||
staticpro (&Qgnutls_bootprop_keylist);
|
||||
|
||||
Qgnutls_bootprop_crlfiles = intern_c_string (":crlfiles");
|
||||
staticpro (&Qgnutls_bootprop_crlfiles);
|
||||
|
||||
Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
|
||||
staticpro (&Qgnutls_bootprop_callbacks);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue