:group 'pgg-parse
:type 'alist)
-(defcustom pgg-ignore-packet-checksum (featurep 'xemacs); XXX
+(defcustom pgg-ignore-packet-checksum t; XXX
"If non-nil checksum of each ascii armored packet will be ignored."
:group 'pgg-parse
:type 'boolean)
+(defvar pgg-armor-header-lines
+ '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP SIGNATURE-----\r?$")
+ "Armor headers")
+
(defmacro pgg-format-key-identifier (string)
`(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
(string-to-int-list ,string))))
0))
(defmacro pgg-byte-after (&optional pos)
- `(char-int (char-after ,pos)))
+ `(char-int (char-after ,(or pos `(point)))))
(defmacro pgg-read-byte ()
`(char-int (char-after (prog1 (point) (forward-char)))))
`(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
(unless-broken ccl-usable
- (check-broken-facility ccl-cascading-read)
-
(define-ccl-program pgg-parse-crc24
'(1
- ((r1 = 183) (r2 = 1230)
- (loop
+ ((loop
(read r0) (r1 ^= r0) (r2 ^= 0)
(r5 = 0)
(loop
(if (r5 < 7)
((r5 += 1)
(repeat))))
- (repeat)))
- ((r1 &= 255)
- (r3 = (r2 & 255))
- (r2 = ((r2 >> 8) & 255))
- (write r1 r2 r3))))
-
- (make-ccl-coding-system
- 'pgg-parse-crc24 ?C "CRC24 checker"
- 'pgg-parse-crc24 'pgg-parse-crc24)
+ (repeat)))))
(defun pgg-parse-crc24-string (string)
- (encode-coding-string string 'pgg-parse-crc24))
+ (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+ (ccl-execute-on-string pgg-parse-crc24 h string)
+ (format "%c%c%c"
+ (logand (aref h 1) 255)
+ (logand (lsh (aref h 2) -8) 255)
+ (logand (aref h 2) 255))))
)
(defmacro pgg-parse-length-type (c)
(pgg-byte-after (+ 5 (point)))))
5))
(t;partial body length
- '(0 0))))
+ '(0 . 0))))
(defun pgg-parse-packet-header ()
(let ((ptag (pgg-byte-after))
;; 7 -- Secret Subkey Packet
;; 8 -- Compressed Data Packet
(9 ;Symmetrically Encrypted Data Packet
- (pgg-read-body ptag))
+ (pgg-read-body-string ptag))
(10 ;Marker Packet
- (pgg-read-body ptag))
+ (pgg-read-body-string ptag))
(11 ;Literal Data Packet
- (pgg-read-body ptag))
+ (pgg-read-body-string ptag))
;; 12 -- Trust Packet
(13 ;User ID Packet
- (pgg-read-body ptag))
+ (pgg-read-body-string ptag))
;; 14 -- Public Subkey Packet
;; 60 .. 63 -- Private or Experimental Values
))
(cons 'trust-level (pgg-read-byte)))
(6 ;regular expression
(cons 'regular-expression
- (pgg-read-body ptag)))
+ (pgg-read-body-string ptag)))
(7 ;revocable
(cons 'revocability (pgg-read-byte)))
(9 ;key expiration time
(cdr (assq (pgg-read-byte)
pgg-parse-compression-algorithm-alist))))
(23 ;key server preferences
- )
- ;; 24 = preferred key server
+ (cons 'key-server-preferences
+ (pgg-read-body ptag)))
+ (24 ;preferred key server
+ (cons 'preferred-key-server
+ (pgg-read-body-string ptag)))
;; 25 = primary user id
(26 ;policy URL
(cons 'policy-url (pgg-read-body-string ptag)))
(pgg-set-alist result
'version (pgg-read-byte))
(pgg-set-alist result
- 'public-key-identifier
- (pgg-format-key-identifier (pgg-read-bytes 8)))
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
(pgg-set-alist result
'public-key-algorithm
(cdr (assq (pgg-read-byte)
(mime-decode-region (point-min) marker "base64")
(static-when (fboundp 'pgg-parse-crc24-string )
(or pgg-ignore-packet-checksum
- (string-equal (mime-encode-string
- (pgg-parse-crc24-string
- (buffer-substring (point-min)(point-max)))
- "base64")
- checksum)
+ (string-equal
+ (funcall (mel-find-function 'mime-encode-string "base64")
+ (pgg-parse-crc24-string
+ (buffer-substring (point-min)(point-max))))
+ checksum)
(error "PGP packet checksum does not match.")))))
-;;;###autoload
(defun pgg-decode-armor-region (start end)
(save-restriction
(narrow-to-region start end)