From bc5e51678fd96b74d1a14508d990434a423c0605 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Mon, 8 Feb 2021 00:36:13 +0200 Subject: Add id3v2 (MP3) support to emms-info-native Also adjust Ogg and FLAC decoders to return info fields in a unified format. --- emms-info-native.el | 355 ++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 287 insertions(+), 68 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index a51dad4..557debc 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -1,6 +1,6 @@ ;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; Author: Petteri Hintsanen @@ -46,12 +46,19 @@ ;; extesion ‘.flac’. Based on xiph.org’s FLAC format specification, ;; see URL ‘https://xiph.org/flac/format.html’. ;; +;; - MP3: MP3 files with extension ‘.mp3’ and id3v2 tags. All id3v2 +;; revisions should work, but many features like CRC and +;; unsynchronization are not supported. Based on id3v2 Informal +;; Standards, see URL ‘https://id3.org’. +;; ;; Format detection is based solely on filename extension, which is ;; matched case-insensitively. ;;; Code: (require 'bindat) +(require 'cl-lib) +(require 'emms-info) (defconst emms-info-native--max-peek-size (* 512 1024) "Maximum buffer size for metadata decoding. @@ -143,25 +150,23 @@ different streams will be mixed together without an error." stream))) (defun emms-info-native--ogg-decode-comments (filename stream-type) - "Decode comment header from Ogg file FILENAME. + "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 a list of comments. Depending on STREAM-TYPE, its -elements are either of type -‘emms-info-native--vorbis-comment-header-bindat-spec’ or -‘emms-info-native--opus-comment-header-bindat-spec’." - (let ((packets (emms-info-native--decode-ogg filename 2)) - stream) - (setq stream - (cond ((eq stream-type 'vorbis) - (bindat-unpack emms-info-native--vorbis-headers-bindat-spec - packets)) - ((eq stream-type 'opus) - (bindat-unpack emms-info-native--opus-headers-bindat-spec - packets)) - (t (error "Unknown stream type %s" stream-type)))) - (bindat-get-field stream 'comment-header 'user-comment))) +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 filename 2)) + (headers (cond ((eq stream-type 'vorbis) + (bindat-unpack emms-info-native--vorbis-headers-bindat-spec + packets)) + ((eq stream-type 'opus) + (bindat-unpack emms-info-native--opus-headers-bindat-spec + packets)) + (t (error "Unknown stream type %s" stream-type))))) + (emms-info-native--extract-vorbis-comments (bindat-get-field headers + 'comment-header + 'user-comments)))) ;;;; Vorbis code @@ -236,12 +241,12 @@ the data is assumed to be valid.") (eval (when (> last emms-info-native--max-vorbis-vendor-length) (error "Vorbis vendor length %s is too long" last))) (vendor-string vec (vendor-length)) - (user-comment-list-length u32r) + (user-comments-list-length u32r) (eval (when (> last emms-info-native--max-num-vorbis-comments) (error "Vorbis user comment list length %s is too long" last))) - (user-comment repeat - (user-comment-list-length) - (struct emms-info-native--vorbis-comment-field-bindat-spec)) + (user-comments repeat + (user-comments-list-length) + (struct emms-info-native--vorbis-comment-field-bindat-spec)) (framing-bit u8) (eval (unless (= last 1)) (error "Vorbis framing bit mismatch: expected 1, got %s" last))) @@ -266,6 +271,49 @@ This field is used in Opus and FLAC comment structures as well.") They are always an identification header followed by a comment header.") +(defconst emms-info-native--accepted-vorbis-fields + '("album" + "albumartist" + "albumartistsort" + "albumsort" + "artist" + "artistsort" + "composer" + "composersort" + "date" + "discnumber" + "genre" + "label" + "originaldate" + "originalyear" + "performer" + "title" + "titlesort" + "tracknumber" + "year") + "Emms info fields that are extracted from Vorbis comments.") + +(defun emms-info-native--extract-vorbis-comments (user-comments) + "Return a decoded list of comments from USER-COMMENTS. +USER-COMMENTS should be a list of Vorbis comments according to +‘user-comments’ field in +‘emms-info-native--vorbis-comment-header-bindat-spec’, +‘emms-info-native--opus-comment-header-bindat-spec’ and +‘emms-info-native--flac-comment-block-bindat-spec’. + +Return comments in a list of (FIELD . VALUE) cons cells. Only +FIELDs that are listed in +‘emms-info-native--accepted-vorbis-fields’ are returned." + (let (comments) + (dolist (user-comment user-comments) + (let* ((comment (cdr (assoc 'user-comment user-comment))) + (pair (emms-info-native--split-vorbis-comment comment))) + (push pair comments))) + (seq-filter (lambda (elt) + (member (car elt) + emms-info-native--accepted-vorbis-fields)) + comments))) + (defun emms-info-native--split-vorbis-comment (comment) "Split Vorbis comment to a field-value pair. Vorbis comments are of form ‘FIELD=VALUE’. FIELD is a @@ -273,14 +321,14 @@ case-insensitive field name with a restricted set of ASCII characters. VALUE is an arbitrary UTF-8 encoded octet stream. Return a cons cell (FIELD . VALUE), where FIELD is converted to -upper case and VALUE is the decoded value." +lower case and VALUE is the decoded value." (let ((comment-string (decode-coding-string (mapconcat #'byte-to-string comment "") 'utf-8))) (when (string-match "^\\(.+?\\)=\\(.+?\\)$" comment-string) - (cons (upcase (match-string 1 comment-string)) + (cons (downcase (match-string 1 comment-string)) (match-string 2 comment-string))))) ;;;; Opus code @@ -329,12 +377,12 @@ assumed to be valid.") (eval (when (> last emms-info-native--max-vorbis-vendor-length) (error "Opus vendor length %s is too long" last))) (vendor-string vec (vendor-length)) - (user-comment-list-length u32r) + (user-comments-list-length u32r) (eval (when (> last emms-info-native--max-num-vorbis-comments) (error "Opus user comment list length %s is too long" last))) - (user-comment repeat - (user-comment-list-length) - (struct emms-info-native--vorbis-comment-field-bindat-spec))) + (user-comments repeat + (user-comments-list-length) + (struct emms-info-native--vorbis-comment-field-bindat-spec))) "Opus comment header specification. Framing is verified. Too long vendor string and comment list will also trigger an error.") @@ -353,17 +401,17 @@ header.") (block-length u24)) "FLAC metadata block header specification.") -(defconst emms-info-native--flac-comment-bindat-spec +(defconst emms-info-native--flac-comment-block-bindat-spec '((vendor-length u32r) (eval (when (> last emms-info-native--max-vorbis-vendor-length) (error "FLAC vendor length %s is too long" last))) (vendor-string vec (vendor-length)) - (user-comment-list-length u32r) + (user-comments-list-length u32r) (eval (when (> last emms-info-native--max-num-vorbis-comments) (error "FLAC user comment list length %s is too long" last))) - (user-comment repeat - (user-comment-list-length) - (struct emms-info-native--vorbis-comment-field-bindat-spec))) + (user-comments repeat + (user-comments-list-length) + (struct emms-info-native--vorbis-comment-field-bindat-spec))) "FLAC Vorbis comment block specification. Too long vendor string and comment list will trigger an error.") @@ -436,56 +484,227 @@ encountered." (defun emms-info-native--flac-decode-comments (filename) "Read and decode comments from FLAC file FILENAME. -Return a list of comments. See -‘emms-info-native--vorbis-comment-field-bindat-spec’ for comment -structure." - (bindat-get-field (bindat-unpack emms-info-native--flac-comment-bindat-spec - (emms-info-native--flac-decode-comment-block filename)) - 'user-comment)) +Return comments in a list of (FIELD . VALUE) cons cells. Only +FIELDs that are listed in +‘emms-info-native--accepted-vorbis-fields’ are returned." + (let* ((comment-block (bindat-unpack emms-info-native--flac-comment-block-bindat-spec + (emms-info-native--flac-decode-comment-block filename))) + (user-comments (bindat-get-field comment-block + 'user-comments))) + (emms-info-native--extract-vorbis-comments user-comments))) + +;;;; id3v2 (MP3) code + +(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) + (error "id3v2 framing mismatch: expected ‘%s’, got ‘%s’" + emms-info-native--id3v2-magic-array + last))) + (version u8) + (revision u8) + (flags bits 1) + (size-bytes vec 4) + (size eval (emms-info-native--checked-id3v2-size last))) + "id3v2 header specification.") + +(defconst emms-info-native--id3v2-frame-bindat-spec + '((id str 4) + (size-bytes vec 4) + (size eval (emms-info-native--checked-id3v2-size last)) + (flags bits 2) + (payload vec (size))) + "id3v2 frame specification.") + +(defconst emms-info-native--id3v2-frame-to-info + '(("TP1" . "artist") + ("TPE1" . "artist") + ("TCM" . "composer") + ("TCOM" . "composer") + ("TIT2" . "title") + ("TT2" . "title") + ("TALB" . "album") + ("TAL" . "album") + ("TRCK" . "tracknumber") + ("TRK" . "tracknumber") + ("TPOS" . "discnumber") + ("TPA" . "discnumber") + ("TYER" . "year") + ("TYE" . "year") + ("TORY" . "originalyear") + ("TOR" . "originalyear")) + "Mapping from id3v2 frame identifiers to info fields.") + +(defconst emms-info-native--id3v2-text-encodings + '((0 . latin-1) + (1 . utf-16) + (2 . uft-16be) + (3 . utf-8)) + "id3v2 text encodings.") + +(defun emms-info-native--checked-id3v2-size (bytes) + "Calculate id3v2 element size from BYTES and check its validity. +Return the size. Signal an error if the size exceeds +‘emms-info-native--max-peek-size’." + (let ((size (emms-info-native--decode-id3v2-size bytes))) + (when (or (= size 0) + (> size emms-info-native--max-peek-size)) + (error "id3v2 tag/header/frame size %s is invalid" bytes)) + size)) + +(defun emms-info-native--decode-id3v2-size (bytes) + "Decode id3v2 element size from BYTES. +BYTES are interpreted as 7-bit bytes, MSB first. Return the +size." + (apply '+ (seq-map-indexed (lambda (elt idx) + (* (expt 2 (* 7 idx)) elt)) + (reverse bytes)))) + +(defun emms-info-native--decode-id3v2 (filename) + "Read and decode id3v2 metadata from FILENAME. +Return metadata in a list of (FIELD . VALUE) cons cells. See +‘emms-info-native--decode-id3v2-text-frame’ for details." + (let* ((header (emms-info-native--decode-id3v2-header filename)) + (tag-size (bindat-get-field header 'size)) + (offset 10)) + (when (> tag-size emms-info-native--max-peek-size) + (error "id3v2 tag size %s is too large" size)) + (when (memq 7 (bindat-get-field header 'flags)) + (error "id3v2 unsynchronisation scheme is not supported")) + (when (memq 6 (bindat-get-field header 'flags)) + ;; Skip the extended header. + (cl-incf offset + (emms-info-native--decode-id3v2-ext-header-size filename))) + (emms-info-native--decode-id3v2-frames filename + offset + (+ tag-size 10)))) + +(defun emms-info-native--decode-id3v2-header (filename) + "Read and decode id3v2 header from FILENAME." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 0 10) + (bindat-unpack emms-info-native--id3v2-header-bindat-spec + (buffer-string)))) + +(defun emms-info-native--decode-id3v2-ext-header-size (filename) + "Read and decode id3v2 extended header size from FILENAME. +Return the size. Signal an error if the size exceeds +‘emms-info-native--max-peek-size’." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 10 14) + (emms-info-native--checked-id3v2-size (buffer-string)))) + +(defun emms-info-native--decode-id3v2-frames (filename begin end) + "Read and decode id3v2 text frames from FILENAME. +BEGIN should be the offset of first byte after id3v2 header and +extended header (if any), and END should be the offset after the +complete id3v2 tag. + +Return metadata in a list of (FIELD . VALUE) cons cells. See +‘emms-info-native--decode-id3v2-text-frame’ for details." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil begin end) + (let (comments + (offset 0)) + (condition-case nil + (while (< offset end) + (let* ((frame (bindat-unpack emms-info-native--id3v2-frame-bindat-spec + (buffer-string) + offset)) + (comment (emms-info-native--decode-id3v2-text-frame + frame))) + (when comment (push comment comments)) + (cl-incf offset (+ (bindat-get-field frame 'size) + 10)))) + (error nil)) + comments))) + +(defun emms-info-native--decode-id3v2-text-frame (frame) + "Identify and decode id3v2 text frame FRAME. +If FRAME’s identifier matches a key in +‘emms-info-native--id3v2-frame-to-info’, return a cons cell +(FIELD . VALUE), where FIELD is the corresponding info field +identifier and VALUE is the decoded text. Otherwise return nil." + (let ((info-id (emms-info-native--id3v2-frame-info-id frame)) + (payload (bindat-get-field frame 'payload))) + (when info-id + (cons info-id + (emms-info-native--decode-id3v2-string payload))))) + +(defun emms-info-native--id3v2-frame-info-id (frame) + "Return the emms-info identifier for FRAME. +If there is no such identifier, return nil." + (cdr (assoc (bindat-get-field frame 'id) + emms-info-native--id3v2-frame-to-info))) + +(defun emms-info-native--decode-id3v2-string (bytes) + "Decode id3v2 text information. +Return the text in BYTES as string." + (let ((encoding (emms-info-native--id3v2-text-encoding bytes)) + (string (mapconcat #'byte-to-string (seq-rest bytes) ""))) + ;; Discard the null terminator. + (substring (decode-coding-string string encoding) 0 -1))) + +(defun emms-info-native--id3v2-text-encoding (bytes) + "Return the encoding for text information BYTES." + (cdr (assoc (seq-first bytes) + emms-info-native--id3v2-text-encodings))) ;;;; EMMS code +(defun emms-info-native (track) + "Set info fields for TRACK. +Supports Ogg Vorbis/Opus, FLAC, and MP3 files. + +Return t if TRACK was updated, nil otherwise." + (let* ((filename (emms-track-name track)) + (info-fields (emms-info-native--decode-info-fields filename)) + update-flag) + (dolist (field info-fields) + (let ((name (intern (concat "info-" (car field)))) + (value (cdr field))) + (setq update-flag (or update-flag name)) + (emms-track-set track + name + (if (eq name 'info-playing-time) + (string-to-number value) + value)))) + update-flag)) + +(defun emms-info-native--decode-info-fields (filename) + "Decode info fields from FILENAME. +Return a list of (FIELD . VALUE) cons cells, where FIELD is an +info field and VALUE is the corresponding info value. Both are +strings." + (let ((stream-type (emms-info-native--find-stream-type filename))) + (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus)) + (emms-info-native--ogg-decode-comments filename stream-type)) + ((eq stream-type 'flac) + (emms-info-native--flac-decode-comments filename)) + ((eq stream-type 'mp3) + (emms-info-native--decode-id3v2 filename)) + (t nil)))) + (defun emms-info-native--find-stream-type (filename) "Deduce the stream type from FILENAME. This is a naive implementation that relies solely on filename extension. -Return one of symbols ‘vorbis’, ‘opus’, or ‘flac’." +Return one of symbols ‘vorbis’, ‘opus’, ‘flac’, or ‘mp3’." (let ((case-fold-search t)) (cond ((string-match ".ogg$" filename) 'vorbis) ((string-match ".opus$" filename) 'opus) ((string-match ".flac$" filename) 'flac) + ((string-match ".mp3$" filename) 'mp3) (t nil)))) -(defun emms-info-native (track) - "Set info fields for TRACK. -Supports Ogg Vorbis/Opus and FLAC files. - -Return t if TRACK was updated, nil otherwise." - (let* ((filename (emms-track-name track)) - (stream-type (emms-info-native--find-stream-type filename)) - (comments) - update-flag) - (setq comments - (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus)) - (emms-info-native--ogg-decode-comments filename stream-type)) - ((eq stream-type 'flac) - (emms-info-native--flac-decode-comments filename)) - (t nil))) - (dolist (comment comments) - (let ((pair (emms-info-native--split-vorbis-comment - (cdr (assoc 'user-comment comment))))) - (when pair - (let ((name (intern-soft (concat "info-" (downcase (car pair))))) - (value (cdr pair))) - (setq update-flag (or update-flag name)) - (emms-track-set track - name - (if (eq name 'info-playing-time) - (string-to-number value) - value)))))) - update-flag)) - (provide 'emms-info-native) ;;; emms-info-native.el ends here -- cgit v1.2.3 From 9c8d96194d815bb24c2243a9f1361726fd6e21b0 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Mon, 8 Feb 2021 19:59:02 +0200 Subject: Simplify Ogg-related code Split long functions to smaller functions that are easier to understand. --- emms-info-native.el | 153 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 89 insertions(+), 64 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index 557debc..e275e87 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -63,10 +63,10 @@ (defconst emms-info-native--max-peek-size (* 512 1024) "Maximum buffer size for metadata decoding. Functions called by ‘emms-info-native’ read certain amounts of -data into a temporary buffer while attempting to read metadata -information. This variable controls the maximum size of that -buffer: if more than ‘emms-info-native--max-peek-size’ bytes are -needed, an error is signaled. +data into a temporary buffer while decoding metadata. This +variable controls the maximum size of that buffer: if more than +‘emms-info-native--max-peek-size’ bytes are needed, an error is +signaled. Technically metadata blocks can have almost arbitrary lengths, but in practice processing must be constrained to prevent memory @@ -79,18 +79,17 @@ exhaustion in case of garbled or malicious inputs.") "Ogg format magic capture pattern ‘OggS’.") (defconst emms-info-native--ogg-page-size 65307 - "Maximum size for a single Ogg container page. -Ogg files are read in chunks of this size during decoding.") + "Maximum size for a single Ogg container page.") (defconst emms-info-native--ogg-page-bindat-spec '((capture-pattern vec 4) - (eval (when (not (equal last emms-info-native--ogg-magic-array)) + (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 (when (not (= last 0)) - (error ("Ogg stream structure version mismatch: expected 0, got %s") + (eval (unless (= last 0) + (error ("Ogg version mismatch: expected 0, got %s") last))) (header-type-flag u8) (granule-position vec 8) @@ -100,12 +99,25 @@ Ogg files are read in chunks of this size during decoding.") (page-segments u8) (segment-table vec (page-segments)) (payload vec (eval (seq-reduce #'+ last 0)))) - "Ogg page structure specification. -Framing and stream structure versions are verified, otherwise the -data is assumed to be valid.") + "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’. -(defun emms-info-native--decode-ogg (filename packets) - "Decode at least PACKETS number of packets from Ogg file FILENAME. +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 @@ -119,54 +131,67 @@ 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." - (with-temp-buffer - (set-buffer-multibyte nil) - (let ((npackets 0) - (offset 0) - (stream (vector)) - page) - (while (< npackets packets) - (insert-file-contents-literally filename - nil - offset - (+ offset - emms-info-native--ogg-page-size) - t) - (setq page - (bindat-unpack emms-info-native--ogg-page-bindat-spec - (buffer-string))) - (setq offset - (+ offset - (bindat-length emms-info-native--ogg-page-bindat-spec page))) - (setq stream (vconcat stream (bindat-get-field page 'payload))) + (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")) - ;; Look for packet boundaries: every element that is less than 255 - ;; in the segment table represents a packet boundary. - (setq npackets - (+ (length (seq-filter (lambda (elt) (< elt 255)) - (bindat-get-field page 'segment-table))) - npackets))) - stream))) - -(defun emms-info-native--ogg-decode-comments (filename stream-type) - "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’. + (error "Ogg payload is too large")))) + stream)) -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 filename 2)) - (headers (cond ((eq stream-type 'vorbis) - (bindat-unpack emms-info-native--vorbis-headers-bindat-spec - packets)) - ((eq stream-type 'opus) - (bindat-unpack emms-info-native--opus-headers-bindat-spec - packets)) - (t (error "Unknown stream type %s" stream-type))))) - (emms-info-native--extract-vorbis-comments (bindat-get-field headers - 'comment-header - 'user-comments)))) +(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) + (bindat-unpack emms-info-native--opus-headers-bindat-spec + packets)) + (t (error "Unknown stream type %s" stream-type)))) ;;;; Vorbis code @@ -257,7 +282,7 @@ string and comment list will also trigger an error.") (defconst emms-info-native--vorbis-comment-field-bindat-spec '((length u32r) (eval (when (> last emms-info-native--max-vorbis-comment-size) - (error "Vorbis comment is too long, length %s" last))) + (error "Vorbis comment length %s is too long" last))) (user-comment vec (length))) "Vorbis comment field specification. Too long comment will trigger an error. @@ -267,7 +292,7 @@ This field is used in Opus and FLAC comment structures as well.") (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)) - "Specification for two first Vorbis header packets. + "Specification for first two Vorbis header packets. They are always an identification header followed by a comment header.") @@ -298,7 +323,7 @@ header.") USER-COMMENTS should be a list of Vorbis comments according to ‘user-comments’ field in ‘emms-info-native--vorbis-comment-header-bindat-spec’, -‘emms-info-native--opus-comment-header-bindat-spec’ and +‘emms-info-native--opus-comment-header-bindat-spec’ or ‘emms-info-native--flac-comment-block-bindat-spec’. Return comments in a list of (FIELD . VALUE) cons cells. Only @@ -685,7 +710,7 @@ info field and VALUE is the corresponding info value. Both are strings." (let ((stream-type (emms-info-native--find-stream-type filename))) (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus)) - (emms-info-native--ogg-decode-comments filename stream-type)) + (emms-info-native--decode-ogg-comments filename stream-type)) ((eq stream-type 'flac) (emms-info-native--flac-decode-comments filename)) ((eq stream-type 'mp3) -- cgit v1.2.3 From bf223840ab1a7f1582d399b8ffc40cc5ba0e6938 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Mon, 8 Feb 2021 20:04:36 +0200 Subject: Clean up Vorbis code These are only stylistic changes. --- emms-info-native.el | 41 +++++++++++++++++++---------------------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index e275e87..f253791 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -228,17 +228,18 @@ their comments have almost the same format as Vorbis.") (defconst emms-info-native--vorbis-identification-header-bindat-spec '((packet-type u8) - (eval (when (not (= last 1)) - (error "Vorbis identification header type mismatch: expected 1, got %s" + (eval (unless (= last 1) + (error "Vorbis header type mismatch: expected 1, got %s" last))) (vorbis vec 6) - (eval (when (not (equal last emms-info-native--vorbis-magic-array)) + (eval (unless (equal last emms-info-native--vorbis-magic-array) (error "Vorbis framing mismatch: expected ‘%s’, got ‘%s’" emms-info-native--vorbis-magic-array last))) (vorbis-version u32r) - (eval (when (not (= last 0)) - (error "Vorbis version mismatch: expected 0, got %s" last))) + (eval (unless (= last 0) + (error "Vorbis version mismatch: expected 0, got %s" + last))) (audio-channels u8) (audio-sample-rate u32r) (bitrate-maximum u32r) @@ -247,18 +248,17 @@ their comments have almost the same format as Vorbis.") (blocksize u8) (framing-flag u8) (eval (unless (= last 1)) - (error "Vorbis framing bit mismatch: expected 1, got %s" last))) - "Vorbis identification header specification. -Identification, framing and version data are verified, otherwise -the data is assumed to be valid.") + (error "Vorbis framing bit mismatch: expected 1, got %s" + last))) + "Vorbis identification header specification.") (defconst emms-info-native--vorbis-comment-header-bindat-spec '((packet-type u8) - (eval (when (not (= last 3)) - (error "Vorbis comment header type mismatch: expected 3, got %s" + (eval (unless (= last 3) + (error "Vorbis header type mismatch: expected 3, got %s" last))) (vorbis vec 6) - (eval (when (not (equal last emms-info-native--vorbis-magic-array)) + (eval (unless (equal last emms-info-native--vorbis-magic-array) (error "Vorbis framing mismatch: expected ‘%s’, got ‘%s’" emms-info-native--vorbis-magic-array last))) @@ -268,26 +268,23 @@ the data is assumed to be valid.") (vendor-string vec (vendor-length)) (user-comments-list-length u32r) (eval (when (> last emms-info-native--max-num-vorbis-comments) - (error "Vorbis user comment list length %s is too long" last))) + (error "Vorbis user comment list length %s is too long" + last))) (user-comments repeat (user-comments-list-length) (struct emms-info-native--vorbis-comment-field-bindat-spec)) (framing-bit u8) (eval (unless (= last 1)) - (error "Vorbis framing bit mismatch: expected 1, got %s" last))) - "Vorbis comment header specification. -Header type and framing data are verified. Too long vendor -string and comment list will also trigger an error.") + (error "Vorbis framing bit mismatch: expected 1, got %s" + last))) + "Vorbis comment header specification.") (defconst emms-info-native--vorbis-comment-field-bindat-spec '((length u32r) (eval (when (> last emms-info-native--max-vorbis-comment-size) (error "Vorbis comment length %s is too long" last))) (user-comment vec (length))) - "Vorbis comment field specification. -Too long comment will trigger an error. - -This field is used in Opus and FLAC comment structures as well.") + "Vorbis comment field specification.") (defconst emms-info-native--vorbis-headers-bindat-spec '((identification-header struct emms-info-native--vorbis-identification-header-bindat-spec) @@ -350,7 +347,7 @@ lower case and VALUE is the decoded value." (let ((comment-string (decode-coding-string (mapconcat #'byte-to-string comment - "") + nil) 'utf-8))) (when (string-match "^\\(.+?\\)=\\(.+?\\)$" comment-string) (cons (downcase (match-string 1 comment-string)) -- cgit v1.2.3 From b8e1de743ba4a346044225ba68a688e2ead0d590 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Mon, 8 Feb 2021 20:06:20 +0200 Subject: Clean up Opus code These are only stylistic changes. --- emms-info-native.el | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index f253791..39b4fd9 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -371,13 +371,13 @@ lower case and VALUE is the decoded value." (defconst emms-info-native--opus-identification-header-bindat-spec '((opus-head vec 8) - (eval (when (not (equal last emms-info-native--opus-head-magic-array)) + (eval (unless (equal last emms-info-native--opus-head-magic-array) (error "Opus framing mismatch: expected ‘%s’, got ‘%s’" emms-info-native--opus-head-magic-array last))) (opus-version u8) - (eval (when (not (< last 16)) - (error "Opus version mismatch: expected less than 16, got %s" + (eval (unless (< last 16) + (error "Opus version mismatch: expected < 16, got %s" last))) (channel-count u8) (pre-skip u16r) @@ -385,13 +385,11 @@ lower case and VALUE is the decoded value." (output-gain u16r) (channel-mapping-family u8) (eval (> last 0) (struct opus-channel-mapping-table))) - "Opus identification header specification. -Framing and version data are verified, otherwise the data is -assumed to be valid.") + "Opus identification header specification.") (defconst emms-info-native--opus-comment-header-bindat-spec '((opus-tags vec 8) - (eval (when (not (equal last emms-info-native--opus-tags-magic-array)) + (eval (unless (equal last emms-info-native--opus-tags-magic-array) (error "Opus framing mismatch: expected ‘%s’, got ‘%s’" emms-info-native--opus-tags-magic-array last))) @@ -401,13 +399,12 @@ assumed to be valid.") (vendor-string vec (vendor-length)) (user-comments-list-length u32r) (eval (when (> last emms-info-native--max-num-vorbis-comments) - (error "Opus user comment list length %s is too long" last))) + (error "Opus user comment list length %s is too long" + last))) (user-comments repeat (user-comments-list-length) (struct emms-info-native--vorbis-comment-field-bindat-spec))) - "Opus comment header specification. -Framing is verified. Too long vendor string and comment list -will also trigger an error.") + "Opus comment header specification.") (defconst emms-info-native--opus-headers-bindat-spec '((identification-header struct emms-info-native--opus-identification-header-bindat-spec) -- cgit v1.2.3 From 810dd41b18cf9632b40c59ce99b6e00fee33a5c5 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Tue, 9 Feb 2021 21:57:46 +0200 Subject: Fix typos in Commentary --- emms-info-native.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index 39b4fd9..4786dfe 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -34,17 +34,17 @@ ;; The following file formats are supported: ;; ;; - Vorbis: Ogg Vorbis I Profile, filename extension ‘.ogg’, -;; elemetary streams only. Based on xiph.org’s Vorbis I +;; elementary streams only. Based on xiph.org’s Vorbis I ;; specification, see URL ;; ‘https://xiph.org/vorbis/doc/Vorbis_I_spec.html’. ;; -;; - Opus: Ogg Opus profile, filename extesion ‘.opus’, elementary +;; - Opus: Ogg Opus profile, filename extension ‘.opus’, elementary ;; streams only. Based on RFC 7845, see URL ;; ‘https://tools.ietf.org/html/rfc7845.html’. ;; ;; - FLAC: FLAC streams in native encapsulation format, filename -;; extesion ‘.flac’. Based on xiph.org’s FLAC format specification, -;; see URL ‘https://xiph.org/flac/format.html’. +;; extension ‘.flac’. Based on xiph.org’s FLAC format +;; specification, see URL ‘https://xiph.org/flac/format.html’. ;; ;; - MP3: MP3 files with extension ‘.mp3’ and id3v2 tags. All id3v2 ;; revisions should work, but many features like CRC and -- cgit v1.2.3 From 7479d7d8f39a926a982ad6dceec34df5b7d91a64 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Wed, 10 Feb 2021 01:06:34 +0200 Subject: Use lexical binding --- emms-info-native.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/emms-info-native.el b/emms-info-native.el index 4786dfe..669f3f3 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -1,4 +1,4 @@ -;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS +;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS -*- lexical-binding: t; -*- ;; Copyright (C) 2020-2021 Free Software Foundation, Inc. -- cgit v1.2.3 From a3729763e260a9ae2e7d1b9e49c27b83ca92f7a7 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Wed, 10 Feb 2021 01:07:10 +0200 Subject: Fix Opus channel mapping decoding MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It seems that bindat specs cannot refer outside themselves, so use a special variable ‘emms-info-native--opus-channel-count’ with dynamic binding to keep track of channel count. --- emms-info-native.el | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index 669f3f3..dc2bbbd 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -189,8 +189,9 @@ Return a structure that corresponds to either (bindat-unpack emms-info-native--vorbis-headers-bindat-spec packets)) ((eq stream-type 'opus) - (bindat-unpack emms-info-native--opus-headers-bindat-spec - packets)) + (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)))) ;;;; Vorbis code @@ -355,6 +356,11 @@ 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’.") @@ -366,7 +372,7 @@ lower case and VALUE is the decoded value." (defconst emms-info-native--opus-channel-mapping-table '((stream-count u8) (coupled-count u8) - (channel-mapping vec (channel-count))) + (channel-mapping vec (eval emms-info-native--opus-channel-count))) "Opus channel mapping table specification.") (defconst emms-info-native--opus-identification-header-bindat-spec @@ -380,11 +386,14 @@ lower case and VALUE is the decoded value." (error "Opus version mismatch: expected < 16, got %s" last))) (channel-count u8) + (eval (setq emms-info-native--opus-channel-count last)) (pre-skip u16r) (sample-rate u32r) (output-gain u16r) (channel-mapping-family u8) - (eval (> last 0) (struct opus-channel-mapping-table))) + (union (channel-mapping-family) + (0 nil) + (t (struct emms-info-native--opus-channel-mapping-table)))) "Opus identification header specification.") (defconst emms-info-native--opus-comment-header-bindat-spec -- cgit v1.2.3 From 6e5d477316da03f2203cc934ebf774ff78403f29 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Wed, 10 Feb 2021 23:26:35 +0200 Subject: Simplify FLAC code Clean up block decoder and fix incorrect last-flag calculation. --- emms-info-native.el | 108 ++++++++++++++++++++-------------------------------- 1 file changed, 42 insertions(+), 66 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index dc2bbbd..91b3ff5 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -425,8 +425,11 @@ header.") ;;;; FLAC code (defconst emms-info-native--flac-metadata-block-header-bindat-spec - '((block-type u8) - (block-length u24)) + '((flags u8) + (length u24) + (eval (when (or (> last emms-info-native--max-peek-size) + (= last 0)) + (error "FLAC block length %s is invalid" last)))) "FLAC metadata block header specification.") (defconst emms-info-native--flac-comment-block-bindat-spec @@ -436,12 +439,12 @@ header.") (vendor-string vec (vendor-length)) (user-comments-list-length u32r) (eval (when (> last emms-info-native--max-num-vorbis-comments) - (error "FLAC user comment list length %s is too long" last))) + (error "FLAC user comment list length %s is too long" + last))) (user-comments repeat (user-comments-list-length) (struct emms-info-native--vorbis-comment-field-bindat-spec))) - "FLAC Vorbis comment block specification. -Too long vendor string and comment list will trigger an error.") + "FLAC Vorbis comment block specification.") (defun emms-info-native--has-flac-signature (filename) "Check for FLAC stream marker at the beginning of FILENAME. @@ -451,74 +454,47 @@ Return t if there is a valid stream marker, nil otherwise." (insert-file-contents-literally filename nil 0 4) (looking-at "fLaC"))) -(defun emms-info-native--flac-decode-block-header (filename offset) - "Read and decode FLAC metadata block header from FILENAME starting at OFFSET. -Return a list (TYPE NEXT-OFFSET LAST). Here, TYPE is the FLAC -metadata block type; NEXT-OFFSET is the starting offset of the -next block; and LAST is t if this was the last metadata block in -the stream, otherwise nil." - (let (block-header - block-type - block-length - end - last-flag) - (insert-file-contents-literally filename nil offset (+ offset 4) t) - (setq offset (+ offset 4)) - (setq block-header - (bindat-unpack emms-info-native--flac-metadata-block-header-bindat-spec - (buffer-string))) - (setq block-type - (logand (bindat-get-field block-header 'block-type) - #x7F)) - (setq block-length (bindat-get-field block-header 'block-length)) - (when (> block-type 6) - (error "FLAC block type error: expected <= 6, got %s" block-type)) - (when (= block-length 0) - (error "FLAC block length error: expected >0, got zero")) - (setq last-flag (= (logand (bindat-get-field block-header 'block-type) - #x80) - 1)) - (setq end (+ offset block-length)) - (list block-type end last-flag))) - -(defun emms-info-native--flac-decode-comment-block (filename) - "Find and decode a comment block from FLAC file FILENAME. -Return the comment block in a vector. Trigger an error if any -metadata block larger than ‘emms-info-native--max-peek-size’ is -encountered." +(defun emms-info-native--decode-flac-comment-block (filename) + "Read and decode a comment block from FLAC file FILENAME. +Return the comment block data in a vector." (with-temp-buffer (set-buffer-multibyte nil) - (unless (emms-info-native--has-flac-signature filename) - (error "Invalid FLAC stream")) - (let ((offset 4) - (comment-block (vector)) - block-type - end - last-flag) - (while (not last-flag) - (cl-multiple-value-setq (block-type - end - last-flag) - (emms-info-native--flac-decode-block-header filename offset)) - (when (> (- end offset) emms-info-native--max-peek-size) - (error "FLAC metadata block is too large: %s" (- end offset))) - (when (= block-type 4) - ;; Comment block found, extract it. - (insert-file-contents-literally filename nil (+ offset 4) end t) - (setq comment-block (vconcat (buffer-string)) - last-flag t)) - (setq offset end)) + (let (comment-block + last-flag + (offset 4)) + (while (and (not comment-block) (not last-flag)) + (insert-file-contents-literally filename + nil + offset + (cl-incf offset 4)) + (let* ((header (bindat-unpack emms-info-native--flac-metadata-block-header-bindat-spec + (buffer-string))) + (end (+ offset (bindat-get-field header 'length))) + (flags (bindat-get-field header 'flags)) + (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" + block-type)) + (when (= block-type 4) + ;; Comment block found, extract it. + (insert-file-contents-literally filename nil offset end t) + (setq comment-block (vconcat (buffer-string)))) + (setq offset end))) comment-block))) -(defun emms-info-native--flac-decode-comments (filename) +(defun emms-info-native--decode-flac-comments (filename) "Read and decode comments from FLAC file FILENAME. Return comments in a list of (FIELD . VALUE) cons cells. Only FIELDs that are listed in ‘emms-info-native--accepted-vorbis-fields’ are returned." - (let* ((comment-block (bindat-unpack emms-info-native--flac-comment-block-bindat-spec - (emms-info-native--flac-decode-comment-block filename))) - (user-comments (bindat-get-field comment-block - 'user-comments))) + (unless (emms-info-native--has-flac-signature filename) + (error "Invalid FLAC stream")) + (let* ((block (emms-info-native--decode-flac-comment-block + filename)) + (unpacked (bindat-unpack emms-info-native--flac-comment-block-bindat-spec + block)) + (user-comments (bindat-get-field unpacked 'user-comments))) (emms-info-native--extract-vorbis-comments user-comments))) ;;;; id3v2 (MP3) code @@ -715,7 +691,7 @@ strings." (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus)) (emms-info-native--decode-ogg-comments filename stream-type)) ((eq stream-type 'flac) - (emms-info-native--flac-decode-comments filename)) + (emms-info-native--decode-flac-comments filename)) ((eq stream-type 'mp3) (emms-info-native--decode-id3v2 filename)) (t nil)))) -- cgit v1.2.3 From 0f11ae182ceb12bcbbbac041af74585ac182c514 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Wed, 10 Feb 2021 23:53:29 +0200 Subject: Reorder functions and constants Constructs are now ordered from generic to specific ("top-down") and are thus, hopefully, easier to follow. --- emms-info-native.el | 150 +++++++++++++++++++++++++--------------------------- 1 file changed, 73 insertions(+), 77 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index 91b3ff5..e0b3906 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -223,10 +223,39 @@ exhaustion in case of garbled or malicious inputs. This limit is used with Opus and FLAC streams as well, since their comments have almost the same format as Vorbis.") +(defconst emms-info-native--accepted-vorbis-fields + '("album" + "albumartist" + "albumartistsort" + "albumsort" + "artist" + "artistsort" + "composer" + "composersort" + "date" + "discnumber" + "genre" + "label" + "originaldate" + "originalyear" + "performer" + "title" + "titlesort" + "tracknumber" + "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)) + "Specification for first two Vorbis header packets. +They are always an identification header followed by a comment +header.") + (defconst emms-info-native--vorbis-identification-header-bindat-spec '((packet-type u8) (eval (unless (= last 1) @@ -287,35 +316,6 @@ their comments have almost the same format as Vorbis.") (user-comment vec (length))) "Vorbis comment field specification.") -(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)) - "Specification for first two Vorbis header packets. -They are always an identification header followed by a comment -header.") - -(defconst emms-info-native--accepted-vorbis-fields - '("album" - "albumartist" - "albumartistsort" - "albumsort" - "artist" - "artistsort" - "composer" - "composersort" - "date" - "discnumber" - "genre" - "label" - "originaldate" - "originalyear" - "performer" - "title" - "titlesort" - "tracknumber" - "year") - "Emms info fields that are extracted from Vorbis comments.") - (defun emms-info-native--extract-vorbis-comments (user-comments) "Return a decoded list of comments from USER-COMMENTS. USER-COMMENTS should be a list of Vorbis comments according to @@ -369,11 +369,12 @@ outside itself.") [79 112 117 115 84 97 103 115] "Opus comment header magic pattern ‘OpusTags’.") -(defconst emms-info-native--opus-channel-mapping-table - '((stream-count u8) - (coupled-count u8) - (channel-mapping vec (eval emms-info-native--opus-channel-count))) - "Opus channel mapping table specification.") +(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)) + "Specification for two first Opus header packets. +They are always an identification header followed by a comment +header.") (defconst emms-info-native--opus-identification-header-bindat-spec '((opus-head vec 8) @@ -396,6 +397,12 @@ outside itself.") (t (struct emms-info-native--opus-channel-mapping-table)))) "Opus identification header specification.") +(defconst emms-info-native--opus-channel-mapping-table + '((stream-count u8) + (coupled-count u8) + (channel-mapping vec (eval emms-info-native--opus-channel-count))) + "Opus channel mapping table specification.") + (defconst emms-info-native--opus-comment-header-bindat-spec '((opus-tags vec 8) (eval (unless (equal last emms-info-native--opus-tags-magic-array) @@ -415,13 +422,6 @@ outside itself.") (struct emms-info-native--vorbis-comment-field-bindat-spec))) "Opus comment header specification.") -(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)) - "Specification for two first Opus header packets. -They are always an identification header followed by a comment -header.") - ;;;; FLAC code (defconst emms-info-native--flac-metadata-block-header-bindat-spec @@ -446,6 +446,20 @@ header.") (struct emms-info-native--vorbis-comment-field-bindat-spec))) "FLAC Vorbis comment block specification.") +(defun emms-info-native--decode-flac-comments (filename) + "Read and decode comments from FLAC file FILENAME. +Return comments in a list of (FIELD . VALUE) cons cells. Only +FIELDs that are listed in +‘emms-info-native--accepted-vorbis-fields’ are returned." + (unless (emms-info-native--has-flac-signature filename) + (error "Invalid FLAC stream")) + (let* ((block (emms-info-native--decode-flac-comment-block + filename)) + (unpacked (bindat-unpack emms-info-native--flac-comment-block-bindat-spec + block)) + (user-comments (bindat-get-field unpacked 'user-comments))) + (emms-info-native--extract-vorbis-comments user-comments))) + (defun emms-info-native--has-flac-signature (filename) "Check for FLAC stream marker at the beginning of FILENAME. Return t if there is a valid stream marker, nil otherwise." @@ -483,20 +497,6 @@ Return the comment block data in a vector." (setq offset end))) comment-block))) -(defun emms-info-native--decode-flac-comments (filename) - "Read and decode comments from FLAC file FILENAME. -Return comments in a list of (FIELD . VALUE) cons cells. Only -FIELDs that are listed in -‘emms-info-native--accepted-vorbis-fields’ are returned." - (unless (emms-info-native--has-flac-signature filename) - (error "Invalid FLAC stream")) - (let* ((block (emms-info-native--decode-flac-comment-block - filename)) - (unpacked (bindat-unpack emms-info-native--flac-comment-block-bindat-spec - block)) - (user-comments (bindat-get-field unpacked 'user-comments))) - (emms-info-native--extract-vorbis-comments user-comments))) - ;;;; id3v2 (MP3) code (defconst emms-info-native--id3v2-magic-array @@ -550,24 +550,6 @@ FIELDs that are listed in (3 . utf-8)) "id3v2 text encodings.") -(defun emms-info-native--checked-id3v2-size (bytes) - "Calculate id3v2 element size from BYTES and check its validity. -Return the size. Signal an error if the size exceeds -‘emms-info-native--max-peek-size’." - (let ((size (emms-info-native--decode-id3v2-size bytes))) - (when (or (= size 0) - (> size emms-info-native--max-peek-size)) - (error "id3v2 tag/header/frame size %s is invalid" bytes)) - size)) - -(defun emms-info-native--decode-id3v2-size (bytes) - "Decode id3v2 element size from BYTES. -BYTES are interpreted as 7-bit bytes, MSB first. Return the -size." - (apply '+ (seq-map-indexed (lambda (elt idx) - (* (expt 2 (* 7 idx)) elt)) - (reverse bytes)))) - (defun emms-info-native--decode-id3v2 (filename) "Read and decode id3v2 metadata from FILENAME. Return metadata in a list of (FIELD . VALUE) cons cells. See @@ -604,6 +586,22 @@ Return the size. Signal an error if the size exceeds (insert-file-contents-literally filename nil 10 14) (emms-info-native--checked-id3v2-size (buffer-string)))) +(defun emms-info-native--checked-id3v2-size (bytes) + "Calculate id3v2 element size from BYTES and check its validity. +Return the size." + (let ((size (emms-info-native--decode-id3v2-size bytes))) + (when (or (= size 0) (> size emms-info-native--max-peek-size)) + (error "id3v2 tag/header/frame size %s is invalid" bytes)) + size)) + +(defun emms-info-native--decode-id3v2-size (bytes) + "Decode id3v2 element size from BYTES. +BYTES are interpreted as 7-bit bytes, MSB first. Return the +size." + (apply '+ (seq-map-indexed (lambda (elt idx) + (* (expt 2 (* 7 idx)) elt)) + (reverse bytes)))) + (defun emms-info-native--decode-id3v2-frames (filename begin end) "Read and decode id3v2 text frames from FILENAME. BEGIN should be the offset of first byte after id3v2 header and @@ -625,8 +623,7 @@ Return metadata in a list of (FIELD . VALUE) cons cells. See (comment (emms-info-native--decode-id3v2-text-frame frame))) (when comment (push comment comments)) - (cl-incf offset (+ (bindat-get-field frame 'size) - 10)))) + (cl-incf offset (+ (bindat-get-field frame 'size) 10)))) (error nil)) comments))) @@ -639,8 +636,7 @@ identifier and VALUE is the decoded text. Otherwise return nil." (let ((info-id (emms-info-native--id3v2-frame-info-id frame)) (payload (bindat-get-field frame 'payload))) (when info-id - (cons info-id - (emms-info-native--decode-id3v2-string payload))))) + (cons info-id (emms-info-native--decode-id3v2-string payload))))) (defun emms-info-native--id3v2-frame-info-id (frame) "Return the emms-info identifier for FRAME. -- cgit v1.2.3 From 4a4a358409fad05c997465b9c3ad800c24f7ec06 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Thu, 11 Feb 2021 00:09:41 +0200 Subject: Remove emms-info-native return value The value was wrong and not used anyway. --- emms-info-native.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index e0b3906..4f5555a 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -661,22 +661,17 @@ Return the text in BYTES as string." (defun emms-info-native (track) "Set info fields for TRACK. -Supports Ogg Vorbis/Opus, FLAC, and MP3 files. - -Return t if TRACK was updated, nil otherwise." +Supports Ogg Vorbis/Opus, FLAC, and MP3 files." (let* ((filename (emms-track-name track)) - (info-fields (emms-info-native--decode-info-fields filename)) - update-flag) + (info-fields (emms-info-native--decode-info-fields filename))) (dolist (field info-fields) (let ((name (intern (concat "info-" (car field)))) (value (cdr field))) - (setq update-flag (or update-flag name)) (emms-track-set track name (if (eq name 'info-playing-time) (string-to-number value) - value)))) - update-flag)) + value)))))) (defun emms-info-native--decode-info-fields (filename) "Decode info fields from FILENAME. -- cgit v1.2.3 From dbcc6143ce6730669a76c57fd3fb25981df74be5 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Mon, 15 Feb 2021 22:45:38 +0200 Subject: Fix id3v2 bugs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Tag-level id3v2 unsynchronization is now supported. Frame-level unsynchronization is still missing, and likely won’t be implemented at all. - Fix frame size decoding between different id3v2 versions. - Use correct id3v2.2 sizes during decoding. - Remove a terminating null byte from text strings only if there is one. --- emms-info-native.el | 152 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 102 insertions(+), 50 deletions(-) diff --git a/emms-info-native.el b/emms-info-native.el index 4f5555a..93621b4 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -42,14 +42,14 @@ ;; streams only. Based on RFC 7845, see URL ;; ‘https://tools.ietf.org/html/rfc7845.html’. ;; -;; - FLAC: FLAC streams in native encapsulation format, filename -;; extension ‘.flac’. Based on xiph.org’s FLAC format -;; specification, see URL ‘https://xiph.org/flac/format.html’. +;; - FLAC streams in native encapsulation format, filename extension +;; ‘.flac’. Based on xiph.org’s FLAC format specification, see URL +;; ‘https://xiph.org/flac/format.html’. ;; -;; - MP3: MP3 files with extension ‘.mp3’ and id3v2 tags. All id3v2 -;; revisions should work, but many features like CRC and -;; unsynchronization are not supported. Based on id3v2 Informal -;; Standards, see URL ‘https://id3.org’. +;; - MP3 files with extension ‘.mp3’ and id3v2 tags. All id3v2 +;; versions should work, but many features like CRC, compression and +;; encryption are not supported. Based on id3v2 Informal Standards, +;; see URL ‘https://id3.org’. ;; ;; Format detection is based solely on filename extension, which is ;; matched case-insensitively. @@ -60,7 +60,7 @@ (require 'cl-lib) (require 'emms-info) -(defconst emms-info-native--max-peek-size (* 512 1024) +(defconst emms-info-native--max-peek-size (* 2048 1024) "Maximum buffer size for metadata decoding. Functions called by ‘emms-info-native’ read certain amounts of data into a temporary buffer while decoding metadata. This @@ -499,6 +499,11 @@ 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’.") @@ -510,23 +515,25 @@ Return the comment block data in a vector." emms-info-native--id3v2-magic-array last))) (version u8) + (eval (setq emms-info-native--id3v2-version last)) (revision u8) (flags bits 1) (size-bytes vec 4) - (size eval (emms-info-native--checked-id3v2-size last))) + (size eval (emms-info-native--checked-id3v2-size 'tag last))) "id3v2 header specification.") (defconst emms-info-native--id3v2-frame-bindat-spec - '((id str 4) - (size-bytes vec 4) - (size eval (emms-info-native--checked-id3v2-size last)) - (flags bits 2) + '((id str (eval (if (= emms-info-native--id3v2-version 2) 3 4))) + (size-bytes vec (eval (if (= emms-info-native--id3v2-version 2) 3 4))) + (size eval (emms-info-native--checked-id3v2-size 'frame last)) + (flags bits (eval (if (= emms-info-native--id3v2-version 2) 0 2))) (payload vec (size))) "id3v2 frame specification.") (defconst emms-info-native--id3v2-frame-to-info '(("TP1" . "artist") ("TPE1" . "artist") + ("TPE2" . "albumartist") ("TCM" . "composer") ("TCOM" . "composer") ("TIT2" . "title") @@ -554,20 +561,19 @@ Return the comment block data in a vector." "Read and decode id3v2 metadata from FILENAME. Return metadata in a list of (FIELD . VALUE) cons cells. See ‘emms-info-native--decode-id3v2-text-frame’ for details." - (let* ((header (emms-info-native--decode-id3v2-header filename)) + (let* (emms-info-native--id3v2-version + (header (emms-info-native--decode-id3v2-header filename)) (tag-size (bindat-get-field header 'size)) + (unsync (memq 7 (bindat-get-field header 'flags))) (offset 10)) - (when (> tag-size emms-info-native--max-peek-size) - (error "id3v2 tag size %s is too large" size)) - (when (memq 7 (bindat-get-field header 'flags)) - (error "id3v2 unsynchronisation scheme is not supported")) (when (memq 6 (bindat-get-field header 'flags)) ;; Skip the extended header. (cl-incf offset (emms-info-native--decode-id3v2-ext-header-size filename))) (emms-info-native--decode-id3v2-frames filename offset - (+ tag-size 10)))) + (+ tag-size 10) + unsync))) (defun emms-info-native--decode-id3v2-header (filename) "Read and decode id3v2 header from FILENAME." @@ -586,46 +592,88 @@ Return the size. Signal an error if the size exceeds (insert-file-contents-literally filename nil 10 14) (emms-info-native--checked-id3v2-size (buffer-string)))) -(defun emms-info-native--checked-id3v2-size (bytes) - "Calculate id3v2 element size from BYTES and check its validity. +(defun emms-info-native--checked-id3v2-size (elt bytes) + "Calculate id3v2 element ELT size from BYTES. +ELT must be either 'tag or 'frame. Check the validity of size. Return the size." - (let ((size (emms-info-native--decode-id3v2-size bytes))) + (let (size) + (cond ((eq elt 'tag) + (setq size (emms-info-native--decode-id3v2-size bytes t))) + ((eq elt 'frame) + (if (= emms-info-native--id3v2-version 4) + (setq size (emms-info-native--decode-id3v2-size bytes t)) + (setq size (emms-info-native--decode-id3v2-size bytes nil))))) (when (or (= size 0) (> size emms-info-native--max-peek-size)) - (error "id3v2 tag/header/frame size %s is invalid" bytes)) + (error "id3v2 tag or frame size %s is invalid" size)) size)) -(defun emms-info-native--decode-id3v2-size (bytes) +(defun emms-info-native--decode-id3v2-size (bytes syncsafe) "Decode id3v2 element size from BYTES. -BYTES are interpreted as 7-bit bytes, MSB first. Return the -size." - (apply '+ (seq-map-indexed (lambda (elt idx) - (* (expt 2 (* 7 idx)) elt)) - (reverse bytes)))) - -(defun emms-info-native--decode-id3v2-frames (filename begin end) +Depending on SYNCSAFE, BYTES are interpreted as 7- or 8-bit +bytes, MSB first. + +Return the decoded size." + (let ((num-bits (if syncsafe 7 8))) + (apply '+ (seq-map-indexed (lambda (elt idx) + (* (expt 2 (* num-bits idx)) elt)) + (reverse bytes))))) + +(defun emms-info-native--decode-id3v2-frames (filename + begin + end + unsync) "Read and decode id3v2 text frames from FILENAME. BEGIN should be the offset of first byte after id3v2 header and extended header (if any), and END should be the offset after the complete id3v2 tag. +If UNSYNC is t, the frames are assumed to have gone through +unsynchronization and decoded as such. + Return metadata in a list of (FIELD . VALUE) cons cells. See ‘emms-info-native--decode-id3v2-text-frame’ for details." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert (emms-info-native--read-id3v2-frames filename + begin + end + unsync)) + (emms-info-native--decode-id3v2-text-frames (buffer-string)))) + +(defun emms-info-native--read-id3v2-frames (filename begin end unsync) + "Read id3v2 frames from FILE. +Start at offset BEGIN and end before offset END. If UNSYNC is t, +reverse unsynchronization. + +Return the frames." (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-literally filename nil begin end) - (let (comments - (offset 0)) - (condition-case nil - (while (< offset end) - (let* ((frame (bindat-unpack emms-info-native--id3v2-frame-bindat-spec - (buffer-string) - offset)) - (comment (emms-info-native--decode-id3v2-text-frame - frame))) - (when comment (push comment comments)) - (cl-incf offset (+ (bindat-get-field frame 'size) 10)))) - (error nil)) - comments))) + (when unsync + (while (re-search-forward (string 255 0) nil t) + (replace-match (string 255)))) + (buffer-string))) + +(defun emms-info-native--decode-id3v2-text-frames (frames) + "Decode id3v2 text frames from FRAMES. + +Return metadata in a list of (FIELD . VALUE) cons cells. See +‘emms-info-native--decode-id3v2-text-frame’ for details." + (let (comments + (offset 0)) + (condition-case nil + (while (< offset (length frames)) + (let* ((frame (bindat-unpack emms-info-native--id3v2-frame-bindat-spec + frames + offset)) + (comment (emms-info-native--decode-id3v2-text-frame + frame))) + (when comment (push comment comments)) + (cl-incf offset + (+ (bindat-get-field frame 'size) + (if (= emms-info-native--id3v2-version 2) 6 10))))) + (error nil)) + comments)) (defun emms-info-native--decode-id3v2-text-frame (frame) "Identify and decode id3v2 text frame FRAME. @@ -645,12 +693,16 @@ If there is no such identifier, return nil." emms-info-native--id3v2-frame-to-info))) (defun emms-info-native--decode-id3v2-string (bytes) - "Decode id3v2 text information. -Return the text in BYTES as string." - (let ((encoding (emms-info-native--id3v2-text-encoding bytes)) - (string (mapconcat #'byte-to-string (seq-rest bytes) ""))) - ;; Discard the null terminator. - (substring (decode-coding-string string encoding) 0 -1))) + "Decode id3v2 text information from BYTES. +Remove the terminating null byte, if any. Return the text as +string." + (let* ((encoding (emms-info-native--id3v2-text-encoding bytes)) + (string (mapconcat #'byte-to-string (seq-rest bytes) "")) + (decoded (decode-coding-string string encoding))) + (when (> (length decoded) 0) + (if (equal (substring decoded -1) "\0") + (substring decoded 0 -1) + decoded)))) (defun emms-info-native--id3v2-text-encoding (bytes) "Return the encoding for text information BYTES." -- cgit v1.2.3 From fcdb111f4b25a94ea4969ed86c544dc49db5d7fa Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Tue, 16 Feb 2021 17:29:08 +0200 Subject: Add mappings for more id3v2 text frames Extract "artistsort", "titlesort", "albumsort" and few more "year" and "originalyear" frames. --- emms-info-native.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/emms-info-native.el b/emms-info-native.el index 93621b4..f31475f 100644 --- a/emms-info-native.el +++ b/emms-info-native.el @@ -534,18 +534,24 @@ outside itself.") '(("TP1" . "artist") ("TPE1" . "artist") ("TPE2" . "albumartist") + ("TSOP" . "artistsort") ("TCM" . "composer") ("TCOM" . "composer") ("TIT2" . "title") ("TT2" . "title") + ("TSOT" . "titlesort") ("TALB" . "album") ("TAL" . "album") + ("TSOA" . "albumsort") ("TRCK" . "tracknumber") ("TRK" . "tracknumber") ("TPOS" . "discnumber") ("TPA" . "discnumber") + ("TDRC" . "year") + ("TDRL" . "year") ("TYER" . "year") ("TYE" . "year") + ("TDOR" . "originalyear") ("TORY" . "originalyear") ("TOR" . "originalyear")) "Mapping from id3v2 frame identifiers to info fields.") -- cgit v1.2.3