diff options
Diffstat (limited to 'elisp/emms-info-native.el')
| -rw-r--r-- | elisp/emms-info-native.el | 982 |
1 files changed, 982 insertions, 0 deletions
diff --git a/elisp/emms-info-native.el b/elisp/emms-info-native.el new file mode 100644 index 0000000..15f2d4c --- /dev/null +++ b/elisp/emms-info-native.el @@ -0,0 +1,982 @@ +;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2023 Free Software Foundation, Inc. + +;; Author: Petteri Hintsanen <[email protected]> + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. + +;;; Commentary: + +;; This file provides a native emms-info-method for EMMS. Here +;; "native" means a pure Emacs Lisp implementation instead of one +;; relying on external tools or libraries like `emms-info-ogginfo' or +;; `emms-info-libtag'. +;; +;; To use this method, add `emms-info-native' to +;; `emms-info-functions'. +;; +;; The following file formats are supported: +;; +;; - Vorbis: Ogg Vorbis I Profile, filename extension `.ogg', +;; 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 extension `.opus', elementary +;; streams only. Based on RFC 7845, see URL +;; `https://tools.ietf.org/html/rfc7845.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 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'. +;; +;; - SPC files with extension `.spc' and id666 tags. This is an audio +;; file based on a memory dump from an SPC700, a special audio chip +;; found within Super Nintendos. +;; +;; Format detection is based solely on filename extension, which is +;; matched case-insensitively. + +;;; Code: + +(require 'bindat) +(require 'cl-lib) +(require 'emms-info) +(require 'emms-info-spc) +(require 'seq) +(require 'subr-x) + +(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 +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 +exhaustion in case of garbled or malicious inputs.") + +(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.") + +(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 + +(defconst emms-info-native--max-num-vorbis-comments 1024 + "Maximum number of Vorbis comment fields in a stream. +Technically a single Vorbis stream may have up to 2^32 comments, +but in practice processing must be constrained to prevent memory +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--max-vorbis-comment-size (* 64 1024) + "Maximum length for a single Vorbis comment field. +Technically a single Vorbis comment may have a length up to 2^32 +bytes, but in practice processing must be constrained to prevent +memory 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--max-vorbis-vendor-length 1024 + "Maximum length of Vorbis vendor string. +Technically a vendor string can be up to 2^32 bytes long, but in +practice processing must be constrained to prevent memory +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-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) + (error "Vorbis header type mismatch: expected 1, got %s" + last))) + (vorbis vec 6) + (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 (unless (= last 0) + (error "Vorbis version mismatch: expected 0, got %s" + last))) + (audio-channels u8) + (audio-sample-rate u32r) + (bitrate-maximum u32r) + (bitrate-nominal u32r) + (bitrate-minimum u32r) + (blocksize u8) + (framing-flag u8) + (eval (unless (= last 1)) + (error "Vorbis framing bit mismatch: expected 1, got %s" + 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) + (error "Vorbis header type mismatch: expected 3, got %s" + last))) + (vorbis vec 6) + (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))) + (vendor-length u32r) + (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-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-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.") + +(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.") + +(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' or +`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 +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 +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)) + (match-string 2 comment-string))))) + +;;;; Opus code + +(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) + (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 (unless (< last 16) + (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) + (union (channel-mapping-family) + (0 nil) + (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) + (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) + (error "Opus framing mismatch: expected `%s', got `%s'" + emms-info-native--opus-tags-magic-array + last))) + (vendor-length u32r) + (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-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-comments repeat + (user-comments-list-length) + (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 + '((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 + '((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-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-comments repeat + (user-comments-list-length) + (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." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 0 4) + (looking-at "fLaC"))) + +(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) + (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))) + +;;;; id3v2 (MP3) code + +(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) + (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 '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) + (error "id3v2 frame id `%s' is invalid" last))) + (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)))) + "id3v2 frame header specification.") + +(defconst emms-info-native--id3v2-frame-to-info + '(("TAL" . "album") + ("TALB" . "album") + ("TPE2" . "albumartist") + ("TSO2" . "albumartistsort") + ("TSOA" . "albumsort") + ("TP1" . "artist") + ("TPE1" . "artist") + ("TSOP" . "artistsort") + ("TCM" . "composer") + ("TCOM" . "composer") + ("TSOC" . "composersort") + ("TDRC" . "date") + ("TPA" . "discnumber") + ("TPOS" . "discnumber") + ("TCON" . genre) + ("TPUB" . "label") + ("TDOR" . "originaldate") + ("TOR" . "originalyear") + ("TORY" . "originalyear") + ("TIT2" . "title") + ("TT2" . "title") + ("TSOT" . "titlesort") + ("TRK" . "tracknumber") + ("TRCK" . "tracknumber") + ("TYE" . "year") + ("TYER" . "year") + ("TXXX" . user-defined)) + "Mapping from id3v2 frame identifiers to EMMS info fields. + +Sources: + +- URL `https://picard-docs.musicbrainz.org/en/appendices/tag_mapping.html' +- URL `http://wiki.hydrogenaud.io/index.php?title=Foobar2000:ID3_Tag_Mapping'") + +(defconst emms-info-native--id3v1-genres + '((0 . "Blues") + (1 . "Classic Rock") + (2 . "Country") + (3 . "Dance") + (4 . "Disco") + (5 . "Funk") + (6 . "Grunge") + (7 . "Hip-Hop") + (8 . "Jazz") + (9 . "Metal") + (10 . "New Age") + (11 . "Oldies") + (12 . "Other") + (13 . "Pop") + (14 . "R&B") + (15 . "Rap") + (16 . "Reggae") + (17 . "Rock") + (18 . "Techno") + (19 . "Industrial") + (20 . "Alternative") + (21 . "Ska") + (22 . "Death Metal") + (23 . "Pranks") + (24 . "Soundtrack") + (25 . "Euro-Techno") + (26 . "Ambient") + (27 . "Trip-Hop") + (28 . "Vocal") + (29 . "Jazz+Funk") + (30 . "Fusion") + (31 . "Trance") + (32 . "Classical") + (33 . "Instrumental") + (34 . "Acid") + (35 . "House") + (36 . "Game") + (37 . "Sound Clip") + (38 . "Gospel") + (39 . "Noise") + (40 . "AlternRock") + (41 . "Bass") + (42 . "Soul") + (43 . "Punk") + (44 . "Space") + (45 . "Meditative") + (46 . "Instrumental Pop") + (47 . "Instrumental Rock") + (48 . "Ethnic") + (49 . "Gothic") + (50 . "Darkwave") + (51 . "Techno-Industrial") + (52 . "Electronic") + (53 . "Pop-Folk") + (54 . "Eurodance") + (55 . "Dream") + (56 . "Southern Rock") + (57 . "Comedy") + (58 . "Cult") + (59 . "Gangsta") + (60 . "Top 40") + (61 . "Christian Rap") + (62 . "Pop/Funk") + (63 . "Jungle") + (64 . "Native American") + (65 . "Cabaret") + (66 . "New Wave") + (67 . "Psychadelic") + (68 . "Rave") + (69 . "Showtunes") + (70 . "Trailer") + (71 . "Lo-Fi") + (72 . "Tribal") + (73 . "Acid Punk") + (74 . "Acid Jazz") + (75 . "Polka") + (76 . "Retro") + (77 . "Musical") + (78 . "Rock & Roll") + (79 . "Hard Rock") + (80 . "Folk") + (81 . "Folk-Rock") + (82 . "National Folk") + (83 . "Swing") + (84 . "Fast Fusion") + (85 . "Bebob") + (86 . "Latin") + (87 . "Revival") + (88 . "Celtic") + (89 . "Bluegrass") + (90 . "Avantgarde") + (91 . "Gothic Rock") + (92 . "Progressive Rock") + (93 . "Psychedelic Rock") + (94 . "Symphonic Rock") + (95 . "Slow Rock") + (96 . "Big Band") + (97 . "Chorus") + (98 . "Easy Listening") + (99 . "Acoustic") + (100 . "Humour") + (101 . "Speech") + (102 . "Chanson") + (103 . "Opera") + (104 . "Chamber Music") + (105 . "Sonata") + (106 . "Symphony") + (107 . "Booty Bass") + (108 . "Primus") + (109 . "Porn Groove") + (110 . "Satire") + (111 . "Slow Jam") + (112 . "Club") + (113 . "Tango") + (114 . "Samba") + (115 . "Folklore") + (116 . "Ballad") + (117 . "Power Ballad") + (118 . "Rhythmic Soul") + (119 . "Freestyle") + (120 . "Duet") + (121 . "Punk Rock") + (122 . "Drum Solo") + (123 . "A cappella") + (124 . "Euro-House") + (125 . "Dance Hall")) + "id3v1 genres.") + +(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--valid-id3v2-frame-id-p (id) + "Return t if ID is a proper id3v2 frame identifier, nil otherwise." + (if (= emms-info-native--id3v2-version 2) + (string-match "[A-Z0-9]\\{3\\}" id) + (string-match "[A-Z0-9]\\{4\\}" id))) + +(defun emms-info-native--checked-id3v2-size (elt bytes) + "Calculate id3v2 element ELT size from BYTES. +ELT must be either \\='tag or \\='frame. + +Return the size. Signal an error if the size is zero." + (let ((size (cond ((eq elt 'tag) + (emms-info-native--decode-id3v2-size bytes t)) + ((eq elt 'frame) + (if (= emms-info-native--id3v2-version 4) + (emms-info-native--decode-id3v2-size bytes t) + (emms-info-native--decode-id3v2-size bytes nil)))))) + (if (zerop size) + (error "id3v2 tag/frame size is zero") + size))) + +(defun emms-info-native--decode-id3v2-size (bytes syncsafe) + "Decode id3v2 element size from BYTES. +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 (filename) + "Read and decode id3v2 metadata from FILENAME. +Return metadata in a list of (FIELD . VALUE) cons cells, or nil +in case of errors or if there were no known fields in FILENAME. + +See `emms-info-native--id3v2-frame-to-info' for recognized +fields." + (condition-case nil + (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 (memq 6 (bindat-get-field header 'flags)) + ;; Skip the extended header. + (cl-incf offset + (emms-info-native--checked-id3v2-ext-header-size filename))) + (emms-info-native--decode-id3v2-frames filename + offset + (+ tag-size 10) + unsync)) + (error nil))) + +(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--checked-id3v2-ext-header-size (filename) + "Read and decode id3v2 extended header size from FILENAME. +Return the size. Signal an error if the size is zero." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 10 14) + (emms-info-native--checked-id3v2-size 'frame (buffer-string)))) + +(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 of the first frame, 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." + (let ((offset begin) + (limit (- end (emms-info-native--id3v2-frame-header-size))) + comments) + (condition-case nil + (while (< offset limit) + (let* ((frame-data (emms-info-native--decode-id3v2-frame filename + offset + unsync)) + (next-frame-offset (car frame-data)) + (comment (cdr frame-data))) + (when comment (push comment comments)) + (setq offset next-frame-offset))) + (error nil)) + comments)) + +(defun emms-info-native--id3v2-frame-header-size () + "Return the last decoded header size in bytes." + (if (= emms-info-native--id3v2-version 2) 6 10)) + +(defun emms-info-native--decode-id3v2-frame (filename offset unsync) + (let* ((header (emms-info-native--decode-id3v2-frame-header filename + offset)) + (info-id (emms-info-native--id3v2-frame-info-id header)) + (data-offset (car header)) + (size (bindat-get-field (cdr header) 'size))) + (if (or info-id unsync) + ;; Note that if unsync is t, we have to always read the frame + ;; to determine next-frame-offset. + (let* ((data (emms-info-native--read-id3v2-frame-data filename + data-offset + size + unsync)) + (next-frame-offset (car data)) + (value (emms-info-native--decode-id3v2-frame-data (cdr data) + info-id))) + (cons next-frame-offset value)) + ;; Skip the frame. + (cons (+ data-offset size) nil)))) + +(defun emms-info-native--decode-id3v2-frame-header (filename begin) + "Read and decode id3v2 frame header from FILENAME. +Start reading from offset BEGIN. + +Return a cons cell (OFFSET . FRAME), where OFFSET is the byte +offset after the frame header, and FRAME is the decoded frame." + (with-temp-buffer + (set-buffer-multibyte nil) + (let ((end (+ begin (emms-info-native--id3v2-frame-header-size)))) + (insert-file-contents-literally filename nil begin end) + (cons end (bindat-unpack emms-info-native--id3v2-frame-header-bindat-spec + (buffer-string)))))) + +(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--read-id3v2-frame-data (filename + begin + num-bytes + unsync) + "Read NUM-BYTES of raw id3v2 frame data from FILENAME. +Start reading from offset BEGIN. If UNSYNC is t, all 'FF 00' +byte combinations are replaced by 'FF'. Replaced byte pairs are +counted as one, instead of two, towards NUM-BYTES. + +Return a cons cell (OFFSET . DATA), where OFFSET is the byte +offset after NUM-BYTES bytes have been read, and DATA is the raw +data." + (with-temp-buffer + (set-buffer-multibyte nil) + (if unsync + ;; Reverse unsynchronization. + (let ((peek-end (+ begin (* 2 num-bytes))) + (end num-bytes)) + (insert-file-contents-literally filename nil begin peek-end) + (goto-char (point-min)) + (while (and (re-search-forward (string 255 0) nil t) + (< (point) end)) + (replace-match (string 255)) + (cl-incf end 1)) + (delete-region (1+ num-bytes) (point-max)) + (cons (+ begin end) (buffer-string))) + ;; No unsynchronization: read the data as-is. + (let ((end (+ begin num-bytes))) + (insert-file-contents-literally filename nil begin end) + (cons end (buffer-string)))))) + +(defun emms-info-native--decode-id3v2-frame-data (data info-id) + "Decode id3v2 text frame data DATA. +If INFO-ID is `user-defined', assume that DATA is a TXXX frame +with key/value-pair. Extract the key and, if it is a mapped +element in `emms-info-native--id3v2-frame-to-info', use it as +INFO-ID. + +If INFO-ID is `genre', assume that DATA is either an integral +id3v1 genre reference or a plain genre string. In the former +case map the reference to a string via +`emms-info-native--id3v1-genres'; in the latter case use the +genre string verbatim. + +Return a cons cell (INFO-ID . VALUE) where VALUE is the decoded +string." + (when info-id + (let ((str (emms-info-native--decode-id3v2-string data))) + (cond ((stringp info-id) (cons info-id str)) + ((eq info-id 'genre) + (if (string-match "^(?\\([0-9]+\\))?" str) + (let ((v1-genre (assoc (string-to-number (match-string 1 str)) + emms-info-native--id3v1-genres))) + (when v1-genre (cons "genre" (cdr v1-genre)))) + (cons "genre" str))) + ((eq info-id 'user-defined) + (let* ((key-val (split-string str (string 0))) + (key (downcase (car key-val))) + (val (cadr key-val))) + (when (rassoc key emms-info-native--id3v2-frame-to-info) + (cons key val)))))))) + +(defun emms-info-native--decode-id3v2-string (bytes) + "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." + (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." + (condition-case env + (let* ((filename (emms-track-name track)) + (info-fields (emms-info-native--decode-info-fields filename))) + (dolist (field info-fields) + (let ((name (intern (concat "info-" (car field)))) + (value (cdr field))) + (unless (zerop (length value)) + (emms-track-set track + name + (if (eq name 'info-playing-time) + (string-to-number value) + (string-trim-right value))))))) + (error (message "emms-info-native error processing %s: %s" + (emms-track-name track) env)))) + +(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--decode-ogg-comments filename stream-type)) + ((eq stream-type 'flac) + (emms-info-native--decode-flac-comments filename)) + ((eq stream-type 'mp3) + (emms-info-native--decode-id3v2 filename)) + ((eq stream-type 'spc) + (emms-info-spc--decode-id666 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', `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) + ((string-match ".spc$" filename) 'spc) + (t nil)))) + +(provide 'emms-info-native) + +;;; emms-info-native.el ends here |