diff options
| -rw-r--r-- | emms-info-native.el | 491 | ||||
| -rw-r--r-- | emms.el | 2 |
2 files changed, 492 insertions, 1 deletions
diff --git a/emms-info-native.el b/emms-info-native.el new file mode 100644 index 0000000..a51dad4 --- /dev/null +++ b/emms-info-native.el @@ -0,0 +1,491 @@ +;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Petteri Hintsanen <petterih@iki.fi> + +;; 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’, +;; elemetary 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 +;; 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’. +;; +;; Format detection is based solely on filename extension, which is +;; matched case-insensitively. + +;;; Code: + +(require 'bindat) + +(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. + +Technically metadata blocks can have almost arbitrary lengths, +but in practice processing must be constrained to prevent memory +exhaustion in case of garbled or malicious inputs.") + +;;;; Ogg code + +(defconst emms-info-native--ogg-magic-array + [79 103 103 83] + "Ogg format magic capture pattern ‘OggS’.") + +(defconst emms-info-native--ogg-page-size 65307 + "Maximum size for a single Ogg container page. +Ogg files are read in chunks of this size during decoding.") + +(defconst emms-info-native--ogg-page-bindat-spec + '((capture-pattern vec 4) + (eval (when (not (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") + 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. +Framing and stream structure versions are verified, otherwise the +data is assumed to be valid.") + +(defun emms-info-native--decode-ogg (filename packets) + "Decode at least PACKETS number of 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." + (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))) + (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 comment header 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))) + +;;;; 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--vorbis-magic-array + [118 111 114 98 105 115] + "Header packet magic pattern ‘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" + last))) + (vorbis vec 6) + (eval (when (not (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))) + (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. +Identification, framing and version data are verified, otherwise +the data is assumed to be valid.") + +(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" + last))) + (vorbis vec 6) + (eval (when (not (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-comment-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)) + (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.") + +(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))) + (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.") + +(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. +They are always an identification header followed by a comment +header.") + +(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 +upper 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)) + (match-string 2 comment-string))))) + +;;;; Opus code + +(defconst emms-info-native--opus-head-magic-array + [79 112 117 115 72 101 97 100] + "Opus identification header magic pattern ‘OpusHead’.") + +(defconst emms-info-native--opus-tags-magic-array + [79 112 117 115 84 97 103 115] + "Opus comment header magic pattern ‘OpusTags’.") + +(defconst emms-info-native--opus-channel-mapping-table + '((stream-count u8) + (coupled-count u8) + (channel-mapping vec (channel-count))) + "Opus channel mapping table specification.") + +(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)) + (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" + last))) + (channel-count u8) + (pre-skip u16r) + (sample-rate u32r) + (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.") + +(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)) + (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-comment-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))) + "Opus comment header specification. +Framing is verified. Too long vendor string and comment list +will also trigger an error.") + +(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 + '((block-type u8) + (block-length u24)) + "FLAC metadata block header specification.") + +(defconst emms-info-native--flac-comment-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) + (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))) + "FLAC Vorbis comment block specification. +Too long vendor string and comment list will trigger an error.") + +(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--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." + (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)) + comment-block))) + +(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)) + +;;;; EMMS code + +(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’." + (let ((case-fold-search t)) + (cond ((string-match ".ogg$" filename) 'vorbis) + ((string-match ".opus$" filename) 'opus) + ((string-match ".flac$" filename) 'flac) + (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 @@ -375,7 +375,7 @@ Point will not be restored afterward." '("ogg" "mp3" "wav" "mpg" "mpeg" "wmv" "wma" "mov" "avi" "divx" "ogm" "ogv" "asf" "mkv" "rm" "rmvb" "mp4" "flac" "vob" "m4a" "ape" - "flv" "webm" "aif") + "flv" "webm" "aif" "opus") "A list of common formats which player definitions can use.") |