aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--emms-info-native.el296
1 files changed, 149 insertions, 147 deletions
diff --git a/emms-info-native.el b/emms-info-native.el
index 405bf25..8601dd0 100644
--- a/emms-info-native.el
+++ b/emms-info-native.el
@@ -59,6 +59,8 @@
(require 'bindat)
(require 'cl-lib)
(require 'emms-info)
+(require 'seq)
+(require 'subr-x)
(defconst emms-info-native--max-peek-size (* 2048 1024)
"Maximum buffer size for metadata decoding.
@@ -72,127 +74,15 @@ Technically metadata blocks can have almost arbitrary lengths,
but in practice processing must be constrained to prevent memory
exhaustion in case of garbled or malicious inputs.")
-;;;; Ogg code
-
-(defconst emms-info-native--ogg-magic-array
- [79 103 103 83]
- "Ogg format magic capture pattern `OggS'.")
-
-(defconst emms-info-native--ogg-page-size 65307
- "Maximum size for a single Ogg container page.")
-
-(defconst emms-info-native--ogg-page-bindat-spec
- '((capture-pattern vec 4)
- (eval (unless (equal last emms-info-native--ogg-magic-array)
- (error "Ogg framing mismatch: expected `%s', got `%s'"
- emms-info-native--ogg-magic-array
- last)))
- (stream-structure-version u8)
- (eval (unless (= last 0)
- (error ("Ogg version mismatch: expected 0, got %s")
- last)))
- (header-type-flag u8)
- (granule-position vec 8)
- (stream-serial-number vec 4)
- (page-sequence-no vec 4)
- (page-checksum vec 4)
- (page-segments u8)
- (segment-table vec (page-segments))
- (payload vec (eval (seq-reduce #'+ last 0))))
- "Ogg page structure specification.")
-
-(defun emms-info-native--decode-ogg-comments (filename stream-type)
- "Read and decode comments from Ogg file FILENAME.
-The file is assumed to contain a single stream of type
-STREAM-TYPE, which must either `vorbis' or `opus'.
-
-Return comments in a list of (FIELD . VALUE) cons cells. See
-`emms-info-native--split-vorbis-comment' for details."
- (let* ((packets (emms-info-native--decode-ogg-packets filename 2))
- (headers (emms-info-native--decode-ogg-headers packets
- stream-type))
- (comments (bindat-get-field headers
- 'comment-header
- 'user-comments)))
- (emms-info-native--extract-vorbis-comments comments)))
-
-(defun emms-info-native--decode-ogg-packets (filename packets)
- "Read and decode packets from Ogg file FILENAME.
-Read in data from the start of FILENAME, remove Ogg packet
-frames, and concatenate payloads until at least PACKETS number of
-packets have been decoded. Return the decoded packets in a
-vector, concatenated.
-
-Data is read in `emms-info-native--ogg-page-size' chunks. If the
-total length of concatenated packets becomes greater than
-`emms-info-native--max-peek-size', an error is signaled.
-
-Only elementary streams are supported, that is, FILENAME should
-contain only a single logical stream. Note that this assumption
-is not verified: with non-elementary streams packets from
-different streams will be mixed together without an error."
- (let ((num-packets 0)
- (offset 0)
- (stream (vector)))
- (while (< num-packets packets)
- (let ((page (emms-info-native--decode-ogg-page filename
- offset)))
- (cl-incf num-packets (or (plist-get page :num-packets) 0))
- (cl-incf offset (plist-get page :num-bytes))
- (setq stream (vconcat stream (plist-get page :stream)))
- (when (> (length stream) emms-info-native--max-peek-size)
- (error "Ogg payload is too large"))))
- stream))
-
-(defun emms-info-native--decode-ogg-page (filename offset)
- "Read and decode a single Ogg page from FILENAME.
-Starting reading data from byte offset OFFSET.
-
-Return a plist (:num-packets N :num-bytes B :stream S), where N
-is the number of packets in the page, B is the size of the page
-in bytes, and S is the unframed logical bitstream in a vector.
-Note that N can be zero."
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally filename
- nil
- offset
- (+ offset
- emms-info-native--ogg-page-size))
- (let* ((page (bindat-unpack emms-info-native--ogg-page-bindat-spec
- (buffer-string)))
- (num-packets (emms-info-native--num-of-packets page))
- (num-bytes (bindat-length emms-info-native--ogg-page-bindat-spec
- page))
- (stream (bindat-get-field page 'payload)))
- (list :num-packets num-packets
- :num-bytes num-bytes
- :stream stream))))
-
-(defun emms-info-native--num-of-packets (page)
- "Return the number of packets in Ogg page PAGE.
-PAGE must correspond to
-`emms-info-native--ogg-page-bindat-spec'."
- ;; Every element that is less than 255 in the segment table
- ;; represents a packet boundary.
- (length (seq-filter (lambda (elt) (< elt 255))
- (bindat-get-field page 'segment-table))))
-
-(defun emms-info-native--decode-ogg-headers (packets stream-type)
- "Decode first two stream headers from PACKETS for STREAM-TYPE.
-STREAM-TYPE must be either `vorbis' or `opus'.
+(defvar emms-info-native--opus-channel-count 0
+ "Last decoded Opus channel count.
+This is a kludge; it is needed because bindat spec cannot refer
+outside itself.")
-Return a structure that corresponds to either
-`emms-info-native--opus-headers-bindat-spec' or
-`emms-info-native--vorbis-headers-bindat-spec'."
- (cond ((eq stream-type 'vorbis)
- (bindat-unpack emms-info-native--vorbis-headers-bindat-spec
- packets))
- ((eq stream-type 'opus)
- (let (emms-info-native--opus-channel-count)
- (bindat-unpack emms-info-native--opus-headers-bindat-spec
- packets)))
- (t (error "Unknown stream type %s" stream-type))))
+(defvar emms-info-native--id3v2-version 0
+ "Last decoded id3v2 version.
+This is a kludge; it is needed because bindat spec cannot refer
+outside itself.")
;;;; Vorbis code
@@ -245,10 +135,6 @@ their comments have almost the same format as Vorbis.")
"year")
"EMMS info fields that are extracted from Vorbis comments.")
-(defconst emms-info-native--vorbis-magic-array
- [118 111 114 98 105 115]
- "Header packet magic pattern `vorbis'.")
-
(defconst emms-info-native--vorbis-headers-bindat-spec
'((identification-header struct emms-info-native--vorbis-identification-header-bindat-spec)
(comment-header struct emms-info-native--vorbis-comment-header-bindat-spec))
@@ -282,6 +168,10 @@ header.")
last)))
"Vorbis identification header specification.")
+(defconst emms-info-native--vorbis-magic-array
+ [118 111 114 98 105 115]
+ "Header packet magic pattern `vorbis'.")
+
(defconst emms-info-native--vorbis-comment-header-bindat-spec
'((packet-type u8)
(eval (unless (= last 3)
@@ -356,19 +246,6 @@ lower case and VALUE is the decoded value."
;;;; Opus code
-(defvar emms-info-native--opus-channel-count 0
- "Last decoded Opus channel count.
-This is a kludge; it is needed because bindat spec cannot refer
-outside itself.")
-
-(defconst emms-info-native--opus-head-magic-array
- [79 112 117 115 72 101 97 100]
- "Opus identification header magic pattern `OpusHead'.")
-
-(defconst emms-info-native--opus-tags-magic-array
- [79 112 117 115 84 97 103 115]
- "Opus comment header magic pattern `OpusTags'.")
-
(defconst emms-info-native--opus-headers-bindat-spec
'((identification-header struct emms-info-native--opus-identification-header-bindat-spec)
(comment-header struct emms-info-native--opus-comment-header-bindat-spec))
@@ -397,6 +274,10 @@ header.")
(t (struct emms-info-native--opus-channel-mapping-table))))
"Opus identification header specification.")
+(defconst emms-info-native--opus-head-magic-array
+ [79 112 117 115 72 101 97 100]
+ "Opus identification header magic pattern `OpusHead'.")
+
(defconst emms-info-native--opus-channel-mapping-table
'((stream-count u8)
(coupled-count u8)
@@ -422,6 +303,132 @@ header.")
(struct emms-info-native--vorbis-comment-field-bindat-spec)))
"Opus comment header specification.")
+(defconst emms-info-native--opus-tags-magic-array
+ [79 112 117 115 84 97 103 115]
+ "Opus comment header magic pattern `OpusTags'.")
+
+;;;; Ogg code
+
+(defconst emms-info-native--ogg-page-size 65307
+ "Maximum size for a single Ogg container page.")
+
+(defconst emms-info-native--ogg-page-bindat-spec
+ '((capture-pattern vec 4)
+ (eval (unless (equal last emms-info-native--ogg-magic-array)
+ (error "Ogg framing mismatch: expected `%s', got `%s'"
+ emms-info-native--ogg-magic-array
+ last)))
+ (stream-structure-version u8)
+ (eval (unless (= last 0)
+ (error ("Ogg version mismatch: expected 0, got %s")
+ last)))
+ (header-type-flag u8)
+ (granule-position vec 8)
+ (stream-serial-number vec 4)
+ (page-sequence-no vec 4)
+ (page-checksum vec 4)
+ (page-segments u8)
+ (segment-table vec (page-segments))
+ (payload vec (eval (seq-reduce #'+ last 0))))
+ "Ogg page structure specification.")
+
+(defconst emms-info-native--ogg-magic-array
+ [79 103 103 83]
+ "Ogg format magic capture pattern `OggS'.")
+
+(defun emms-info-native--decode-ogg-comments (filename stream-type)
+ "Read and decode comments from Ogg file FILENAME.
+The file is assumed to contain a single stream of type
+STREAM-TYPE, which must either `vorbis' or `opus'.
+
+Return comments in a list of (FIELD . VALUE) cons cells. See
+`emms-info-native--split-vorbis-comment' for details."
+ (let* ((packets (emms-info-native--decode-ogg-packets filename 2))
+ (headers (emms-info-native--decode-ogg-headers packets
+ stream-type))
+ (comments (bindat-get-field headers
+ 'comment-header
+ 'user-comments)))
+ (emms-info-native--extract-vorbis-comments comments)))
+
+(defun emms-info-native--decode-ogg-packets (filename packets)
+ "Read and decode packets from Ogg file FILENAME.
+Read in data from the start of FILENAME, remove Ogg packet
+frames, and concatenate payloads until at least PACKETS number of
+packets have been decoded. Return the decoded packets in a
+vector, concatenated.
+
+Data is read in `emms-info-native--ogg-page-size' chunks. If the
+total length of concatenated packets becomes greater than
+`emms-info-native--max-peek-size', an error is signaled.
+
+Only elementary streams are supported, that is, FILENAME should
+contain only a single logical stream. Note that this assumption
+is not verified: with non-elementary streams packets from
+different streams will be mixed together without an error."
+ (let ((num-packets 0)
+ (offset 0)
+ (stream (vector)))
+ (while (< num-packets packets)
+ (let ((page (emms-info-native--decode-ogg-page filename
+ offset)))
+ (cl-incf num-packets (or (plist-get page :num-packets) 0))
+ (cl-incf offset (plist-get page :num-bytes))
+ (setq stream (vconcat stream (plist-get page :stream)))
+ (when (> (length stream) emms-info-native--max-peek-size)
+ (error "Ogg payload is too large"))))
+ stream))
+
+(defun emms-info-native--decode-ogg-page (filename offset)
+ "Read and decode a single Ogg page from FILENAME.
+Starting reading data from byte offset OFFSET.
+
+Return a plist (:num-packets N :num-bytes B :stream S), where N
+is the number of packets in the page, B is the size of the page
+in bytes, and S is the unframed logical bitstream in a vector.
+Note that N can be zero."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename
+ nil
+ offset
+ (+ offset
+ emms-info-native--ogg-page-size))
+ (let* ((page (bindat-unpack emms-info-native--ogg-page-bindat-spec
+ (buffer-string)))
+ (num-packets (emms-info-native--num-of-packets page))
+ (num-bytes (bindat-length emms-info-native--ogg-page-bindat-spec
+ page))
+ (stream (bindat-get-field page 'payload)))
+ (list :num-packets num-packets
+ :num-bytes num-bytes
+ :stream stream))))
+
+(defun emms-info-native--num-of-packets (page)
+ "Return the number of packets in Ogg page PAGE.
+PAGE must correspond to
+`emms-info-native--ogg-page-bindat-spec'."
+ ;; Every element that is less than 255 in the segment table
+ ;; represents a packet boundary.
+ (length (seq-filter (lambda (elt) (< elt 255))
+ (bindat-get-field page 'segment-table))))
+
+(defun emms-info-native--decode-ogg-headers (packets stream-type)
+ "Decode first two stream headers from PACKETS for STREAM-TYPE.
+STREAM-TYPE must be either `vorbis' or `opus'.
+
+Return a structure that corresponds to either
+`emms-info-native--opus-headers-bindat-spec' or
+`emms-info-native--vorbis-headers-bindat-spec'."
+ (cond ((eq stream-type 'vorbis)
+ (bindat-unpack emms-info-native--vorbis-headers-bindat-spec
+ packets))
+ ((eq stream-type 'opus)
+ (let (emms-info-native--opus-channel-count)
+ (bindat-unpack emms-info-native--opus-headers-bindat-spec
+ packets)))
+ (t (error "Unknown stream type %s" stream-type))))
+
;;;; FLAC code
(defconst emms-info-native--flac-metadata-block-header-bindat-spec
@@ -488,7 +495,7 @@ Return the comment block data in a vector."
(block-type (logand flags #x7F)))
(setq last-flag (> (logand flags #x80) 0))
(when (> block-type 6)
- (error "FLAC block type error: expected ≤ 6, got %s"
+ (error "FLAC block type error: expected <= 6, got %s"
block-type))
(when (= block-type 4)
;; Comment block found, extract it.
@@ -499,15 +506,6 @@ Return the comment block data in a vector."
;;;; id3v2 (MP3) code
-(defvar emms-info-native--id3v2-version 0
- "Last decoded id3v2 version.
-This is a kludge; it is needed because bindat spec cannot refer
-outside itself.")
-
-(defconst emms-info-native--id3v2-magic-array
- [#x49 #x44 #x33]
- "id3v2 header magic pattern `ID3'.")
-
(defconst emms-info-native--id3v2-header-bindat-spec
'((file-identifier vec 3)
(eval (unless (equal last emms-info-native--id3v2-magic-array)
@@ -522,6 +520,10 @@ outside itself.")
(size eval (emms-info-native--checked-id3v2-size 'tag last)))
"id3v2 header specification.")
+(defconst emms-info-native--id3v2-magic-array
+ [#x49 #x44 #x33]
+ "id3v2 header magic pattern `ID3'.")
+
(defconst emms-info-native--id3v2-frame-header-bindat-spec
'((id str (eval (if (= emms-info-native--id3v2-version 2) 3 4)))
(eval (unless (emms-info-native--valid-id3v2-frame-id-p last)