aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--emms-info-native.el491
-rw-r--r--emms.el2
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
diff --git a/emms.el b/emms.el
index 1ea73fe..dd8a69d 100644
--- a/emms.el
+++ b/emms.el
@@ -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.")