(require 'cl-lib)
(defgroup x509 nil
"View certificates, CRLs, keys and other related files using OpenSSL."
:group 'extensions
:group 'convenience
:link '(emacs-library-link :tag "Lisp File" "x509-mode.el"))
(defcustom x509-openssl-cmd
(if (eq system-type 'windows-nt)
"C:/Program Files/Git/mingw64/bin/openssl.exe"
"openssl")
"Path to OpenSSL binary.
Example:
\"/usr/bin/openssl\" or just \"openssl\" on Linux
\"C:/Program Files/Git/mingw64/bin/openssl\" on Windows."
:type 'string
:group 'x509)
(defcustom x509-x509-default-arg
"x509 -text -noout -nameopt utf8 -nameopt multiline"
"Default arguments for \"openssl x509\" command."
:type 'string
:group 'x509)
(defcustom x509-req-default-arg
"req -text -noout -nameopt utf8 -nameopt multiline"
"Default arguments for \"openssl req\" command."
:type 'string
:group 'x509)
(defcustom x509-crl-default-arg
"crl -text -noout -nameopt utf8 -nameopt multiline"
"Default arguments for \"openssl crl\" command."
:type 'string
:group 'x509)
(defcustom x509-pkcs7-default-arg "pkcs7 -noout -text -print_certs"
"Default arguments for \"openssl pkcs7\" command."
:type 'string
:group 'x509)
(defcustom x509-dhparam-default-arg "dhparam -text -noout"
"Default arguments for \"openssl dhparam\" command."
:type 'string
:group 'x509)
(defcustom x509-pkey-default-arg "pkey -text -noout"
"Default arguments for \"openssl pkey\" command."
:type 'string
:group 'x509)
(defcustom x509-pkey-pubin-default-arg "pkey -text -noout -pubin"
"Default arguments for \"openssl pkey -pubin\" command."
:type 'string
:group 'x509)
(defcustom x509-asn1parse-default-arg "asn1parse"
"Default arguments for \"openssl asn1parse\" command."
:type 'string
:group 'x509)
(defgroup x509-faces nil
"Faces used by x509."
:group 'x509
:group 'faces)
(defface x509-keyword-face '((t (:inherit font-lock-builtin-face)))
"Face for keywords."
:group 'x509-faces)
(defface x509-constant-face '((t (:inherit font-lock-constant-face)))
"Face for constants."
:group 'x509-faces)
(defface x509-short-name-face '((t (:bold t)))
"Face for short names, e.g, CN and OU."
:group 'x509-faces)
(defface x509-string-face '((t (:inherit font-lock-string-face)))
"Face for strings."
:group 'x509-faces)
(defface x509-hex-string-face '((t (:inherit font-lock-comment-face)))
"Face for colon-separated hex values."
:group 'x509-faces)
(defface x509-oid-link-face '((t (:inherit (link font-lock-constant-face))))
"Face for OID buttons."
:group 'x509-faces)
(defface x509-oid-face '((t (:inherit font-lock-constant-face)))
"Face for symbolic, known, OIDs."
:group 'x509-faces)
(defface x509-asn1-sequence-face
'((t (:inherit font-lock-regexp-grouping-backslash)))
"Face for ASN.1 sequences."
:group 'x509-faces)
(defface x509-warning-face
'((t (:inherit font-lock-warning-face :inverse-video t)))
"Face for bad values."
:group 'x509-faces)
(defface x509-near-warning-face
'((t (:inherit font-lock-function-name-face :inverse-video nil)))
"Face for near expire date/time values."
:group 'x509-faces)
(defface x509-browse-url-face '((t (:inherit link)))
"Face for clickable URL links.")
(defface x509-asn1-hexl-header '((t (:inherit highlight :underline t)))
"Face for highlighting ASN.1 header in hexl buffer in `x509-asn1-mode'."
:group 'x509-faces)
(defface x509-asn1-hexl-value '((t (:inherit region)))
"Face for highlighting ASN.1 value in hexl buffer in `x509-asn1-mode'."
:group 'x509-faces)
(defun x509--match-date (cmp bound)
"Return non-nil if it can find a date that CMP to current time.
Intended to search for dates in form \"Jun 11 00:00:01 2014 GMT\"
and compare them to the current time. Return non-nil, move point,
and set ‘match-data’ appropriately if it succeeds; like
‘re-search-forward’ would. The argument BOUND is a buffer
position that bounds the search."
(let ((mdata (match-data))
(p (point)))
(if (re-search-forward "[A-Z][a-z][a-z] +[0-9]+ ..:..:.. [0-9]\\{4\\} GMT"
bound
t)
(if (condition-case nil
(funcall cmp
(date-to-time (match-string-no-properties 0))
(current-time))
(error nil))
t
(goto-char p)
(set-match-data mdata)
nil)
nil)))
(defun x509--match-date-in-past (bound)
"Return non-nil if it can find a date that is the past.
Intended to search for dates in form \"Jun 11 00:00:01 2014 GMT\"
and compare them to the current time. Return non-nil, move point,
and set ‘match-data’ appropriately if it succeeds; like
‘re-search-forward’ would. The optional argument BOUND is a
buffer position that bounds the search."
(x509--match-date (lambda (d1 d2) (time-less-p d1 d2)) bound))
(defun x509--match-date-in-future (bound)
"Return non-nil if it can find a date that is the future.
Intended to search for dates in form \"Jun 11 00:00:01 2014 GMT\"
and compare them to the current time. Return non-nil, move point,
and set ‘match-data’ appropriately if it succeeds; like
‘re-search-forward’ would. The optional argument BOUND is a
buffer position that bounds the search."
(x509--match-date (lambda (d1 d2) (not (time-less-p d1 d2))) bound))
(defcustom x509-warn-near-expire-days 30
"Warn certificate expiration if time is near.
Set to nil to inhibit warning."
:type 'integer
:group 'x509)
(defcustom x509-query-oid-url-format "https://oid-rep.orange-labs.fr/get/%s"
"A format string for constructing URL for querying OIDs.
Used with `(format x509-query-oid-url-format oid)'"
:type 'string
:group 'x509)
(defun x509--match-date-near-now (bound)
"Return non-nil it can find a date that is \"near\" in the future.
\"Near\" is defined by `x509-warn-near-expire-days'.
Intended to search for dates in form \"Jun 11 00:00:01 2014 GMT\"
and compare them to the current time. Return non-nil, move point,
and set ‘match-data’ appropriately if it succeeds; like
‘re-search-forward’ would. The optional argument BOUND is a
buffer position that bounds the search."
(x509--match-date
(lambda (time now)
(and x509-warn-near-expire-days
(time-less-p now time)
(time-less-p
time (time-add now (* x509-warn-near-expire-days 24 60 60)))))
bound))
(defun x509--mark-browse-url-links (regex face compose-url-fn)
"Make URLs clickable by making them buttons.
REGEX is used to find and delimit button.
FACE is the face to apply to the button.
COMPOSE-URL-FN is a function that takes a string and returns an URL.
For simple cases, COMPOSE-URL-FN returns its argument unchanged."
(save-excursion
(save-match-data
(goto-char (point-min))
(while (search-forward-regexp regex nil t)
(let* ((start (match-beginning 0))
(end (match-end 0))
(url (funcall compose-url-fn (match-string-no-properties 0)))
(help-echo (format "Click to browse-url %s" url)))
(make-button start end
'face
face
'follow-link
t
'url
url
'help-echo
help-echo
'action
(lambda (button)
(browse-url (button-get button 'url)))))))))
(defun x509--mark-browse-http-links ()
"Make http URLs clickable by making them buttons."
(x509--mark-browse-url-links
"\\(file\\|https?\\)://[-_.:/A-Za-z0-9]+"
'x509-browse-url-face
(lambda (url) url)))
(defun x509--mark-browse-oid ()
"Make OIDs clickable by making them buttons."
(x509--mark-browse-url-links
"\\(?:[0-9]+\\.\\)\\{3,\\}[0-9]+" 'x509-oid-link-face
(lambda (oid)
(format x509-query-oid-url-format oid))))
(eval-when-compile
(defun x509--load-data-file (filename)
"Split FILENAME linewise into a list.
Skip blank lines and comment lines. Return list."
(with-temp-buffer
(insert-file-contents
(if (null load-file-name)
filename
(expand-file-name filename (file-name-directory load-file-name))))
(cl-remove-if
(lambda (s) (string-match-p "^ *\\(?:#\\|$\\)" s))
(split-string (buffer-string) "\n")))))
(eval-when-compile
(defconst x509--keywords (regexp-opt (x509--load-data-file "keywords.txt"))))
(eval-when-compile
(defconst x509--constants
(regexp-opt (x509--load-data-file "constants.txt") 'words)))
(eval-when-compile
(defconst x509--keyword-w-constant
(concat
(regexp-opt (x509--load-data-file "keyword+constant.txt") t)
": *\\(.*\\)")))
(eval-when-compile
(defconst x509--multiline-name
(concat
(regexp-opt (x509--load-data-file "long-name.txt") t) " *= \\(.*\\)")))
(defconst x509-font-lock-keywords
(eval-when-compile
(list
`(,x509--multiline-name (1 'x509-keyword-face) (2 'x509-string-face))
`(,x509--keywords . 'x509-keyword-face)
`(,x509--constants . 'x509-constant-face)
'("^ +Validity ?$" . 'x509-keyword-face)
'("\\(\\<\\w+=\\)\\(.*?\\)\\(?:[,/]\\|$\\)"
(1 'x509-short-name-face)
(2 'x509-string-face))
'("\\(\\<\\w+\\) = \\(.*?\\)\\(?:[,/]\\|$\\)"
(1 'x509-short-name-face)
(2 'x509-string-face))
'("\\<\\(URI:\\|CPS: \\)" (1 'x509-keyword-face))
'("\\<\\(DNS:\\|email:\\|othername:\\)\\(.*?\\)\\(?:,\\|$\\)"
(1 'x509-keyword-face)
(2 'x509-string-face))
'("\\(Not Before\\): "
(1 'x509-keyword-face)
(x509--match-date-in-future nil nil (0 'x509-warning-face)))
'("\\(Not After\\) : "
(1 'x509-keyword-face)
(x509--match-date-in-past nil nil (0 'x509-warning-face))
(x509--match-date-near-now nil nil (0 'x509-near-warning-face)))
'("\\(Next Update\\): "
(1 'x509-keyword-face)
(x509--match-date-in-past nil nil (0 'x509-warning-face)))
'("\\(Policy\\): \\([0-9]+\\.[0-9]+\\(:?\\.[0-9]+\\)*\\)"
(1 'x509-keyword-face)
(2 'x509-oid-face))
`(,x509--keyword-w-constant
(1 'x509-keyword-face) (2 'x509-constant-face))
'("\\(CA\\):\\(TRUE\\|FALSE\\)"
(1 'x509-keyword-face)
(2 'x509-constant-face))
'("[0-9a-fA-F][0-9a-fA-F]\\(?::[0-9a-fA-F][0-9a-fA-F]\\)+:?$"
.
'x509-hex-string-face)))
"OpenSSL x509 highlighting.")
(defun x509-mode--kill-buffer ()
"Kill current buffer."
(interactive)
(set-buffer-modified-p nil)
(kill-buffer))
(define-derived-mode
x509-mode
fundamental-mode
"x509"
"Major mode for displaying OpenSSL output.
\\{x509-mode-map}"
(set (make-local-variable 'font-lock-defaults) '(x509-font-lock-keywords t))
(define-key x509-mode-map "q" 'x509-mode--kill-buffer)
(define-key x509-mode-map "t" 'x509--toggle-mode)
(define-key x509-mode-map "e" 'x509--edit-params)
(x509--mark-browse-http-links)
(x509--mark-browse-oid))
(defun x509--buffer-encoding (buffer)
"Heuristic for identifying PEM or DER encoding in BUFFER.
Return string \"PEM\" or \"DER\"."
(with-current-buffer buffer
(goto-char (point-min))
(save-match-data
(if (search-forward "-----BEGIN" nil t)
"PEM"
"DER"))))
(defun x509--pem-region ()
"Determine if point is in region delimited by \"-----BEGIN\" \"-----END\".
Return (begin . end) or nil"
(save-excursion
(save-match-data
(let ((here (point)))
(if (or (looking-at "-----BEGIN \\(.*?\\)-----")
(re-search-backward "-----BEGIN \\(.*?\\)-----" nil t))
(let ((begin (match-beginning 0))
(type (match-string-no-properties 1)))
(if (and (search-forward (concat "-----END " type "-----") nil t)
(< here (match-end 0)))
(cons begin (match-end 0)))))))))
(defun x509--pem-region-type ()
"Return type of pem region or nil if not matched.
Ex \"CERTIFICATE\" or \"DH PARAMETERS\""
(let ((region (x509--pem-region)))
(if region
(save-excursion
(save-match-data
(goto-char (car region))
(if (re-search-forward "-----BEGIN \\(.*?\\)-----" (cdr region) t)
(match-string-no-properties 1)))))))
(defun x509--generate-input-buffer ()
"Return a buffer containing data to be processed by OpenSSL.
Determine what portion of the current buffer is interesting to pass to
OpenSSL.
If point is in region delimited by \"-----BEGIN\" \"-----END\"
then that region is selected. The region is trimmed so that
leading and trailing non base-64 characters on each line are
removed. The idea is to be able to view, for example, a
certificate that is embedded as string in code.
If point is not in a PEM region, the whole buffer is used."
(let* ((region (x509--pem-region))
(begin
(if region
(car region)
(point-min)))
(end
(if region
(cdr region)
(point-max)))
(data
(if region
(buffer-substring-no-properties begin end)))
(src-buffer (current-buffer))
(new-buf
(generate-new-buffer
(generate-new-buffer-name (format " *in-x-%s*" (buffer-name))))))
(with-current-buffer new-buf
(set-buffer-file-coding-system 'no-conversion)
(if data
(insert data)
(insert-buffer-substring-no-properties src-buffer))
(when region
(goto-char (point-min))
(while (re-search-forward "^[^-A-Za-z0-9+=/]+\\|[^-A-Za-z0-9+=/]+$"
nil
t)
(replace-match "" nil nil))
(goto-char (point-min))
(while (re-search-forward "\\\\n$" nil t)
(replace-match "" nil nil)))
new-buf)))
(defmacro x509-defvar-local-persistent (var-name docstring)
"Define a buffer-local variable VAR-NAME with DOCSTRING.
Make it persist during major mode change."
`(progn
(defvar-local ,var-name nil
,docstring)
(put ',var-name 'permanent-local t)))
(x509-defvar-local-persistent
x509--shadow-buffer "Input buffer used for OpenSSL command.")
(x509-defvar-local-persistent
x509--x509-mode-shadow-arguments
"Current OpenSSL command arguments used in `x509-mode'.")
(x509-defvar-local-persistent
x509--x509-asn1-mode-shadow-arguments
"Current OpenSSL command argument used in `x509-asn1-mode'.")
(x509-defvar-local-persistent
x509--x509-asn1-mode-offset-stack
"Stack of (command start header-len pos) for strparse/offset.
In `x509-asn1-mod'.
POS is the buffer position when going down. Used to restore pos
when going back up.")
(x509-defvar-local-persistent
x509-asn1--last-point
"Used to detect when the point has moved.
For updating overlay in hexl buffer.")
(x509-defvar-local-persistent
x509-asn1--hexl-buffer
"Hexl buffer that follows current line in `x509-asn1-mode'.")
(x509-defvar-local-persistent
x509-asn1--hexl-overlays "Current overlays in hexl buffer.")
(defun x509--kill-shadow-buffer ()
"Kill buffer hook function.
Run when killing a view buffer for cleaning up associated input buffer.
Also kill any hexl buffer."
(when (and (boundp 'x509--shadow-buffer) (buffer-live-p x509--shadow-buffer))
(kill-buffer x509--shadow-buffer))
(when (and (boundp 'x509-asn1--hexl-buffer)
(buffer-live-p x509-asn1--hexl-buffer))
(kill-buffer x509-asn1--hexl-buffer)))
(defun x509--process-buffer
(input-buf openssl-arguments &optional output-buf no-hooks)
"Create new buffer named \"*x-[buffer-name]*\".
Pass content INPUT-BUF to openssl with
OPENSSL-ARGUMENTS. E.g. x509 -text. If OUTPUT-BUF is non-'nil',
out to that buffer instead of generating a new one.
When NO-HOOKS is not nil, `kill-buffer-hook' and
`x509--shadow-buffer' are not set. Can be used when decoding
base64 and result buffer does not need special hooks or
variables. NO-HOOKS also ensures that process output isn't
decoded, i.e. data is inserted into buffer as binary.
Return output buffer."
(interactive)
(let* ((buf
(or output-buf
(generate-new-buffer
(generate-new-buffer-name (format "*x-%s*" (buffer-name))))))
(args
(append
(list nil nil x509-openssl-cmd nil buf nil) openssl-arguments)))
(with-current-buffer buf
(setq buffer-read-only nil)
(erase-buffer)
(unless no-hooks
(setq x509--shadow-buffer input-buf)
(add-hook 'kill-buffer-hook 'x509--kill-shadow-buffer nil t))
(with-current-buffer input-buf
(if no-hooks
(let ((coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion))
(apply 'call-process-region args))
(apply 'call-process-region args)))
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t))
buf))
(defun x509--read-arguments (prompt default history)
"Prompt, using PROMPT, for arguments if \\[universal-argument] prefix.
Provide DEFAULT argument and HISTORY.
Return argument string."
(let ((history-delete-duplicates t))
(if (equal current-prefix-arg '(4))
(read-from-minibuffer prompt default nil nil history)
(progn
(add-to-history history default)
default))))
(defun x509--add-inform-spec (arguments encoding)
"Add or modify \"-inform ENCODING\" in ARGUMENTS."
(if (string-match "-inform \\(PEM\\|DER\\)" arguments)
(replace-match encoding nil nil arguments 1)
(format "%s -inform %s" arguments encoding)))
(defun x509--generic-view (default history mode &optional input-buf output-buf)
"Prepare an input buffer for data to be processed.
Optionally get modified command arguments from user.
Process data from input buffer using command arguments.
DEFAULT is the initial command line arguments to OpenSSL.
HISTORY is the command history symbol used with
`read-from-minibuffer'. MODE is the major mode that will be
applied to the result buffer. If INPUT-BUF is non-'nil', use
existing input buffer instead of creating one. If OUTPUT-BUF is
non-'nil', use that instead of creating a new one.
Switch to resulting buffer and return it."
(let* ((in-buf (or input-buf (x509--generate-input-buffer)))
(encoding (x509--buffer-encoding in-buf))
(initial (x509--add-inform-spec default encoding))
(args (x509--read-arguments "arguments: " initial history))
(result-buffer
(x509--process-buffer in-buf (split-string-and-unquote args)
output-buf)))
(switch-to-buffer result-buffer)
(if (eq mode 'x509-mode)
(setq x509--x509-mode-shadow-arguments args)
(setq x509--x509-asn1-mode-shadow-arguments args))
(funcall mode)
(when (bound-and-true-p x509-asn1--hexl-buffer)
(add-hook 'post-command-hook #'x509-asn1--post-command-hook nil t)
(setq x509-asn1--last-point nil))
result-buffer))
(defun x509--get-x509-toggle-mode-args ()
"Ask user for command and return default arguments for that command."
(let* ((collection
'(("cert" . x509-x509-default-arg)
("req" . x509-req-default-arg)
("crl" . x509-crl-default-arg)
("pkcs7" . x509-pkcs7-default-arg)
("dhparam" . x509-dhparam-default-arg)
("key" . x509-pkey-default-arg)
("publickey" . x509-pkey-pubin-default-arg)
("asn1parse" . x509-asn1parse-default-arg)))
(choice
(completing-read
"Parse as: " collection nil t )))
(symbol-value (cdr (assoc choice collection)))))
(defun x509--get-x509-history (args)
"Return history variable that matches command ARGS."
(pcase (car (split-string-and-unquote args))
("x509" 'x509--viewcert-history)
("req" 'x509--viewreq-history)
("crl" 'x509--viewcrl-history)
("pkcs7" 'x509--viewpkcs7-history)
("dhparam" 'x509--viewdh-history)
("pkey" (if (string-match-p "-pubin" args)
'x509--viewpublickey-history
'x509--viewkey-history))
("asn1parse" 'x509--viewasn1-history)
(_ nil)))
(defun x509--toggle-mode (&optional edit)
"Toggle between asn1-mode and `x509-mode'.
If EDIT is non-'nil', edit current command arguments and redisplay."
(interactive)
(if edit
(setq current-prefix-arg '(4)))
(if (or (and edit (derived-mode-p 'x509-asn1-mode)) (and (not edit) (derived-mode-p 'x509-mode))) (let ((default-args
(or x509--x509-asn1-mode-shadow-arguments
x509-asn1parse-default-arg)))
(x509--generic-view
default-args 'x509--viewasn1-history 'x509-asn1-mode
x509--shadow-buffer (current-buffer)))
(let* ((default-args
(or x509--x509-mode-shadow-arguments
(x509--get-x509-toggle-mode-args)))
(history (x509--get-x509-history default-args)))
(x509--generic-view default-args history 'x509-mode
x509--shadow-buffer
(current-buffer)))))
(defun x509--edit-params ()
"Edit command parameters in current buffer."
(interactive)
(x509--toggle-mode t))
(defvar x509--viewcert-history nil
"History list for `x509-viewcert'.")
(defun x509-viewcert ()
"Parse current buffer as a certificate file.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view
x509-x509-default-arg 'x509--viewcert-history 'x509-mode))
(defvar x509--viewreq-history nil
"History list for `x509-viewreq'.")
(defun x509-viewreq ()
"Parse current buffer as a certificate request file.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view x509-req-default-arg 'x509--viewreq-history 'x509-mode))
(defvar x509--viewcrl-history nil
"History list for `x509-viewcrl'.")
(defun x509-viewcrl ()
"Parse current buffer as a CRL file.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view x509-crl-default-arg 'x509--viewcrl-history 'x509-mode))
(defvar x509--viewpkcs7-history nil
"History list for `x509-viewpkcs7'.")
(defun x509-viewpkcs7 ()
"Parse current buffer as a PKCS#7 file.
Output only certificates and CRLs by default. Add the \"-print\"
switch to output details.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view
x509-pkcs7-default-arg 'x509--viewpkcs7-history 'x509-mode))
(defvar x509--viewdh-history nil
"History list for `x509-viewdh'.")
(defun x509-viewdh ()
"Parse current buffer as a DH-parameter file.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view
x509-dhparam-default-arg 'x509--viewdh-history 'x509-mode))
(defvar x509--viewkey-history nil
"History list for `x509-viewkey'.")
(defun x509-viewkey ()
"Display x509 private key using the OpenSSL pkey command.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view x509-pkey-default-arg 'x509--viewkey-history 'x509-mode))
(defvar x509--viewpublickey-history nil
"History list for `x509-publicviewkey'.")
(defun x509-viewpublickey ()
"Display x509 public key using the OpenSSL pkey command.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view
x509-pkey-pubin-default-arg 'x509--viewpublickey-history 'x509-mode))
(defvar x509--viewlegacykey-history nil
"History list for `x509-viewlegacykey'.")
(defun x509-viewlegacykey (&optional args)
"Display x509 private key using the OpenSSL pkey command.
This function works with older OpenSSL that could not read key from
stdin. Instead, the buffer file is used with -in.
ARGS are arguments to the openssl command.
With \\[universal-argument] prefix, you can edit the command arguments.
For example to enter pass-phrase, add -passin pass:PASSPHRASE."
(interactive (list
(x509--read-arguments
"pkey args: "
(format "%s -inform %s -in \"%s\""
x509-pkey-default-arg
(x509--buffer-encoding (current-buffer))
(buffer-file-name))
'x509--viewlegacykey-history)))
(let* ((buf
(generate-new-buffer
(generate-new-buffer-name (format "*x-%s*" (buffer-name))))))
(setq args
(append
(list x509-openssl-cmd nil buf nil)
(split-string-and-unquote args)))
(apply 'call-process args)
(switch-to-buffer buf)
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(x509-mode)))
(defun x509--dwim-tester (openssl-commamd-args)
"Test running OPENSSL-COMMAMD-ARGS in current buffer.
Return t if return status is 0, otherwise nil. Use to determine
if the buffer contains data of certain type."
(let* ((in-buf (x509--generate-input-buffer))
(encoding (x509--buffer-encoding in-buf))
(args (x509--add-inform-spec openssl-commamd-args encoding))
(proc-args
(append
(list nil nil x509-openssl-cmd nil nil nil)
(split-string-and-unquote args))))
(prog1 (= 0
(with-current-buffer in-buf
(apply 'call-process-region proc-args)))
(kill-buffer in-buf))))
(defun x509-dwim ()
"Guess the type of object and call the corresponding view-function.
Look at -----BEGIN header for known object types. Then test
different openssl commands until one succeeds. Call
`x509-viewasn1' as a last resort."
(interactive)
(pcase (x509--pem-region-type)
((or "CERTIFICATE" "TRUSTED CERTIFICATE")
(call-interactively 'x509-viewcert))
("CERTIFICATE REQUEST" (call-interactively 'x509-viewreq))
("DH PARAMETERS" (call-interactively 'x509-viewdh))
("PKCS7" (call-interactively 'x509-viewpkcs7))
((or "ENCRYPTED PRIVATE KEY" "PRIVATE KEY" "RSA PRIVATE KEY")
(call-interactively 'x509-viewkey))
("PUBLIC KEY" (call-interactively 'x509-viewpublickey))
("X509 CRL" (call-interactively 'x509-viewcrl))
(_
(cond
((x509--dwim-tester x509-x509-default-arg)
(call-interactively 'x509-viewcert))
((x509--dwim-tester x509-crl-default-arg)
(call-interactively 'x509-viewcrl))
((x509--dwim-tester x509-pkey-default-arg)
(call-interactively 'x509-viewkey))
((x509--dwim-tester x509-pkey-pubin-default-arg)
(call-interactively 'x509-viewpublickey))
((x509--dwim-tester x509-req-default-arg)
(call-interactively 'x509-viewreq))
((x509--dwim-tester x509-dhparam-default-arg)
(call-interactively 'x509-viewdh))
((x509--dwim-tester x509-pkcs7-default-arg)
(call-interactively 'x509-viewpkcs7))
(t
(call-interactively 'x509-viewasn1))))))
(defun x509--asn1-get-offset ()
"Return offset at current ASN.1 line.
Ex ^ 63:d=1 hl=2 l= 34
-> 63"
(save-excursion
(move-beginning-of-line 1)
(if (re-search-forward "^ *\\([0-9]+\\):d=[0-9]+ *hl=\\([0-9]+\\)"
(line-end-position)
t)
(string-to-number (match-string-no-properties 1))
0)))
(defun x509--asn1-get-total-length ()
"Return header length + data length on current ASN.1 line.
Ex ^ 63:d=1 hl=2 l= 34
-> 2 + 34 = 36"
(save-excursion
(move-beginning-of-line 1)
(if (re-search-forward (concat
"^ *\\([0-9]+\\):d=[0-9]+ *hl=\\([0-9]+\\) "
"*l= *\\(?:\\([0-9]+\\)\\|\\(inf\\)\\)")
(line-end-position) t)
(let* ((hl (string-to-number (match-string-no-properties 2)))
(len-str (match-string-no-properties 3))
(len
(if len-str
(string-to-number len-str)
0)))
(+ hl len))
0)))
(defun x509--asn1-get-header-len ()
"Return header length at current ASN.1 line.
Ex ^ 63:d=1 hl=2 l= 34
-> 2
If current line is a BITSTRING, we add 1 to the header length to
account for the unused-bits byte."
(save-excursion
(move-beginning-of-line 1)
(if (re-search-forward "^ *\\([0-9]+\\):d=[0-9]+ *hl=\\([0-9]+\\)"
(line-end-position)
t)
(let ((hl (string-to-number (match-string-no-properties 2)))
(add-one
(if (re-search-forward "BIT STRING" (line-end-position) t)
1
0)))
(+ hl add-one))
0)))
(defun x509--asn1-update-command-line-start-arg (arguments command start)
"Add, modify or remove -offset N or -strparse N argument in ARGUMENTS.
COMMAND is either \"-offset\" or \"strparse\".
START is the new N, can be 0.
Return updated argument string."
(if (= start 0)
(if (string-match " *\\(?:-offset\\|-strparse\\) [0-9]+" arguments)
(replace-match "" nil nil arguments 0)
arguments)
(if (string-match "\\(?:-offset\\|-strparse\\) [0-9]+" arguments)
(replace-match (concat command " " (number-to-string start))
nil
nil
arguments
0)
(format "%s %s %s" arguments command start))))
(defvar x509--asn1-mode-name "asn1"
"Major mode name displayed in mode line.")
(defun x509--asn1-update-mode-line ()
"Update command line mode name."
(let* ((top (car x509--x509-asn1-mode-offset-stack))
(command
(if top
(if (string= (nth 0 top) "-strparse")
"s"
"o")))
(offset
(if top
(nth 1 top)))
new-mode-name)
(if offset
(setq new-mode-name
(format "%s[%s%s]" x509--asn1-mode-name command offset))
(setq new-mode-name x509--asn1-mode-name))
(when (not (string= mode-name new-mode-name))
(setq mode-name new-mode-name)
(force-mode-line-update))))
(defun x509--asn1-get-absolute-offset ()
"Calculate offset at line adding current -offset or -strparse."
(let* ((line-offset (x509--asn1-get-offset))
(top (car x509--x509-asn1-mode-offset-stack))
(strparsep
(if top
(string= (nth 0 top) "-strparse")))
(current-offset
(if top
(+ (nth 1 top)
(if strparsep
(nth 2 top)
0))
0)))
(+ line-offset current-offset)))
(defun x509--asn1-offset-strparse (command)
"Add -offset N or -strparse N to command line and redisplay.
COMMAND must be either \"-offset\" or \"-strparse\".
When \"-offset\", N i set to current offset + offset on line + header length.
When \"-strparse\", N i set to current offset + offset on line.
Mileage may vary if mixing calls to strparse and offset. We try
to get it right but it can get confusing."
(let* ((line-offset (x509--asn1-get-offset))
(header-len (x509--asn1-get-header-len))
(strparsep (string= command "-strparse"))
(add-header
(if strparsep
0
header-len))
(top (car x509--x509-asn1-mode-offset-stack))
(current-offset
(if top
(+ (nth 1 top)
(if strparsep
(nth 2 top)
0))
0))
(new-offset (+ current-offset line-offset add-header))
(new-args
(x509--asn1-update-command-line-start-arg
(or x509--x509-asn1-mode-shadow-arguments
x509-asn1parse-default-arg)
command new-offset)))
(if (> new-offset 0)
(push (list command new-offset header-len (point))
x509--x509-asn1-mode-offset-stack))
(x509--generic-view new-args 'x509--viewasn1-history 'x509-asn1-mode
x509--shadow-buffer
(current-buffer))
(x509--asn1-update-mode-line)))
(defun x509--asn1-offset-down ()
"Add -offset N argument to current asn1 command line and redisplay.
Offset is calculated from offset on current line."
(interactive)
(x509--asn1-offset-strparse "-offset"))
(defun x509--asn1-strparse ()
"Add -strparse N argument to current asn1 command line and redisplay.
Offset is calculated from offset on current line."
(interactive)
(x509--asn1-offset-strparse "-strparse"))
(defun x509--asn1-offset-up ()
"Pop offset and redisplay."
(interactive)
(when (and (boundp 'x509--x509-asn1-mode-offset-stack)
x509--x509-asn1-mode-offset-stack)
(let* ((current (pop x509--x509-asn1-mode-offset-stack))
(point (nth 3 current))
(up (car x509--x509-asn1-mode-offset-stack))
(command
(if up
(nth 0 up)
"none"))
(offset
(if up
(nth 1 up)
0))
(new-args
(x509--asn1-update-command-line-start-arg
(or x509--x509-asn1-mode-shadow-arguments
x509-asn1parse-default-arg)
command offset)))
(x509--generic-view new-args 'x509--viewasn1-history 'x509-asn1-mode
x509--shadow-buffer
(current-buffer))
(goto-char point)
(x509--asn1-update-mode-line))))
(defun x509-asn1--remove-overlays ()
"Clean up hexl buffer overlays."
(mapc #'delete-overlay x509-asn1--hexl-overlays)
(setq x509-asn1--hexl-overlays nil))
(defun x509-asn1--setup-overlay (start end buf face)
"Setup overlay with START and END in BUF.
Use FACE."
(let ((overlay (make-overlay start end buf)))
(overlay-put overlay 'face face)
overlay))
(defun x509-asn1--hexl-offset-start (offset)
"Return buffer point where byte at OFFSET start in a `hexl-mode' buffer."
(let* ((lines (/ offset 16))
(addresses (* 10 (+ 1 lines)))
(trailers (* 18 lines))
(spaces (/ offset 2))
(bytes (* offset 2)))
(+ 1 addresses trailers spaces bytes)))
(defun x509-asn1--hexl-char-offset-start (offset)
"Return buffer point where char at OFFSET start in a `hexl-mode' buffer."
(let* ((lines (/ offset 16))
(addresses (* 10 (+ 1 lines)))
(bytes (* 41 (+ 1 lines)))
(char-blocks (* lines 17))
(chars (mod offset 16)))
(+ 1 addresses bytes char-blocks chars)))
(defun x509-asn1--hexl-offset-end (offset)
"Return buffer point where OFFSET ends in a `hexl-mode' buffer."
(let* ((lines (/ offset 16))
(even-sixteen (and (> offset 0) (= 0 (mod offset 16))))
(count-addresses
(if even-sixteen
lines
(1+ lines)))
(count-trailers
(if even-sixteen
(max 0 (1- lines))
lines))
(addresses (* 10 count-addresses))
(trailers (* 18 count-trailers))
(spaces (/ offset 2))
(bytes (* offset 2)))
(if (and (> spaces 0) (= 0 (mod offset 2)))
(setq spaces (1- spaces)))
(if (= 0 offset)
(x509-asn1--hexl-offset-start offset)
(+ 1 addresses trailers spaces bytes))))
(defun x509-asn1--hexl-char-offset-end (offset)
"Return buffer point where OFFSET ends in a `hexl-mode' buffer."
(let* ((lines (/ offset 16))
(even-sixteen (and (> offset 0) (= 0 (mod offset 16))))
(whole-lines
(if even-sixteen
lines
(1+ lines)))
(addresses (* 10 whole-lines))
(byte-blocks (* 41 whole-lines))
(char-blocks (* lines 17))
(chars (mod offset 16)))
(if even-sixteen
(setq chars (- chars 1)))
(if (= 0 offset)
(x509-asn1--hexl-char-offset-start offset)
(+ 1 addresses byte-blocks char-blocks chars))))
(defun x509--display-buffer (buffer)
"Display BUFFER without switching to it.
Used to display hexl buffer in `x509-asn1-mode'."
(display-buffer buffer '(nil (inhibit-same-window . t))))
(defun x509--point-visible (buffer point)
"Check if POINT is visible in a window in BUFFER."
(cl-find-if
(lambda (w)
(and (>= point (window-start w)) (<= point (window-end w))))
(get-buffer-window-list buffer)))
(defun x509--scroll-window (buffer point)
"Recenter window showing BUFFER around point POINT unless POINT is visible."
(if (not (x509--point-visible buffer point))
(let ((window (get-buffer-window buffer)))
(when window
(with-selected-window window
(goto-char point)
(recenter))))))
(defun x509-asn1--byte-offet-stripes (start-byte end-byte)
"Construct stripes of bytes mod 16.
Starting from START-BYTE and ending before END-BYTE."
(let ((ranges '()))
(while (< start-byte end-byte)
(let* ((total-bytes (- end-byte start-byte))
(stripe-len (min total-bytes (- 16 (mod start-byte 16))))
(stripe-end (+ start-byte stripe-len)))
(push (cons start-byte stripe-end) ranges)
(setq start-byte (+ start-byte stripe-len))))
ranges))
(defun x509-asn1--hexl-buffer-offset-stripes (start-byte end-byte)
"Construct stripes of offsets in a `hexl-mode' buffer.
Starting from START-BYTE and ending before END-BYTE.
One set of stripes cover the hex bytes and one set cover the
characters in the rightmost column."
(let ((byte-ranges (x509-asn1--byte-offet-stripes start-byte end-byte)))
(append
(nreverse
(cl-mapcar
(lambda (stripe)
(cons
(x509-asn1--hexl-offset-start (car stripe))
(x509-asn1--hexl-offset-end (cdr stripe))))
byte-ranges))
(nreverse
(cl-mapcar
(lambda (stripe)
(cons
(x509-asn1--hexl-char-offset-start (car stripe))
(x509-asn1--hexl-char-offset-end (cdr stripe))))
byte-ranges)))))
(defun x509-asn1--apply-overlay-stripes (point-stripes face)
"Add overlays in current buffer spanning POINT-STRIPES using face FACE.
Store created overlays in `x509-asn1--hexl-overlays'."
(cl-loop
for stripe in point-stripes do
(let ((start (car stripe))
(end (cdr stripe)))
(push (x509-asn1--setup-overlay start end (current-buffer) face)
x509-asn1--hexl-overlays))))
(defun x509-asn1--update-overlays ()
"Add overlay that spans currently active bytes in `x509-asn1-mode' buffer.
The ASN.1 header uses `x509-asn1-hexl-header' face and the value uses the
`x509-asn1-hexl-value' face."
(let* ((header-length (x509--asn1-get-header-len))
(total-length (x509--asn1-get-total-length))
(value-length (- total-length header-length))
(header-start (x509--asn1-get-absolute-offset))
(header-end (+ header-start header-length))
(value-start (+ header-start header-length))
(value-end (+ value-start value-length))
(header-stripes
(x509-asn1--hexl-buffer-offset-stripes header-start header-end))
(value-stripes
(x509-asn1--hexl-buffer-offset-stripes value-start value-end)))
(with-current-buffer x509-asn1--hexl-buffer
(x509-asn1--remove-overlays)
(x509-asn1--apply-overlay-stripes header-stripes 'x509-asn1-hexl-header)
(x509-asn1--apply-overlay-stripes value-stripes 'x509-asn1-hexl-value)
(let ((start-region (caar header-stripes)))
(if start-region
(x509--scroll-window x509-asn1--hexl-buffer start-region))))))
(defun x509-asn1--post-command-hook ()
"Update hexl buffer overlay if point has moved."
(if (and (boundp 'x509-asn1--hexl-buffer)
(buffer-live-p x509-asn1--hexl-buffer)
(boundp 'x509-asn1--last-point))
(unless (eq (point) x509-asn1--last-point)
(setq x509-asn1--last-point (point))
(x509-asn1--update-overlays)
(x509--display-buffer x509-asn1--hexl-buffer))
(remove-hook 'post-command-hook #'x509-asn1--post-command-hook t)))
(defun x509-asn1-toggle-hexl ()
"Display hex buffer matching current input puffer."
(interactive)
(if (bound-and-true-p x509-asn1--hexl-buffer)
(progn
(remove-hook 'post-command-hook #'x509-asn1--post-command-hook t)
(kill-buffer x509-asn1--hexl-buffer)
(setq x509-asn1--hexl-buffer nil)
(setq x509-asn1--last-point nil))
(let* ((src-buffer x509--shadow-buffer)
(hexl-buffer-name
(replace-regexp-in-string
"^ \\*in-x-" "*hexl-" (buffer-name src-buffer)))
(hexl-buffer (get-buffer-create hexl-buffer-name)))
(with-current-buffer hexl-buffer
(setq buffer-file-coding-system 'no-conversion)
(setq buffer-read-only nil)
(erase-buffer))
(if (string= "PEM" (x509--buffer-encoding src-buffer))
(x509--process-buffer
src-buffer (split-string-and-unquote "enc -d -base64")
hexl-buffer 'no-hooks)
(with-current-buffer hexl-buffer
(insert-buffer-substring-no-properties src-buffer)))
(with-current-buffer hexl-buffer
(setq buffer-read-only nil)
(let ((buffer-undo-list t))
(hexlify-buffer))
(read-only-mode)
(x509--display-buffer hexl-buffer))
(add-hook 'post-command-hook #'x509-asn1--post-command-hook nil t)
(setq x509-asn1--hexl-buffer hexl-buffer))))
(eval-when-compile
(defconst x509--asn1-primitives-keywords
(regexp-opt
'("prim"
"EOC"
"BOOLEAN"
"INTEGER"
"BIT_STRING"
"BIT STRING"
"OCTET_STRING"
"OCTET STRING"
"NULL"
"OID"
"UTCTIME"
"GENERALIZEDTIME"
"ENUMERATED"))))
(eval-when-compile
(defconst x509--asn1-cons-keywords (regexp-opt '("SEQUENCE" "SET"))))
(eval-when-compile
(defconst x509--asn1-strings
(concat
(regexp-opt
'("UTF8STRING" "PRINTABLESTRING" "IA5STRING")
t) " *:\\(.*?\\)\\(?: *:\\|$\\)")))
(eval-when-compile
(defconst x509--asn1-oid
(concat
(regexp-opt
'("OID" "OBJECT")
t) " *:\\(.*?\\)\\(?: *:\\|$\\)")))
(defconst x509-asn1-font-lock-keywords
(eval-when-compile
(list
'("l=\\(inf\\) " (1 'x509-constant-face))
`(,x509--asn1-primitives-keywords . 'x509-keyword-face)
`(,x509--asn1-cons-keywords . 'x509-asn1-sequence-face)
'("\\(cons\\):" (1 'x509-asn1-sequence-face))
'("\\(cont\\|appl\\|priv\\) \\[\\(.*?\\)\\]"
(1 'x509-asn1-sequence-face)
(2 'x509-string-face))
'("error:.*\\|Error in encoding" . 'x509-warning-face)
`(,x509--asn1-strings (1 'x509-keyword-face) (2 'x509-string-face))
`(,x509--asn1-oid (1 'x509-keyword-face) (2 'x509-oid-face))))
"Openssl asn1parse highlighting.")
(define-derived-mode
x509-asn1-mode
fundamental-mode
x509--asn1-mode-name
"Major mode for displaying openssl asn1parse output.
\\{x509-asn1-mode-map}"
(set
(make-local-variable 'font-lock-defaults) '(x509-asn1-font-lock-keywords t))
(define-key x509-asn1-mode-map "q" 'x509-mode--kill-buffer)
(define-key x509-asn1-mode-map "t" 'x509--toggle-mode)
(define-key x509-asn1-mode-map "e" 'x509--edit-params)
(define-key x509-asn1-mode-map "d" 'x509--asn1-offset-down)
(define-key x509-asn1-mode-map "s" 'x509--asn1-strparse)
(define-key x509-asn1-mode-map "u" 'x509--asn1-offset-up)
(define-key x509-asn1-mode-map "x" 'x509-asn1-toggle-hexl)
(x509--mark-browse-http-links)
(x509--mark-browse-oid))
(defvar x509--viewasn1-history nil
"History list for `x509-viewasn1'.")
(defun x509-viewasn1 ()
"Parse current buffer as ASN.1.
With \\[universal-argument] prefix, you can edit the command arguments."
(interactive)
(x509--generic-view
x509-asn1parse-default-arg 'x509--viewasn1-history 'x509-asn1-mode))
(provide 'x509-asn1-mode)
(provide 'x509-mode)