diff options
Diffstat (limited to 'emms-info-native.el')
| -rw-r--r-- | emms-info-native.el | 296 |
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) |