| 1 | ;;; pgg-parse.el --- OpenPGP packet parsing |
| 2 | |
| 3 | ;; Copyright (C) 1999, 2002, 2003, 2004, 2005, |
| 4 | ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 7 | ;; Created: 1999/10/28 |
| 8 | ;; Keywords: PGP, OpenPGP, GnuPG |
| 9 | |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | |
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 13 | ;; it under the terms of the GNU General Public License as published by |
| 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 15 | ;; any later version. |
| 16 | |
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ;; GNU General Public License for more details. |
| 21 | |
| 22 | ;; You should have received a copy of the GNU General Public License |
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 25 | ;; Boston, MA 02110-1301, USA. |
| 26 | |
| 27 | ;;; Commentary: |
| 28 | |
| 29 | ;; This module is based on |
| 30 | |
| 31 | ;; [OpenPGP] RFC 2440: "OpenPGP Message Format" |
| 32 | ;; by John W. Noerenberg, II <jwn2@qualcomm.com>, |
| 33 | ;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>, |
| 34 | ;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com> |
| 35 | ;; (1998/11) |
| 36 | |
| 37 | ;;; Code: |
| 38 | |
| 39 | (eval-when-compile |
| 40 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) |
| 41 | (require 'cl)) |
| 42 | |
| 43 | (defgroup pgg-parse () |
| 44 | "OpenPGP packet parsing." |
| 45 | :group 'pgg) |
| 46 | |
| 47 | (defcustom pgg-parse-public-key-algorithm-alist |
| 48 | '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG)) |
| 49 | "Alist of the assigned number to the public key algorithm." |
| 50 | :group 'pgg-parse |
| 51 | :type '(repeat |
| 52 | (cons (sexp :tag "Number") (sexp :tag "Type")))) |
| 53 | |
| 54 | (defcustom pgg-parse-symmetric-key-algorithm-alist |
| 55 | '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128)) |
| 56 | "Alist of the assigned number to the simmetric key algorithm." |
| 57 | :group 'pgg-parse |
| 58 | :type '(repeat |
| 59 | (cons (sexp :tag "Number") (sexp :tag "Type")))) |
| 60 | |
| 61 | (defcustom pgg-parse-hash-algorithm-alist |
| 62 | '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2) (8 . SHA256) (9 . SHA384) |
| 63 | (10 . SHA512)) |
| 64 | "Alist of the assigned number to the cryptographic hash algorithm." |
| 65 | :group 'pgg-parse |
| 66 | :type '(repeat |
| 67 | (cons (sexp :tag "Number") (sexp :tag "Type")))) |
| 68 | |
| 69 | (defcustom pgg-parse-compression-algorithm-alist |
| 70 | '((0 . nil); Uncompressed |
| 71 | (1 . ZIP) |
| 72 | (2 . ZLIB)) |
| 73 | "Alist of the assigned number to the compression algorithm." |
| 74 | :group 'pgg-parse |
| 75 | :type '(repeat |
| 76 | (cons (sexp :tag "Number") (sexp :tag "Type")))) |
| 77 | |
| 78 | (defcustom pgg-parse-signature-type-alist |
| 79 | '((0 . "Signature of a binary document") |
| 80 | (1 . "Signature of a canonical text document") |
| 81 | (2 . "Standalone signature") |
| 82 | (16 . "Generic certification of a User ID and Public Key packet") |
| 83 | (17 . "Persona certification of a User ID and Public Key packet") |
| 84 | (18 . "Casual certification of a User ID and Public Key packet") |
| 85 | (19 . "Positive certification of a User ID and Public Key packet") |
| 86 | (24 . "Subkey Binding Signature") |
| 87 | (31 . "Signature directly on a key") |
| 88 | (32 . "Key revocation signature") |
| 89 | (40 . "Subkey revocation signature") |
| 90 | (48 . "Certification revocation signature") |
| 91 | (64 . "Timestamp signature.")) |
| 92 | "Alist of the assigned number to the signature type." |
| 93 | :group 'pgg-parse |
| 94 | :type '(repeat |
| 95 | (cons (sexp :tag "Number") (sexp :tag "Type")))) |
| 96 | |
| 97 | (defcustom pgg-ignore-packet-checksum t; XXX |
| 98 | "If non-nil checksum of each ascii armored packet will be ignored." |
| 99 | :group 'pgg-parse |
| 100 | :type 'boolean) |
| 101 | |
| 102 | (defvar pgg-armor-header-lines |
| 103 | '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$" |
| 104 | "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$" |
| 105 | "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$" |
| 106 | "^-----BEGIN PGP SIGNATURE-----\r?$") |
| 107 | "Armor headers.") |
| 108 | |
| 109 | (eval-and-compile |
| 110 | (defalias 'pgg-char-int (if (fboundp 'char-int) |
| 111 | 'char-int |
| 112 | 'identity))) |
| 113 | |
| 114 | (defmacro pgg-format-key-identifier (string) |
| 115 | `(mapconcat (lambda (c) (format "%02X" (pgg-char-int c))) |
| 116 | ,string "") |
| 117 | ;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x" |
| 118 | ;; (string-to-number-list ,string))) |
| 119 | ) |
| 120 | |
| 121 | (defmacro pgg-parse-time-field (bytes) |
| 122 | `(list (logior (lsh (car ,bytes) 8) |
| 123 | (nth 1 ,bytes)) |
| 124 | (logior (lsh (nth 2 ,bytes) 8) |
| 125 | (nth 3 ,bytes)) |
| 126 | 0)) |
| 127 | |
| 128 | (defmacro pgg-byte-after (&optional pos) |
| 129 | `(pgg-char-int (char-after ,(or pos `(point))))) |
| 130 | |
| 131 | (defmacro pgg-read-byte () |
| 132 | `(pgg-char-int (char-after (prog1 (point) (forward-char))))) |
| 133 | |
| 134 | (defmacro pgg-read-bytes-string (nbytes) |
| 135 | `(buffer-substring |
| 136 | (point) (prog1 (+ ,nbytes (point)) |
| 137 | (forward-char ,nbytes)))) |
| 138 | |
| 139 | (defmacro pgg-read-bytes (nbytes) |
| 140 | `(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes)) |
| 141 | ;; `(string-to-number-list (pgg-read-bytes-string ,nbytes)) |
| 142 | ) |
| 143 | |
| 144 | (defmacro pgg-read-body-string (ptag) |
| 145 | `(if (nth 1 ,ptag) |
| 146 | (pgg-read-bytes-string (nth 1 ,ptag)) |
| 147 | (pgg-read-bytes-string (- (point-max) (point))))) |
| 148 | |
| 149 | (defmacro pgg-read-body (ptag) |
| 150 | `(mapcar #'pgg-char-int (pgg-read-body-string ,ptag)) |
| 151 | ;; `(string-to-number-list (pgg-read-body-string ,ptag)) |
| 152 | ) |
| 153 | |
| 154 | (defalias 'pgg-skip-bytes 'forward-char) |
| 155 | |
| 156 | (defmacro pgg-skip-header (ptag) |
| 157 | `(pgg-skip-bytes (nth 2 ,ptag))) |
| 158 | |
| 159 | (defmacro pgg-skip-body (ptag) |
| 160 | `(pgg-skip-bytes (nth 1 ,ptag))) |
| 161 | |
| 162 | (defmacro pgg-set-alist (alist key value) |
| 163 | `(setq ,alist (nconc ,alist (list (cons ,key ,value))))) |
| 164 | |
| 165 | (when (fboundp 'define-ccl-program) |
| 166 | |
| 167 | (define-ccl-program pgg-parse-crc24 |
| 168 | '(1 |
| 169 | ((loop |
| 170 | (read r0) (r1 ^= r0) (r2 ^= 0) |
| 171 | (r5 = 0) |
| 172 | (loop |
| 173 | (r1 <<= 1) |
| 174 | (r1 += ((r2 >> 15) & 1)) |
| 175 | (r2 <<= 1) |
| 176 | (if (r1 & 256) |
| 177 | ((r1 ^= 390) (r2 ^= 19707))) |
| 178 | (if (r5 < 7) |
| 179 | ((r5 += 1) |
| 180 | (repeat)))) |
| 181 | (repeat))))) |
| 182 | |
| 183 | (defvar pgg-parse-crc24) |
| 184 | |
| 185 | (defun pgg-parse-crc24-string (string) |
| 186 | (let ((h (vector nil 183 1230 nil nil nil nil nil nil))) |
| 187 | (ccl-execute-on-string pgg-parse-crc24 h string) |
| 188 | (format "%c%c%c" |
| 189 | (logand (aref h 1) 255) |
| 190 | (logand (lsh (aref h 2) -8) 255) |
| 191 | (logand (aref h 2) 255))))) |
| 192 | |
| 193 | (defmacro pgg-parse-length-type (c) |
| 194 | `(cond |
| 195 | ((< ,c 192) (cons ,c 1)) |
| 196 | ((< ,c 224) |
| 197 | (cons (+ (lsh (- ,c 192) 8) |
| 198 | (pgg-byte-after (+ 2 (point))) |
| 199 | 192) |
| 200 | 2)) |
| 201 | ((= ,c 255) |
| 202 | (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8) |
| 203 | (pgg-byte-after (+ 3 (point)))) |
| 204 | (logior (lsh (pgg-byte-after (+ 4 (point))) 8) |
| 205 | (pgg-byte-after (+ 5 (point))))) |
| 206 | 5)) |
| 207 | (t;partial body length |
| 208 | '(0 . 0)))) |
| 209 | |
| 210 | (defun pgg-parse-packet-header () |
| 211 | (let ((ptag (pgg-byte-after)) |
| 212 | length-type content-tag packet-bytes header-bytes) |
| 213 | (if (zerop (logand 64 ptag));Old format |
| 214 | (progn |
| 215 | (setq length-type (logand ptag 3) |
| 216 | length-type (if (= 3 length-type) 0 (lsh 1 length-type)) |
| 217 | content-tag (logand 15 (lsh ptag -2)) |
| 218 | packet-bytes 0 |
| 219 | header-bytes (1+ length-type)) |
| 220 | (dotimes (i length-type) |
| 221 | (setq packet-bytes |
| 222 | (logior (lsh packet-bytes 8) |
| 223 | (pgg-byte-after (+ 1 i (point))))))) |
| 224 | (setq content-tag (logand 63 ptag) |
| 225 | length-type (pgg-parse-length-type |
| 226 | (pgg-byte-after (1+ (point)))) |
| 227 | packet-bytes (car length-type) |
| 228 | header-bytes (1+ (cdr length-type)))) |
| 229 | (list content-tag packet-bytes header-bytes))) |
| 230 | |
| 231 | (defun pgg-parse-packet (ptag) |
| 232 | (case (car ptag) |
| 233 | (1 ;Public-Key Encrypted Session Key Packet |
| 234 | (pgg-parse-public-key-encrypted-session-key-packet ptag)) |
| 235 | (2 ;Signature Packet |
| 236 | (pgg-parse-signature-packet ptag)) |
| 237 | (3 ;Symmetric-Key Encrypted Session Key Packet |
| 238 | (pgg-parse-symmetric-key-encrypted-session-key-packet ptag)) |
| 239 | ;; 4 -- One-Pass Signature Packet |
| 240 | ;; 5 -- Secret Key Packet |
| 241 | (6 ;Public Key Packet |
| 242 | (pgg-parse-public-key-packet ptag)) |
| 243 | ;; 7 -- Secret Subkey Packet |
| 244 | ;; 8 -- Compressed Data Packet |
| 245 | (9 ;Symmetrically Encrypted Data Packet |
| 246 | (pgg-read-body-string ptag)) |
| 247 | (10 ;Marker Packet |
| 248 | (pgg-read-body-string ptag)) |
| 249 | (11 ;Literal Data Packet |
| 250 | (pgg-read-body-string ptag)) |
| 251 | ;; 12 -- Trust Packet |
| 252 | (13 ;User ID Packet |
| 253 | (pgg-read-body-string ptag)) |
| 254 | ;; 14 -- Public Subkey Packet |
| 255 | ;; 60 .. 63 -- Private or Experimental Values |
| 256 | )) |
| 257 | |
| 258 | (defun pgg-parse-packets (&optional header-parser body-parser) |
| 259 | (let ((header-parser |
| 260 | (or header-parser |
| 261 | (function pgg-parse-packet-header))) |
| 262 | (body-parser |
| 263 | (or body-parser |
| 264 | (function pgg-parse-packet))) |
| 265 | result ptag) |
| 266 | (while (> (point-max) (1+ (point))) |
| 267 | (setq ptag (funcall header-parser)) |
| 268 | (pgg-skip-header ptag) |
| 269 | (push (cons (car ptag) |
| 270 | (save-excursion |
| 271 | (funcall body-parser ptag))) |
| 272 | result) |
| 273 | (if (zerop (nth 1 ptag)) |
| 274 | (goto-char (point-max)) |
| 275 | (forward-char (nth 1 ptag)))) |
| 276 | result)) |
| 277 | |
| 278 | (defun pgg-parse-signature-subpacket-header () |
| 279 | (let ((length-type (pgg-parse-length-type (pgg-byte-after)))) |
| 280 | (list (pgg-byte-after (+ (cdr length-type) (point))) |
| 281 | (1- (car length-type)) |
| 282 | (1+ (cdr length-type))))) |
| 283 | |
| 284 | (defun pgg-parse-signature-subpacket (ptag) |
| 285 | (case (car ptag) |
| 286 | (2 ;signature creation time |
| 287 | (cons 'creation-time |
| 288 | (let ((bytes (pgg-read-bytes 4))) |
| 289 | (pgg-parse-time-field bytes)))) |
| 290 | (3 ;signature expiration time |
| 291 | (cons 'signature-expiry |
| 292 | (let ((bytes (pgg-read-bytes 4))) |
| 293 | (pgg-parse-time-field bytes)))) |
| 294 | (4 ;exportable certification |
| 295 | (cons 'exportability (pgg-read-byte))) |
| 296 | (5 ;trust signature |
| 297 | (cons 'trust-level (pgg-read-byte))) |
| 298 | (6 ;regular expression |
| 299 | (cons 'regular-expression |
| 300 | (pgg-read-body-string ptag))) |
| 301 | (7 ;revocable |
| 302 | (cons 'revocability (pgg-read-byte))) |
| 303 | (9 ;key expiration time |
| 304 | (cons 'key-expiry |
| 305 | (let ((bytes (pgg-read-bytes 4))) |
| 306 | (pgg-parse-time-field bytes)))) |
| 307 | ;; 10 = placeholder for backward compatibility |
| 308 | (11 ;preferred symmetric algorithms |
| 309 | (cons 'preferred-symmetric-key-algorithm |
| 310 | (cdr (assq (pgg-read-byte) |
| 311 | pgg-parse-symmetric-key-algorithm-alist)))) |
| 312 | (12 ;revocation key |
| 313 | ) |
| 314 | (16 ;issuer key ID |
| 315 | (cons 'key-identifier |
| 316 | (pgg-format-key-identifier (pgg-read-body-string ptag)))) |
| 317 | (20 ;notation data |
| 318 | (pgg-skip-bytes 4) |
| 319 | (cons 'notation |
| 320 | (let ((name-bytes (pgg-read-bytes 2)) |
| 321 | (value-bytes (pgg-read-bytes 2))) |
| 322 | (cons (pgg-read-bytes-string |
| 323 | (logior (lsh (car name-bytes) 8) |
| 324 | (nth 1 name-bytes))) |
| 325 | (pgg-read-bytes-string |
| 326 | (logior (lsh (car value-bytes) 8) |
| 327 | (nth 1 value-bytes))))))) |
| 328 | (21 ;preferred hash algorithms |
| 329 | (cons 'preferred-hash-algorithm |
| 330 | (cdr (assq (pgg-read-byte) |
| 331 | pgg-parse-hash-algorithm-alist)))) |
| 332 | (22 ;preferred compression algorithms |
| 333 | (cons 'preferred-compression-algorithm |
| 334 | (cdr (assq (pgg-read-byte) |
| 335 | pgg-parse-compression-algorithm-alist)))) |
| 336 | (23 ;key server preferences |
| 337 | (cons 'key-server-preferences |
| 338 | (pgg-read-body ptag))) |
| 339 | (24 ;preferred key server |
| 340 | (cons 'preferred-key-server |
| 341 | (pgg-read-body-string ptag))) |
| 342 | ;; 25 = primary user id |
| 343 | (26 ;policy URL |
| 344 | (cons 'policy-url (pgg-read-body-string ptag))) |
| 345 | ;; 27 = key flags |
| 346 | ;; 28 = signer's user id |
| 347 | ;; 29 = reason for revocation |
| 348 | ;; 100 to 110 = internal or user-defined |
| 349 | )) |
| 350 | |
| 351 | (defun pgg-parse-signature-packet (ptag) |
| 352 | (let* ((signature-version (pgg-byte-after)) |
| 353 | (result (list (cons 'version signature-version))) |
| 354 | hashed-material field n) |
| 355 | (cond |
| 356 | ((= signature-version 3) |
| 357 | (pgg-skip-bytes 2) |
| 358 | (setq hashed-material (pgg-read-bytes 5)) |
| 359 | (pgg-set-alist result |
| 360 | 'signature-type |
| 361 | (cdr (assq (pop hashed-material) |
| 362 | pgg-parse-signature-type-alist))) |
| 363 | (pgg-set-alist result |
| 364 | 'creation-time |
| 365 | (pgg-parse-time-field hashed-material)) |
| 366 | (pgg-set-alist result |
| 367 | 'key-identifier |
| 368 | (pgg-format-key-identifier |
| 369 | (pgg-read-bytes-string 8))) |
| 370 | (pgg-set-alist result |
| 371 | 'public-key-algorithm (pgg-read-byte)) |
| 372 | (pgg-set-alist result |
| 373 | 'hash-algorithm (pgg-read-byte))) |
| 374 | ((= signature-version 4) |
| 375 | (pgg-skip-bytes 1) |
| 376 | (pgg-set-alist result |
| 377 | 'signature-type |
| 378 | (cdr (assq (pgg-read-byte) |
| 379 | pgg-parse-signature-type-alist))) |
| 380 | (pgg-set-alist result |
| 381 | 'public-key-algorithm |
| 382 | (pgg-read-byte)) |
| 383 | (pgg-set-alist result |
| 384 | 'hash-algorithm (pgg-read-byte)) |
| 385 | (when (>= 10000 (setq n (pgg-read-bytes 2) |
| 386 | n (logior (lsh (car n) 8) |
| 387 | (nth 1 n)))) |
| 388 | (save-restriction |
| 389 | (narrow-to-region (point)(+ n (point))) |
| 390 | (nconc result |
| 391 | (mapcar (function cdr) ;remove packet types |
| 392 | (pgg-parse-packets |
| 393 | #'pgg-parse-signature-subpacket-header |
| 394 | #'pgg-parse-signature-subpacket))) |
| 395 | (goto-char (point-max)))) |
| 396 | (when (>= 10000 (setq n (pgg-read-bytes 2) |
| 397 | n (logior (lsh (car n) 8) |
| 398 | (nth 1 n)))) |
| 399 | (save-restriction |
| 400 | (narrow-to-region (point)(+ n (point))) |
| 401 | (nconc result |
| 402 | (mapcar (function cdr) ;remove packet types |
| 403 | (pgg-parse-packets |
| 404 | #'pgg-parse-signature-subpacket-header |
| 405 | #'pgg-parse-signature-subpacket))))))) |
| 406 | |
| 407 | (setcdr (setq field (assq 'public-key-algorithm |
| 408 | result)) |
| 409 | (cdr (assq (cdr field) |
| 410 | pgg-parse-public-key-algorithm-alist))) |
| 411 | (setcdr (setq field (assq 'hash-algorithm |
| 412 | result)) |
| 413 | (cdr (assq (cdr field) |
| 414 | pgg-parse-hash-algorithm-alist))) |
| 415 | result)) |
| 416 | |
| 417 | (defun pgg-parse-public-key-encrypted-session-key-packet (ptag) |
| 418 | (let (result) |
| 419 | (pgg-set-alist result |
| 420 | 'version (pgg-read-byte)) |
| 421 | (pgg-set-alist result |
| 422 | 'key-identifier |
| 423 | (pgg-format-key-identifier |
| 424 | (pgg-read-bytes-string 8))) |
| 425 | (pgg-set-alist result |
| 426 | 'public-key-algorithm |
| 427 | (cdr (assq (pgg-read-byte) |
| 428 | pgg-parse-public-key-algorithm-alist))) |
| 429 | result)) |
| 430 | |
| 431 | (defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag) |
| 432 | (let (result) |
| 433 | (pgg-set-alist result |
| 434 | 'version |
| 435 | (pgg-read-byte)) |
| 436 | (pgg-set-alist result |
| 437 | 'symmetric-key-algorithm |
| 438 | (cdr (assq (pgg-read-byte) |
| 439 | pgg-parse-symmetric-key-algorithm-alist))) |
| 440 | result)) |
| 441 | |
| 442 | (defun pgg-parse-public-key-packet (ptag) |
| 443 | (let* ((key-version (pgg-read-byte)) |
| 444 | (result (list (cons 'version key-version))) |
| 445 | field) |
| 446 | (cond |
| 447 | ((= 3 key-version) |
| 448 | (pgg-set-alist result |
| 449 | 'creation-time |
| 450 | (let ((bytes (pgg-read-bytes 4))) |
| 451 | (pgg-parse-time-field bytes))) |
| 452 | (pgg-set-alist result |
| 453 | 'key-expiry (pgg-read-bytes 2)) |
| 454 | (pgg-set-alist result |
| 455 | 'public-key-algorithm (pgg-read-byte))) |
| 456 | ((= 4 key-version) |
| 457 | (pgg-set-alist result |
| 458 | 'creation-time |
| 459 | (let ((bytes (pgg-read-bytes 4))) |
| 460 | (pgg-parse-time-field bytes))) |
| 461 | (pgg-set-alist result |
| 462 | 'public-key-algorithm (pgg-read-byte)))) |
| 463 | |
| 464 | (setcdr (setq field (assq 'public-key-algorithm |
| 465 | result)) |
| 466 | (cdr (assq (cdr field) |
| 467 | pgg-parse-public-key-algorithm-alist))) |
| 468 | result)) |
| 469 | |
| 470 | ;; p-d-p only calls this if it is defined, but the compiler does not |
| 471 | ;; recognize that. |
| 472 | (declare-function pgg-parse-crc24-string "pgg-parse" (string)) |
| 473 | |
| 474 | (defun pgg-decode-packets () |
| 475 | (if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t) |
| 476 | (let ((p (match-beginning 0)) |
| 477 | (checksum (match-string 1))) |
| 478 | (delete-region p (point-max)) |
| 479 | (if (ignore-errors (base64-decode-region (point-min) p)) |
| 480 | (or (not (fboundp 'pgg-parse-crc24-string)) |
| 481 | pgg-ignore-packet-checksum |
| 482 | (string-equal (base64-encode-string (pgg-parse-crc24-string |
| 483 | (buffer-string))) |
| 484 | checksum) |
| 485 | (progn |
| 486 | (message "PGP packet checksum does not match") |
| 487 | nil)) |
| 488 | (message "PGP packet contain invalid base64") |
| 489 | nil)) |
| 490 | (message "PGP packet checksum not found") |
| 491 | nil)) |
| 492 | |
| 493 | (defun pgg-decode-armor-region (start end) |
| 494 | (save-restriction |
| 495 | (narrow-to-region start end) |
| 496 | (goto-char (point-min)) |
| 497 | (re-search-forward "^-+BEGIN PGP" nil t) |
| 498 | (delete-region (point-min) |
| 499 | (and (search-forward "\n\n") |
| 500 | (match-end 0))) |
| 501 | (when (pgg-decode-packets) |
| 502 | (goto-char (point-min)) |
| 503 | (pgg-parse-packets)))) |
| 504 | |
| 505 | (defun pgg-parse-armor (string) |
| 506 | (with-temp-buffer |
| 507 | (buffer-disable-undo) |
| 508 | (if (fboundp 'set-buffer-multibyte) |
| 509 | (set-buffer-multibyte nil)) |
| 510 | (insert string) |
| 511 | (pgg-decode-armor-region (point-min)(point)))) |
| 512 | |
| 513 | (eval-and-compile |
| 514 | (defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte) |
| 515 | 'string-as-unibyte |
| 516 | 'identity))) |
| 517 | |
| 518 | (defun pgg-parse-armor-region (start end) |
| 519 | (pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end)))) |
| 520 | |
| 521 | (provide 'pgg-parse) |
| 522 | |
| 523 | ;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e |
| 524 | ;;; pgg-parse.el ends here |