| 1 | ;;; emms-info-native-flac.el --- EMMS info functions for FLAC files -*- lexical-binding: t; -*- |
| 2 | |
| 3 | ;; Copyright (C) 2020-2023 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Petteri Hintsanen <petterih@iki.fi> |
| 6 | |
| 7 | ;; This file is part of EMMS. |
| 8 | |
| 9 | ;; EMMS is free software; you can redistribute it and/or modify it |
| 10 | ;; under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 12 | ;; any later version. |
| 13 | |
| 14 | ;; EMMS is distributed in the hope that it will be useful, but WITHOUT |
| 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
| 16 | ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
| 17 | ;; License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with EMMS; see the file COPYING. If not, write to the Free |
| 21 | ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, |
| 22 | ;; MA 02110-1301, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; This file contains functions for extracting metadata from FLAC |
| 27 | ;; files in their native encapsulation format. The code is based on |
| 28 | ;; xiph.org's FLAC format specification, available at |
| 29 | ;; https://xiph.org/flac/format.html. |
| 30 | |
| 31 | ;;; Code: |
| 32 | |
| 33 | (require 'emms) |
| 34 | (require 'emms-info-native-vorbis) |
| 35 | (require 'bindat) |
| 36 | |
| 37 | (defvar bindat-raw) |
| 38 | |
| 39 | (defconst emms-info-native-flac--max-peek-size (* 16 1024 1024) |
| 40 | "Maximum buffer size for metadata decoding. |
| 41 | Functions in `emms-info-native-flac' read certain amounts of data |
| 42 | into a temporary buffer while decoding metadata. This variable |
| 43 | controls the maximum size of that buffer: if more than |
| 44 | `emms-info-native-flac--max-peek-size' bytes are needed, an error |
| 45 | is signaled. |
| 46 | |
| 47 | Technically metadata blocks can have almost arbitrary lengths, |
| 48 | but in practice processing must be constrained to prevent memory |
| 49 | exhaustion in case of garbled or malicious inputs.") |
| 50 | |
| 51 | (defconst emms-info-native-flac--meta-header-bindat-spec |
| 52 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 53 | (bindat-type |
| 54 | (flags u8) |
| 55 | (length uint 24) |
| 56 | (_ unit (when (or (> length emms-info-native-flac--max-peek-size) |
| 57 | (= length 0)) |
| 58 | (error "FLAC block length %s is invalid" length)))) |
| 59 | '((flags u8) |
| 60 | (length u24) |
| 61 | (eval (when (or (> last emms-info-native-flac--max-peek-size) |
| 62 | (= last 0)) |
| 63 | (error "FLAC block length %s is invalid" last))))) |
| 64 | "FLAC metadata block header specification.") |
| 65 | |
| 66 | (defconst emms-info-native-flac--stream-info-block-bindat-spec |
| 67 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 68 | (bindat-type |
| 69 | (min-block-size uint 16) |
| 70 | (max-block-size uint 16) |
| 71 | (min-frame-size uint 24) |
| 72 | (max-frame-size uint 24) |
| 73 | (sample-metadata vec 8) |
| 74 | (md5 vec 16)) |
| 75 | '((min-block-size u16) |
| 76 | (max-block-size u16) |
| 77 | (min-frame-size u24) |
| 78 | (max-frame-size u24) |
| 79 | (sample-metadata vec 8) |
| 80 | (md5 vec 16))) |
| 81 | "FLAC stream info block specification.") |
| 82 | |
| 83 | (defconst emms-info-native-flac--comment-block-bindat-spec |
| 84 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 85 | (bindat-type |
| 86 | (vendor-length uintr 32) |
| 87 | (_ unit (when (> vendor-length (length bindat-raw)) |
| 88 | (error "FLAC vendor length %s is too long" |
| 89 | vendor-length))) |
| 90 | (vendor-string str vendor-length) |
| 91 | (user-comments-list-length uintr 32) |
| 92 | (_ unit (when (> user-comments-list-length (length bindat-raw)) |
| 93 | (error "FLAC user comment list length %s is too long" |
| 94 | user-comments-list-length))) |
| 95 | (user-comments repeat user-comments-list-length |
| 96 | type emms-info-native-vorbis--comment-field-bindat-spec)) |
| 97 | '((vendor-length u32r) |
| 98 | (eval (when (> last (length bindat-raw)) |
| 99 | (error "FLAC vendor length %s is too long" last))) |
| 100 | (vendor-string str (vendor-length)) |
| 101 | (user-comments-list-length u32r) |
| 102 | (eval (when (> last (length bindat-raw)) |
| 103 | (error "FLAC user comment list length %s is too long" |
| 104 | last))) |
| 105 | (user-comments repeat |
| 106 | (user-comments-list-length) |
| 107 | (struct emms-info-native-vorbis--comment-field-bindat-spec)))) |
| 108 | "FLAC Vorbis comment block specification.") |
| 109 | |
| 110 | (defun emms-info-native-flac-decode-metadata (filename) |
| 111 | "Read and decode metadata from FLAC file FILENAME. |
| 112 | Return comments in a list of (FIELD . VALUE) cons cells. |
| 113 | Additionally return stream duration in `playing-time' field. |
| 114 | |
| 115 | See `emms-info-native-vorbis-extract-comments' for details." |
| 116 | (unless (emms-info-native-flac--has-signature filename) |
| 117 | (error "Invalid FLAC stream")) |
| 118 | (let* ((blocks |
| 119 | (emms-info-native-flac--decode-meta-blocks |
| 120 | (emms-info-native-flac--file-inserter filename))) |
| 121 | (comment-block |
| 122 | (and (car blocks) |
| 123 | (bindat-unpack emms-info-native-flac--comment-block-bindat-spec |
| 124 | (car blocks)))) |
| 125 | (stream-info-block |
| 126 | (and (cadr blocks) |
| 127 | (bindat-unpack emms-info-native-flac--stream-info-block-bindat-spec |
| 128 | (cadr blocks)))) |
| 129 | (user-comments |
| 130 | (and comment-block |
| 131 | (bindat-get-field comment-block 'user-comments))) |
| 132 | (comments |
| 133 | (and user-comments |
| 134 | (emms-info-native-vorbis-extract-comments user-comments))) |
| 135 | (playing-time |
| 136 | (and stream-info-block |
| 137 | (emms-info-native-flac--decode-duration |
| 138 | (emms-be-to-int |
| 139 | (bindat-get-field stream-info-block |
| 140 | 'sample-metadata)))))) |
| 141 | (nconc comments |
| 142 | (when playing-time |
| 143 | (list (cons "playing-time" playing-time)))))) |
| 144 | |
| 145 | (defun emms-info-native-flac--has-signature (filename) |
| 146 | "Check for FLAC stream marker at the beginning of FILENAME. |
| 147 | Return t if there is a valid stream marker, nil otherwise." |
| 148 | (with-temp-buffer |
| 149 | (set-buffer-multibyte nil) |
| 150 | (insert-file-contents-literally filename nil 0 4) |
| 151 | (looking-at "fLaC"))) |
| 152 | |
| 153 | (defun emms-info-native-flac--file-inserter (filename) |
| 154 | "Return a function for reading bytes from FILENAME. |
| 155 | This is meant for `emms-info-native-flac--decode-meta-blocks'." |
| 156 | (lambda (offset end) |
| 157 | (insert-file-contents-literally filename nil offset end t))) |
| 158 | |
| 159 | (defun emms-info-native-flac--decode-meta-blocks (read-func) |
| 160 | "Decode metadata blocks from data supplied by READ-FUNC. |
| 161 | Go through each metadata block looking for comment and stream |
| 162 | info blocks. Extract and return them in a list, if found." |
| 163 | (with-temp-buffer |
| 164 | (set-buffer-multibyte nil) |
| 165 | (let (comment-block stream-info-block last-flag (offset 4)) |
| 166 | (while (not last-flag) |
| 167 | (funcall read-func offset (setq offset (+ offset 4))) |
| 168 | (let* ((header |
| 169 | (bindat-unpack emms-info-native-flac--meta-header-bindat-spec |
| 170 | (buffer-string))) |
| 171 | (end (+ offset (bindat-get-field header 'length))) |
| 172 | (flags (bindat-get-field header 'flags)) |
| 173 | (block-type (logand flags #x7F))) |
| 174 | (setq last-flag (> (logand flags #x80) 0)) |
| 175 | (when (> block-type 6) |
| 176 | (error "FLAC block type error: expected <= 6, got %s" |
| 177 | block-type)) |
| 178 | (when (= block-type 0) |
| 179 | ;; Stream info block found, extract it. |
| 180 | (funcall read-func offset end) |
| 181 | (setq stream-info-block (buffer-string))) |
| 182 | (when (= block-type 4) |
| 183 | ;; Comment block found, extract it. |
| 184 | (funcall read-func offset end) |
| 185 | (setq comment-block (buffer-string))) |
| 186 | (setq offset end))) |
| 187 | (list comment-block stream-info-block)))) |
| 188 | |
| 189 | (defun emms-info-native-flac--decode-duration (sample-meta) |
| 190 | "Decode stream duration from SAMPLE-META. |
| 191 | SAMPLE-META should be a part of stream info metadata block. See |
| 192 | `emms-info-native-flac--stream-info-block-bindat-spec'. |
| 193 | |
| 194 | Return the duration in seconds, or nil if it is not available." |
| 195 | (let ((sample-rate (emms-extract-bits sample-meta 44 63)) |
| 196 | (num-samples (emms-extract-bits sample-meta 0 35))) |
| 197 | (when (and (> sample-rate 0) |
| 198 | (> num-samples 0)) |
| 199 | (/ num-samples sample-rate)))) |
| 200 | |
| 201 | (provide 'emms-info-native-flac) |
| 202 | |
| 203 | ;;; emms-info-native-flac.el ends here |