diff options
| -rw-r--r-- | emms-info-native.el | 355 |
1 files 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 <petterih@iki.fi> @@ -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 |