id3-frame.lisp 47 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010
  1. ;;; -*- Mode: Lisp; show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: ID3-FRAME; -*-
  2. ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
  3. (in-package #:id3-frame)
  4. (log5:defcategory cat-log-id3-frame)
  5. (defmacro log-id3-frame (&rest log-stuff) `(log5:log-for (cat-log-id3-frame) ,@log-stuff))
  6. (define-condition id3-frame-condition ()
  7. ((location :initarg :location :reader location :initform nil)
  8. (object :initarg :object :reader object :initform nil)
  9. (messsage :initarg :message :reader message :initform "Undefined Condition"))
  10. (:report (lambda (condition stream)
  11. (format stream "id3-frame condition at location: <~a> with object: <~a>: message: <~a>"
  12. (location condition) (object condition) (message condition)))))
  13. (defmethod print-object ((me id3-frame-condition) stream)
  14. (format stream "location: <~a>, object: <~a>, message: <~a>" (location me) (object me) (message me)))
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ID3 header/extended header/v2.1 header ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16. (defclass id3-header ()
  17. ((version :accessor version :initarg :version :initform 0 :documentation "ID3 version: 2, 3, or 4")
  18. (revision :accessor revision :initarg :revision :initform 0 :documentation "ID3 revision---is this ever non-zero?")
  19. (flags :accessor flags :initarg :flags :initform 0 :documentation "ID3 header flags")
  20. (size :accessor size :initarg :size :initform 0 :documentation "size of ID3 info")
  21. (ext-header :accessor ext-header :initarg :ext-header :initform nil :documentation "holds v2.3/4 extended header")
  22. (frames :accessor frames :initarg :frames :initform nil :documentation "holds ID3 frames")
  23. (v21-tag-header :accessor v21-tag-header :initarg :v21-tag-header :initform nil :documentation "old-style v2.1 header (if present)"))
  24. (:documentation "The ID3 header, found at start of file"))
  25. (defun is-valid-mp3-file (mp3-file)
  26. "Make sure this is an MP3 file. Look for ID3 header at begining (versions 2, 3, 4) and/or end (version 2.1)
  27. Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
  28. (log5:with-context "is-valid-mp3-file"
  29. (let ((id3)
  30. (valid)
  31. (version)
  32. (tag))
  33. (unwind-protect
  34. (handler-case
  35. (progn
  36. (stream-seek mp3-file 0 :start)
  37. (setf id3 (stream-read-string-with-len mp3-file 3))
  38. (setf version (stream-read-u8 mp3-file))
  39. (stream-seek mp3-file 128 :end)
  40. (setf tag (stream-read-string-with-len mp3-file 3))
  41. (log-id3-frame "id3 = ~a, version = ~d" id3 version)
  42. (setf valid (or (and (string= "ID3" id3)
  43. (or (= 2 version) (= 3 version) (= 4 version)))
  44. (string= tag "TAG"))))
  45. (condition (c)
  46. (declare (ignore c))))
  47. (stream-seek mp3-file 0 :start))
  48. valid)))
  49. (defclass v21-tag-header ()
  50. ((title :accessor title :initarg :title :initform nil)
  51. (artist :accessor artist :initarg :artist :initform nil)
  52. (album :accessor album :initarg :album :initform nil)
  53. (year :accessor year :initarg :year :initform nil)
  54. (comment :accessor comment :initarg :comment :initform nil)
  55. (track :accessor track :initarg :track :initform nil :documentation "some taggers allow the last 2 bytes of comment to be used as track number")
  56. (genre :accessor genre :initarg :genre :initform nil))
  57. (:documentation "ID3 V2.1 old-style tag. If present, found in last 128 bytes of file."))
  58. (defmethod vpprint ((me v21-tag-header) stream)
  59. (with-slots (title artist album year comment track genre) me
  60. (format stream "title = <~a>, artist = <~a>, album = <~a>, year = <~a>, comment = <~a>, track = <~d>, genre = ~d (~a)"
  61. title artist album year comment track genre (mp3-tag:get-id3v1-genre genre))))
  62. ;;; NB: no ":after" here
  63. (defmethod initialize-instance ((me v21-tag-header) &key instream)
  64. "Read in a V2.1 tag. Caller will have stream-seek'ed file to correct location and ensured that TAG was present"
  65. (log5:with-context "v21-frame-initializer"
  66. (log-id3-frame "reading v2.1 tag from ~:d" (stream-seek instream 0))
  67. (with-slots (title artist album year comment genre track) me
  68. (setf title (upto-null (stream-read-string-with-len instream 30)))
  69. (setf artist (upto-null (stream-read-string-with-len instream 30)))
  70. (setf album (upto-null (stream-read-string-with-len instream 30)))
  71. (setf year (upto-null (stream-read-string-with-len instream 4)))
  72. ;; In V21, a comment can be split into comment and track #
  73. ;; find the first #\Null then check to see if that index < 28. If so, the check the last two bytes being
  74. ;; non-zero---if so, then track can be set to integer value of last two bytes
  75. (let* ((c (stream-read-sequence instream 30))
  76. (first-null (find 0 c))
  77. (trck 0))
  78. (when (and first-null (<= first-null 28))
  79. (setf (ldb (byte 8 8) trck) (aref c 28))
  80. (setf (ldb (byte 8 0) trck) (aref c 29)))
  81. (setf comment (upto-null (map 'string #'code-char c)))
  82. (if (> trck 0)
  83. (setf track trck)
  84. (setf track nil)))
  85. (setf genre (stream-read-u8 instream))
  86. (log-id3-frame "v21 tag: ~a" (vpprint me nil)))))
  87. (defclass id3-ext-header ()
  88. ((size :accessor size :initarg :size :initform 0)
  89. (flags :accessor flags :initarg :flags :initform 0)
  90. (padding :accessor padding :initarg :padding :initform 0)
  91. (crc :accessor crc :initarg :crc :initform nil)
  92. (is-update :accessor is-update :initarg :is-update :initform nil)
  93. (restrictions :accessor restrictions :initarg :restrictions :initform 0))
  94. (:documentation "Class representing a V2.3/4 extended header"))
  95. (defmethod initialize-instance :after ((me id3-ext-header) &key instream version)
  96. "Read in the extended header. Caller will have stream-seek'ed to correct location in file.
  97. Note: extended headers are subject to unsynchronization, so make sure that INSTREAM has been made sync-safe.
  98. NB: 2.3 and 2.4 extended flags are different..."
  99. (with-slots (size flags padding crc is-update restrictions) me
  100. (setf size (stream-read-u32 instream))
  101. (setf flags (stream-read-u16 instream)) ; reading in flags fields, must discern below 2.3/2.4
  102. (log-id3-frame "making id3-ext-header: version = ~d, size = ~d, flags = ~x"
  103. version size flags)
  104. (ecase version
  105. (3
  106. (setf padding (stream-read-u32 instream))
  107. (when (logand flags #x8000)
  108. (if (not (= size 10))
  109. (warn-user "CRC bit set in extended header, but not enough bytes to read")
  110. (setf crc (stream-read-u32 instream)))))
  111. (4
  112. (when (not (= (logand #xff00 flags) 1))
  113. (warn-user "v2.4 extended flags length is not 1"))
  114. (setf flags (logand flags #xff)) ; lop off type byte (the flags length)
  115. (let ((len 0))
  116. (when (logand #x3000 flags)
  117. (setf len (stream-read-u8 instream))
  118. (when (not (zerop len)) (warn-user "v2.4 extended header is-tag length is ~d" len))
  119. (setf is-update t))
  120. (when (logand #x2000 flags)
  121. (setf len (stream-read-u8 instream))
  122. (when (not (= 5 len)) (warn-user "v2.4 extended header crc length is ~d" len))
  123. (setf crc (stream-read-u32 instream :bits-per-byte 7)))
  124. (when (logand #x1000 flags)
  125. (setf len (stream-read-u8 instream))
  126. (when (not (= 5 1)) (warn-user "v2.4 extended header restrictions length is ~d" len))
  127. (setf restrictions (stream-read-u8 instream))))))))
  128. (defun ext-header-restrictions-grok (r)
  129. "Return a string that shows what restrictions are in an ext-header"
  130. (if (zerop r)
  131. "No restrictions"
  132. (with-output-to-string (s)
  133. (format s "Tag size restictions: ~a/"
  134. (ecase (ash (logand #xc0 r) -6)
  135. (0 "No more than 128 frames and 1 MB total tag size")
  136. (1 "No more than 64 frames and 128 KB total tag size")
  137. (2 "No more than 32 frames and 40 KB total tag size")
  138. (3 "No more than 32 frames and 4 KB total tag size")))
  139. (format s "Tag encoding restictions: ~a/"
  140. (ecase (ash (logand #x20 r) -5)
  141. (0 "No restrictions")
  142. (1 "Strings are only encoded with ISO-8859-1 [ISO-8859-1] or UTF-8 [UTF-8]")))
  143. (format s "Tag field size restictions: ~a/"
  144. (ecase (ash (logand #x18 r) -3)
  145. (0 "No restrictions")
  146. (1 "No string is longer than 1024 characters")
  147. (2 "No string is longer than 128 characters")
  148. (3 "No string is longer than 30 characters")))
  149. (format s "Tag image encoding restrictions: ~a/"
  150. (ecase (ash (logand #x04 r) -2)
  151. (0 "No restrictions")
  152. (1 "Images are encoded only with PNG [PNG] or JPEG [JFIF]")))
  153. (format s "Tag image size restrictions: ~a"
  154. (ecase (logand #x04 r)
  155. (0 "No restrictions")
  156. (1 "All images are 256x256 pixels or smaller.")
  157. (2 "All images are 64x64 pixels or smaller.")
  158. (3 "All images are exactly 64x64 pixels, unless required otherwise."))))))
  159. (defmethod vpprint ((me id3-ext-header) stream)
  160. (with-slots (size flags padding crc is-update restrictions) me
  161. (format stream "extended header: size: ~d, flags: ~x, padding ~:d, crc = ~x is-update ~a, restrictions = ~x/~a~%"
  162. size flags padding crc is-update restrictions (ext-header-restrictions-grok restrictions))))
  163. ;;; NB: v2.2 only really defines bit-7. It does document bit-6 as being the compression flag, but then states
  164. ;;; that if it is set, the software should "ignore the entire tag if this (bit-6) is set"
  165. (defmacro header-unsynchronized-p (flags) `(logbitp 7 ,flags)) ; all share this flag
  166. (defmacro header-extended-p (flags) `(logbitp 6 ,flags)) ; 2.3/2.4
  167. (defmacro header-experimental-p (flags) `(logbitp 5 ,flags)) ; 2.3/2.4
  168. (defmacro header-footer-p (flags) `(logbitp 4 ,flags)) ; 2.4 only
  169. (defmacro print-header-flags (stream flags)
  170. `(format ,stream "0x~2,'0x: ~:[0/~;unsynchronized-frames/~]~:[0/~;extended-header/~]~:[0/~;expermental-tag/~]~:[0~;footer-present~]"
  171. ,flags
  172. (header-unsynchronized-p ,flags)
  173. (header-extended-p ,flags)
  174. (header-experimental-p ,flags)
  175. (header-footer-p ,flags)))
  176. (defmethod vpprint ((me id3-header) stream)
  177. (with-slots (version revision flags v21-tag-header size ext-header frames) me
  178. (format stream "~a"
  179. (with-output-to-string (s)
  180. (format s "Header: version/revision: ~d/~d, flags: ~a, size = ~:d bytes; ~a; ~a"
  181. version revision (print-header-flags nil flags) size
  182. (if (and (header-extended-p flags) ext-header)
  183. (concatenate 'string "Extended header: " (vpprint ext-header nil))
  184. "No extended header")
  185. (if v21-tag-header
  186. (concatenate 'string "V21 tag: " (vpprint v21-tag-header nil))
  187. "No V21 tag"))
  188. (when frames
  189. (format s "~&~4tFrames[~d]:~%" (length frames))
  190. (dolist (f frames)
  191. (format s "~8t~a~%" (vpprint f nil))))))))
  192. (defmethod initialize-instance :after ((me id3-header) &key instream &allow-other-keys)
  193. "Fill in an mp3-header from INSTREAM."
  194. (log5:with-context "id3-header-initializer"
  195. (with-slots (version revision flags size ext-header frames v21-tag-header) me
  196. (stream-seek instream 128 :end)
  197. (when (string= "TAG" (stream-read-string-with-len instream 3))
  198. (log-id3-frame "looking at last 128 bytes at ~:d to try to read id3v21 header" (stream-seek instream))
  199. (handler-case
  200. (setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
  201. (id3-frame-condition (c)
  202. (log-id3-frame "reading v21 got condition: ~a" c))))
  203. (stream-seek instream 0 :start)
  204. (when (string= "ID3" (stream-read-string-with-len instream 3))
  205. (setf version (stream-read-u8 instream))
  206. (setf revision (stream-read-u8 instream))
  207. (setf flags (stream-read-u8 instream))
  208. (setf size (stream-read-u32 instream :bits-per-byte 7))
  209. (when (header-unsynchronized-p flags)
  210. (log-id3-frame "header flags indicate unsync"))
  211. (assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet")
  212. (log-id3-frame "id3 header = ~a" (vpprint me nil))))))
  213. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  214. ;;;
  215. ;;; General plan: for each frame type we are interested in, DEFCLASS a class with
  216. ;;; specfic naming convention: frame-xxx/frame-xxxx, where xxx is valid ID3V2.2 frame name
  217. ;;; and xxxx is a valid ID3V2.[34] frame name. Upon finding a frame name in an MP3 file,
  218. ;;; we can then do a FIND-CLASS on the "frame-xxx", and a MAKE-INSTANCE on the found class
  219. ;;; to read in that class (each defined class is assumed to have an INITIALIZE-INSTANCE method
  220. ;;; that reads in data to build class.
  221. ;;;
  222. ;;; Each frame class assumes that the STREAM being passed has been made sync-safe.
  223. ;;;
  224. ;;; For any class we don't want to parse (eg, haven't gotten around to it yet, etc), we create
  225. ;;; a RAW-FRAME class that can be subclassed. RAW-FRAME simply reads in the frame header, and then
  226. ;;; the frame "payload" as raw OCTETS.
  227. ;;;
  228. ;;; many ID3 tags are name/value pairs, with the name/value encoded in various ways
  229. ;;; this routine assumes that the "name" is always a string with a "normal" encoding (i.e. 0, 1, 2, or 3).
  230. ;;; The "value" field accepts "normal" encoding, but also accepts any negative number, which means read
  231. ;;; the bytes an raw octets.
  232. (defun get-name-value-pair (instream len name-encoding value-encoding)
  233. (log5:with-context "get-name-value-pair"
  234. (log-id3-frame "reading from ~:d, len ~:d, name-encoding = ~d, value-encoding = ~d" (stream-seek instream) len name-encoding value-encoding)
  235. (let* ((old-pos (stream-seek instream))
  236. (name (stream-read-string instream :encoding name-encoding))
  237. (name-len (- (stream-seek instream) old-pos))
  238. (value))
  239. (log-id3-frame "name = <~a>, name-len = ~d" name name-len)
  240. (setf value (if (>= value-encoding 0)
  241. (stream-read-string-with-len instream (- len name-len) :encoding value-encoding)
  242. (stream-read-sequence instream (- len name-len)))) ; if < 0, then just read as octets
  243. (values name value))))
  244. (defclass id3-frame ()
  245. ((pos :accessor pos :initarg :pos :documentation "the offset in the buffer were this frame was found")
  246. (id :accessor id :initarg :id :documentation "the 3-4 character name of this frame")
  247. (len :accessor len :initarg :len :documentation "the length of this frame")
  248. (version :accessor version :initarg :version :documentation "the ID3-HEADER version number stored here for convenience")
  249. (flags :accessor flags :initarg :flags :initform nil :documentation "the frame's flags"))
  250. (:documentation "Base class for an ID3 frame. Used for versions 2.2, 2.3, and 2.4"))
  251. ;;; The frame flags are the same for V22/V23
  252. (defmacro frame-23-altertag-p (frame-flags) `(logbitp 15 ,frame-flags))
  253. (defmacro frame-23-alterfile-p (frame-flags) `(logbitp 14 ,frame-flags))
  254. (defmacro frame-23-readonly-p (frame-flags) `(logbitp 13 ,frame-flags))
  255. (defmacro frame-23-compress-p (frame-flags) `(logbitp 7 ,frame-flags))
  256. (defmacro frame-23-encrypt-p (frame-flags) `(logbitp 6 ,frame-flags))
  257. (defmacro frame-23-group-p (frame-flags) `(logbitp 5 ,frame-flags))
  258. ;;; frame flags are different for 2.4. Also note, that some flags indicate that additional data
  259. ;;; follows the frame header and these must be read in the order of the flags
  260. (defmacro frame-24-altertag-p (frame-flags) `(logbitp 14 ,frame-flags)) ; no additional data
  261. (defmacro frame-24-alterfile-p (frame-flags) `(logbitp 13 ,frame-flags)) ; no additional data
  262. (defmacro frame-24-readonly-p (frame-flags) `(logbitp 12 ,frame-flags)) ; no additional data
  263. (defmacro frame-24-groupid-p (frame-flags) `(logbitp 6 ,frame-flags)) ; one byte added to frame
  264. (defmacro frame-24-compress-p (frame-flags) `(logbitp 3 ,frame-flags)) ; one byte added to frame
  265. (defmacro frame-24-encrypt-p (frame-flags) `(logbitp 2 ,frame-flags)) ; wonky case, may or may not be set, dependin on encryption type
  266. (defmacro frame-24-unsynch-p (frame-flags) `(logbitp 1 ,frame-flags)) ; *may* have a 4-byte field after header, iff datalen is set
  267. (defmacro frame-24-datalen-p (frame-flags) `(logbitp 0 ,frame-flags)) ; if unsynch is set and this too, 4-bytes are added to frame
  268. ;; NB version 2.2 does NOT have FLAGS field in a frame; hence, the ECASE
  269. (defun valid-frame-flags (header-version frame-flags)
  270. (ecase header-version
  271. (3 (zerop (logand #b0001111100011111 frame-flags)))
  272. (4 (zerop (logand #b1000111110110000 frame-flags)))))
  273. (defun print-frame-flags (version flags stream)
  274. (ecase version
  275. (2 (format stream "None, "))
  276. (3 (format stream
  277. "flags: 0x~4,'0x: ~:[0/~;tag-alter-preservation/~]~:[0/~;file-alter-preservation/~]~:[0/~;read-only/~]~:[0/~;compress/~]~:[0/~;encypt/~]~:[0~;group~], "
  278. flags
  279. (frame-23-altertag-p flags)
  280. (frame-23-alterfile-p flags)
  281. (frame-23-readonly-p flags)
  282. (frame-23-compress-p flags)
  283. (frame-23-encrypt-p flags)
  284. (frame-23-group-p flags)))
  285. (4 (format stream
  286. "flags: 0x~4,'0x: ~:[0/~;tag-alter-preservation/~]~:[0/~;file-alter-preservation/~]~:[0/~;read-only/~]~:[0/~;group-id/~]~:[0/~;compress/~]~:[0/~;encypt/~]~:[0/~;unsynch/~]~:[0~;datalen~], "
  287. flags
  288. (frame-24-altertag-p flags)
  289. (frame-24-alterfile-p flags)
  290. (frame-24-readonly-p flags)
  291. (frame-24-groupid-p flags)
  292. (frame-24-compress-p flags)
  293. (frame-24-encrypt-p flags)
  294. (frame-24-unsynch-p flags)
  295. (frame-24-datalen-p flags)))))
  296. (defun vpprint-frame-header (id3-frame)
  297. (with-output-to-string (stream)
  298. (with-slots (pos version id len flags) id3-frame
  299. (format stream "offset: ~:d, version = ~d, id: ~a, len: ~:d, ~a" pos version id len
  300. (if flags
  301. (print-frame-flags version flags stream)
  302. "flags: none")))))
  303. (defclass frame-raw (id3-frame)
  304. ((octets :accessor octets :initform nil))
  305. (:documentation "Frame class that slurps in frame contents w/no attempt to grok them"))
  306. (defmethod initialize-instance :after ((me frame-raw) &key instream)
  307. (log5:with-context "frame-raw"
  308. (with-slots (pos len octets) me
  309. (log-id3-frame "reading ~:d bytes from position ~:d" len pos)
  310. (setf octets (stream-read-sequence instream len))
  311. (log-id3-frame "frame: ~a" (vpprint me nil)))))
  312. (defmethod vpprint ((me frame-raw) stream)
  313. (with-slots (octets) me
  314. (format stream "frame-raw: ~a, ~a" (vpprint-frame-header me) (printable-array octets))))
  315. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; V2.2 frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  316. (defclass frame-buf (frame-raw) ())
  317. (defclass frame-cnt (frame-raw) ())
  318. (defclass frame-cra (frame-raw) ())
  319. (defclass frame-crm (frame-raw) ())
  320. (defclass frame-equ (frame-raw) ())
  321. (defclass frame-etc (frame-raw) ())
  322. (defclass frame-geo (frame-raw) ())
  323. (defclass frame-ipl (frame-raw) ())
  324. (defclass frame-lnk (frame-raw) ())
  325. (defclass frame-mci (frame-raw) ())
  326. (defclass frame-mll (frame-raw) ())
  327. (defclass frame-pop (frame-raw) ())
  328. (defclass frame-rev (frame-raw) ())
  329. (defclass frame-rva (frame-raw) ())
  330. (defclass frame-slt (frame-raw) ())
  331. (defclass frame-waf (frame-raw) ())
  332. (defclass frame-war (frame-raw) ())
  333. (defclass frame-was (frame-raw) ())
  334. (defclass frame-wcm (frame-raw) ())
  335. (defclass frame-wcp (frame-raw) ())
  336. (defclass frame-wpb (frame-raw) ())
  337. (defclass frame-stc (frame-raw) ())
  338. ;;; V22 User defined... "WXX"
  339. ;;; Text encoding $xx
  340. ;;; Description <textstring> $00 (00)
  341. ;;; URL <textstring>
  342. ;;; Identical to TXX
  343. (defclass frame-wxx (frame-txx) ())
  344. ;; V22 COM frames
  345. ;; Comment "COM"
  346. ;; Text encoding $xx
  347. ;; Language $xx xx xx
  348. ;; Short content description <textstring> $00 (00)
  349. ;; The actual text <textstring>
  350. (defclass frame-com (id3-frame)
  351. ((encoding :accessor encoding)
  352. (lang :accessor lang)
  353. (desc :accessor desc)
  354. (val :accessor val)))
  355. (defmethod initialize-instance :after ((me frame-com) &key instream)
  356. (log5:with-context "frame-com"
  357. (with-slots (len encoding lang desc val) me
  358. (setf encoding (stream-read-u8 instream))
  359. (setf lang (stream-read-iso-string-with-len instream 3))
  360. (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
  361. (setf desc n)
  362. ;; iTunes broken-ness... for frame-coms, there can be an additional null or two at the end
  363. (setf val (upto-null v)))
  364. (log-id3-frame "encoding = ~d, lang = <~a>, desc = <~a>, text = <~a>" encoding lang desc val))))
  365. (defmethod vpprint ((me frame-com) stream)
  366. (with-slots (len encoding lang desc val) me
  367. (format stream "frame-com: ~a, encoding = ~d, lang = <~a> (~a), desc = <~a>, val = <~a>"
  368. (vpprint-frame-header me) encoding lang (get-iso-639-2-language lang) desc val)))
  369. ;;; ULT's are same format as COM's... XXX rewrite this as suggested in comment at bottom of this file
  370. ;;; V22 unsynced lyrics/text "ULT"
  371. ;;; Text encoding $xx
  372. ;;; Language $xx xx xx
  373. ;;; Content descriptor <textstring> $00 (00)
  374. ;;; Lyrics/text <textstring>
  375. (defclass frame-ult (frame-com) ())
  376. ;; V22 PIC frames
  377. ;; Attached picture "PIC"
  378. ;; Text encoding $xx
  379. ;; Image format $xx xx xx
  380. ;; Picture type $xx
  381. ;; Description <textstring> $00 (00)
  382. ;; Picture data <binary data>
  383. (defclass frame-pic (id3-frame)
  384. ((encoding :accessor encoding)
  385. (img-format :accessor img-format)
  386. (type :accessor type)
  387. (desc :accessor desc)
  388. (data :accessor data)))
  389. (defmethod initialize-instance :after ((me frame-pic) &key instream)
  390. (log5:with-context "frame-pic"
  391. (with-slots (id len encoding img-format type desc data) me
  392. (setf encoding (stream-read-u8 instream))
  393. (setf img-format (stream-read-iso-string-with-len instream 3))
  394. (setf type (stream-read-u8 instream))
  395. (multiple-value-bind (n v) (get-name-value-pair instream (- len 5) encoding -1)
  396. (setf desc n)
  397. (setf data v)
  398. (log-id3-frame "encoding: ~d, img-format = <~a>, type = ~d (~a), desc = <~a>, value = ~a"
  399. encoding img-format type (get-picture-type type) desc (printable-array data))))))
  400. (defmethod vpprint ((me frame-pic) stream)
  401. (with-slots (encoding img-format type desc data) me
  402. (format stream "frame-pic: ~a, encoding ~d, img-format type: <~a>, picture type: ~d (~a), description <~a>, data: ~a"
  403. (vpprint-frame-header me) encoding img-format type (get-picture-type type) desc (printable-array data))))
  404. ;; Version 2, 3, or 4 generic text-info frames
  405. ;; Text information identifier "T00" - "TZZ", excluding "TXX", or "T000 - TZZZ", excluding "TXXX"
  406. ;; Text encoding $xx
  407. ;; Information <textstring>
  408. (defclass frame-text-info (id3-frame)
  409. ((encoding :accessor encoding)
  410. (info :accessor info))
  411. (:documentation "V2/V3/V4 T00-TZZ and T000-TZZZ frames, but not TXX or TXXX"))
  412. (defmethod initialize-instance :after ((me frame-text-info) &key instream)
  413. (log5:with-context "frame-text-info"
  414. (with-slots (version flags len encoding info) me
  415. (let ((read-len len))
  416. ;; In version 4 frames, each frame may also have an unsync flag. since we have unsynced already
  417. ;; the only thing we need to do here is check for the optional DATALEN field. If it is present
  418. ;; then it has the actual number of octets to read
  419. (when (and (= version 4) (frame-24-unsynch-p flags))
  420. (if (frame-24-datalen-p flags)
  421. (setf read-len (stream-read-u32 instream :bits-per-byte 7))))
  422. (setf encoding (stream-read-u8 instream))
  423. (setf info (stream-read-string-with-len instream (1- read-len) :encoding encoding)))
  424. ;; A null is ok, but according to the "spec", you're supposed to ignore anything after a 'Null'
  425. (log-id3-frame "made text-info-frame: ~a" (vpprint me nil))
  426. (setf info (upto-null info))
  427. (log-id3-frame "encoding = ~d, info = <~a>" encoding info))))
  428. (defmethod vpprint ((me frame-text-info) stream)
  429. (with-slots (len encoding info) me
  430. (format stream "frame-text-info: ~a, encoding = ~d, info = <~a>" (vpprint-frame-header me) encoding info)))
  431. (defclass frame-tal (frame-text-info) ())
  432. (defclass frame-tbp (frame-text-info) ())
  433. (defclass frame-tcm (frame-text-info) ())
  434. (defclass frame-tco (frame-text-info) ())
  435. (defclass frame-tcp (frame-text-info) ())
  436. (defclass frame-tcr (frame-text-info) ())
  437. (defclass frame-tda (frame-text-info) ())
  438. (defclass frame-tdy (frame-text-info) ())
  439. (defclass frame-ten (frame-text-info) ())
  440. (defclass frame-tft (frame-text-info) ())
  441. (defclass frame-tim (frame-text-info) ())
  442. (defclass frame-tke (frame-text-info) ())
  443. (defclass frame-tla (frame-text-info) ())
  444. (defclass frame-tle (frame-text-info) ())
  445. (defclass frame-tmt (frame-text-info) ())
  446. (defclass frame-toa (frame-text-info) ())
  447. (defclass frame-tof (frame-text-info) ())
  448. (defclass frame-tol (frame-text-info) ())
  449. (defclass frame-tor (frame-text-info) ())
  450. (defclass frame-tot (frame-text-info) ())
  451. (defclass frame-tp1 (frame-text-info) ())
  452. (defclass frame-tp2 (frame-text-info) ())
  453. (defclass frame-tp3 (frame-text-info) ())
  454. (defclass frame-tp4 (frame-text-info) ())
  455. (defclass frame-tpa (frame-text-info) ())
  456. (defclass frame-tpb (frame-text-info) ())
  457. (defclass frame-trc (frame-text-info) ())
  458. (defclass frame-trd (frame-text-info) ())
  459. (defclass frame-trk (frame-text-info) ())
  460. (defclass frame-tsi (frame-text-info) ())
  461. (defclass frame-tss (frame-text-info) ())
  462. (defclass frame-tt1 (frame-text-info) ())
  463. (defclass frame-tt2 (frame-text-info) ())
  464. (defclass frame-tt3 (frame-text-info) ())
  465. (defclass frame-txt (frame-text-info) ())
  466. (defclass frame-tye (frame-text-info) ())
  467. ;; V22 User defined "TXX" frames
  468. ;; Text encoding $xx
  469. ;; Description <textstring> $00 (00)
  470. ;; Value <textstring>
  471. (defclass frame-txx (id3-frame)
  472. ((encoding :accessor encoding)
  473. (desc :accessor desc)
  474. (val :accessor val))
  475. (:documentation "TXX is the only frame starting with a 'T' that has a different format"))
  476. (defmethod initialize-instance :after ((me frame-txx) &key instream)
  477. (log5:with-context "frame-txx"
  478. (with-slots (len encoding desc val) me
  479. (setf encoding (stream-read-u8 instream))
  480. (multiple-value-bind (n v) (get-name-value-pair instream (1- len) encoding encoding)
  481. (setf desc n)
  482. (setf val v)
  483. (log-id3-frame "encoding = ~d, desc = <~a>, val = <~a>" encoding desc val)))))
  484. (defmethod vpprint ((me frame-txx) stream)
  485. (with-slots (len encoding desc val) me
  486. (format stream "frame-txx: ~a, encoding = ~d, desc = <~a>, val = <~a>" (vpprint-frame-header me) encoding desc val)))
  487. ;;; V22 unique file identifier "UFI"
  488. ;;; Owner identifier <textstring> $00
  489. ;;; Identifier <up to 64 bytes binary data>
  490. (defclass frame-ufi (id3-frame)
  491. ((name :accessor name)
  492. (value :accessor value))
  493. (:documentation "Unique File Identifier"))
  494. (defmethod initialize-instance :after ((me frame-ufi) &key instream)
  495. (log5:with-context "frame-ufi"
  496. (with-slots (id len name value) me
  497. (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
  498. (setf name n)
  499. (setf value v))
  500. (log-id3-frame "name = <~a>, value = ~a" name (printable-array value)))))
  501. (defmethod vpprint ((me frame-ufi) stream)
  502. (with-slots (id len name value) me
  503. (format stream "frame-ufi: ~a, name: <~a>, value: ~a" (vpprint-frame-header me) name (printable-array value))))
  504. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; V23/V24 frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  505. (defclass frame-aenc (frame-raw) ())
  506. (defclass frame-aspi (frame-raw) ())
  507. (defclass frame-comr (frame-raw) ())
  508. (defclass frame-encr (frame-raw) ())
  509. (defclass frame-equ2 (frame-raw) ())
  510. (defclass frame-equa (frame-raw) ())
  511. (defclass frame-etco (frame-raw) ())
  512. (defclass frame-geob (frame-raw) ())
  513. (defclass frame-grid (frame-raw) ())
  514. (defclass frame-ipls (frame-raw) ())
  515. (defclass frame-link (frame-raw) ())
  516. (defclass frame-mcdi (frame-raw) ())
  517. (defclass frame-mllt (frame-raw) ())
  518. (defclass frame-ncon (frame-raw) ())
  519. (defclass frame-owne (frame-raw) ())
  520. (defclass frame-popm (frame-raw) ())
  521. (defclass frame-poss (frame-raw) ())
  522. (defclass frame-rbuf (frame-raw) ())
  523. (defclass frame-rva2 (frame-raw) ())
  524. (defclass frame-rvad (frame-raw) ())
  525. (defclass frame-rvrb (frame-raw) ())
  526. (defclass frame-seek (frame-raw) ())
  527. (defclass frame-sign (frame-raw) ())
  528. (defclass frame-sylt (frame-raw) ())
  529. (defclass frame-sytc (frame-raw) ())
  530. (defclass frame-user (frame-raw) ())
  531. ;;; V23/V24 text-info frames
  532. (defclass frame-talb (frame-text-info) ())
  533. (defclass frame-tbpm (frame-text-info) ())
  534. (defclass frame-tcmp (frame-text-info) ())
  535. (defclass frame-tcom (frame-text-info) ())
  536. (defclass frame-tcon (frame-text-info) ())
  537. (defclass frame-tcop (frame-text-info) ())
  538. (defclass frame-tdat (frame-text-info) ())
  539. (defclass frame-tden (frame-text-info) ())
  540. (defclass frame-tdly (frame-text-info) ())
  541. (defclass frame-tdor (frame-text-info) ())
  542. (defclass frame-tdrc (frame-text-info) ())
  543. (defclass frame-tdrl (frame-text-info) ())
  544. (defclass frame-tdtg (frame-text-info) ())
  545. (defclass frame-tenc (frame-text-info) ())
  546. (defclass frame-text (frame-text-info) ())
  547. (defclass frame-tflt (frame-text-info) ())
  548. (defclass frame-time (frame-text-info) ())
  549. (defclass frame-tipl (frame-text-info) ())
  550. (defclass frame-tit1 (frame-text-info) ())
  551. (defclass frame-tit2 (frame-text-info) ())
  552. (defclass frame-tit3 (frame-text-info) ())
  553. (defclass frame-tkey (frame-text-info) ())
  554. (defclass frame-tlan (frame-text-info) ())
  555. (defclass frame-tlen (frame-text-info) ())
  556. (defclass frame-tmcl (frame-text-info) ())
  557. (defclass frame-tmed (frame-text-info) ())
  558. (defclass frame-tmoo (frame-text-info) ())
  559. (defclass frame-toal (frame-text-info) ())
  560. (defclass frame-tofn (frame-text-info) ())
  561. (defclass frame-toly (frame-text-info) ())
  562. (defclass frame-tope (frame-text-info) ())
  563. (defclass frame-tory (frame-text-info) ())
  564. (defclass frame-town (frame-text-info) ())
  565. (defclass frame-tpe1 (frame-text-info) ())
  566. (defclass frame-tpe2 (frame-text-info) ())
  567. (defclass frame-tpe3 (frame-text-info) ())
  568. (defclass frame-tpe4 (frame-text-info) ())
  569. (defclass frame-tpos (frame-text-info) ())
  570. (defclass frame-tpro (frame-text-info) ())
  571. (defclass frame-tpub (frame-text-info) ())
  572. (defclass frame-trda (frame-text-info) ())
  573. (defclass frame-trsn (frame-text-info) ())
  574. (defclass frame-trso (frame-text-info) ())
  575. (defclass frame-tsoa (frame-text-info) ())
  576. (defclass frame-tsop (frame-text-info) ())
  577. (defclass frame-tsot (frame-text-info) ())
  578. (defclass frame-tsst (frame-text-info) ())
  579. (defclass frame-tsse (frame-text-info) ())
  580. (defclass frame-tsrc (frame-text-info) ())
  581. (defclass frame-tsiz (frame-text-info) ())
  582. (defclass frame-tyer (frame-text-info) ())
  583. (defclass frame-trck (frame-text-info) ())
  584. (defparameter *picture-type*
  585. '("Other"
  586. "32x32 pixels 'file icon' (PNG only)"
  587. "Other file icon"
  588. "Cover (front)"
  589. "Cover (back)"
  590. "Leaflet page"
  591. "Media (e.g. lable side of CD)"
  592. "Lead artist/lead performer/soloist"
  593. "Artist/performer"
  594. "Conductor"
  595. "Band/Orchestra"
  596. "Composer"
  597. "Lyricist/text writer"
  598. "Recording Location"
  599. "During recording"
  600. "During performance"
  601. "Movie/video screen capture"
  602. "A bright coloured fish" ; how do you know the fish is intelligent? :)
  603. "Illustration"
  604. "Band/artist logotype"
  605. "Publisher/Studio logotype"))
  606. (defun get-picture-type (n)
  607. "Function to return picture types for APIC frames"
  608. (if (and (>= n 0) (< n (length *picture-type*)))
  609. (nth n *picture-type*)
  610. "Unknown"))
  611. ;; V23/V24 APIC frames
  612. ;; <Header for 'Attached picture', ID: "APIC">
  613. ;; Text encoding $xx
  614. ;; MIME type <text string> $00
  615. ;; Picture type $xx
  616. ;; Description <text string according to encoding> $00 (00)
  617. ;; Picture data <binary data>
  618. (defclass frame-apic (id3-frame)
  619. ((encoding :accessor encoding)
  620. (mime :accessor mime)
  621. (type :accessor type)
  622. (desc :accessor desc)
  623. (data :accessor data))
  624. (:documentation "Holds an attached picture (cover art)"))
  625. (defmethod initialize-instance :after ((me frame-apic) &key instream)
  626. (log5:with-context "frame-apic"
  627. (with-slots (id len encoding mime type desc data) me
  628. (setf encoding (stream-read-u8 instream))
  629. (setf mime (stream-read-iso-string instream))
  630. (setf type (stream-read-u8 instream))
  631. (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 (length mime) 1 1) encoding -1)
  632. (setf desc n)
  633. (setf data v)
  634. (log-id3-frame "enoding = ~d, mime = <~a>, type = ~d (~a), desc = <~a>, data = ~a" encoding mime type (get-picture-type type) desc (printable-array data))))))
  635. (defmethod vpprint ((me frame-apic) stream)
  636. (with-slots (encoding mime type desc data) me
  637. (format stream "frame-apic: ~a, encoding ~d, mime type: ~a, picture type: ~d (~a), description <~a>, data: ~a"
  638. (vpprint-frame-header me) encoding mime type (get-picture-type type) desc (printable-array data))))
  639. ;;; V23/V24 COMM frames
  640. ;;; <Header for 'Comment', ID: "COMM">
  641. ;;; Text encoding $xx
  642. ;;; Language $xx xx xx
  643. ;;; Short content descrip. <text string according to encoding> $00 (00)
  644. ;;; The actual text <full text string according to encoding>
  645. (defclass frame-comm (id3-frame)
  646. ((encoding :accessor encoding)
  647. (lang :accessor lang)
  648. (desc :accessor desc)
  649. (val :accessor val))
  650. (:documentation "V23/4 Comment frame"))
  651. (defmethod initialize-instance :after ((me frame-comm) &key instream)
  652. (log5:with-context "frame-comm"
  653. (with-slots (encoding lang len desc val) me
  654. (setf encoding (stream-read-u8 instream))
  655. (setf lang (stream-read-iso-string-with-len instream 3))
  656. (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
  657. (setf desc n)
  658. ;; iTunes broken-ness... for frame-coms, there can be an additional null or two at the end
  659. (setf val (upto-null v)))
  660. (log-id3-frame "encoding = ~d, lang = <~a>, desc = <~a>, val = <~a>" encoding lang desc val))))
  661. (defmethod vpprint ((me frame-comm) stream)
  662. (with-slots (encoding lang desc val) me
  663. (format stream "frame-comm: ~a, encoding: ~d, lang: <~a> (~a), desc = <~a>, val = <~a>"
  664. (vpprint-frame-header me) encoding lang (get-iso-639-2-language lang) desc val)))
  665. ;;; Unsynchronized lyrics frames look very much like comment frames...
  666. (defclass frame-uslt (frame-comm) ())
  667. ;;; V23/24 PCNT frames
  668. ;;; <Header for 'Play counter', ID: "PCNT">
  669. ;;; Counter $xx xx xx xx (xx ...)
  670. (defclass frame-pcnt (id3-frame)
  671. ((play-count :accessor play-count))
  672. (:documentation "Play count frame"))
  673. (defmethod initialize-instance :after ((me frame-pcnt) &key instream)
  674. (log5:with-context "frame-pcnt"
  675. (with-slots (play-count len) me
  676. (assert (= 4 len) () "Ran into a play count with ~d bytes" len)
  677. (setf play-count (stream-read-u32 instream)) ; probably safe---play count *can* be longer than 4 bytes, but...
  678. (log-id3-frame "play count = <~d>" play-count))))
  679. (defmethod vpprint ((me frame-pcnt) stream)
  680. (with-slots (play-count) me
  681. (format stream "frame-pcnt: ~a, count = ~d" (vpprint-frame-header me) play-count)))
  682. ;;; V23/V24 PRIV frames
  683. ;;; <Header for 'Private frame', ID: "PRIV">
  684. ;;; Owner identifier <text string> $00
  685. ;;; The private data <binary data>
  686. (defclass frame-priv (id3-frame)
  687. ((name :accessor name)
  688. (value :accessor value))
  689. (:documentation "Private frame"))
  690. (defmethod initialize-instance :after ((me frame-priv) &key instream)
  691. (log5:with-context "frame-priv"
  692. (with-slots (id len name value) me
  693. (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
  694. (setf name n)
  695. (setf value v)
  696. (log-id3-frame "name = <~a>, value = <~a>" name value)))))
  697. (defmethod vpprint ((me frame-priv) stream)
  698. (with-slots (id len name value) me
  699. (format stream "frame-priv: ~a, name: <~a>, data: ~a" (vpprint-frame-header me) name (printable-array value))))
  700. ;; V23/V24 TXXX frames
  701. ;; <Header for 'User defined text information frame', ID: "TXXX">
  702. ;; Text encoding $xx
  703. ;; Description <text string according to encoding> $00 (00)
  704. ;; Value <text string according to encoding>
  705. (defclass frame-txxx (id3-frame)
  706. ((encoding :accessor encoding)
  707. (desc :accessor desc)
  708. (val :accessor val))
  709. (:documentation "TXXX frame"))
  710. (defmethod initialize-instance :after ((me frame-txxx) &key instream)
  711. (log5:with-context "frame-txxx"
  712. (with-slots (encoding len desc val) me
  713. (setf encoding (stream-read-u8 instream))
  714. (multiple-value-bind (n v) (get-name-value-pair instream
  715. (- len 1)
  716. encoding
  717. encoding)
  718. (setf desc n)
  719. (setf val v))
  720. (log-id3-frame "encoding = ~d, desc = <~a>, value = <~a>" encoding desc val))))
  721. (defmethod vpprint ((me frame-txxx) stream)
  722. (format stream "frame-txxx: ~a, <~a/~a>" (vpprint-frame-header me) (desc me) (val me)))
  723. ;; V23/V24 UFID frames
  724. ;; <Header for 'Unique file identifier', ID: "UFID">
  725. ;; Owner identifier <text string> $00
  726. ;; Identifier <up to 64 bytes binary data>
  727. (defclass frame-ufid (id3-frame)
  728. ((name :accessor name)
  729. (value :accessor value))
  730. (:documentation "Unique file identifier frame"))
  731. (defmethod initialize-instance :after ((me frame-ufid) &key instream)
  732. (log5:with-context "frame-ufid"
  733. (with-slots (id len name value) me
  734. (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
  735. (setf name n)
  736. (setf value v))
  737. (log-id3-frame "name = <~a>, value = ~a" name (printable-array value)))))
  738. (defmethod vpprint ((me frame-ufid) stream)
  739. (with-slots (id len name value) me
  740. (format stream "frame-ufid: ~a, name: <~a>, value: ~a" (vpprint-frame-header me) name (printable-array value))))
  741. ;;; V23/V24 URL frame
  742. ;;; <Header for 'URL link frame', ID: "W000" - "WZZZ", excluding "WXXX" described in 4.3.2.>
  743. ;;; URL <text string>
  744. (defclass frame-url-link (id3-frame)
  745. ((url :accessor url))
  746. (:documentation "URL link frame"))
  747. (defmethod initialize-instance :after ((me frame-url-link) &key instream)
  748. (with-slots (id len url) me
  749. (log5:with-context "url"
  750. (setf url (stream-read-iso-string-with-len instream len))
  751. (log-id3-frame "url = <~a>" url))))
  752. (defmethod vpprint ((me frame-url-link) stream)
  753. (with-slots (url) me
  754. (format stream "frame-url-link: ~a, url: ~a" (vpprint-frame-header me) url)))
  755. ;;; V23/V24 frames URL link frames
  756. (defclass frame-wcom (frame-url-link) ())
  757. (defclass frame-wcop (frame-url-link) ())
  758. (defclass frame-woaf (frame-url-link) ())
  759. (defclass frame-woar (frame-url-link) ())
  760. (defclass frame-woas (frame-url-link) ())
  761. (defclass frame-wors (frame-url-link) ())
  762. (defclass frame-wpay (frame-url-link) ())
  763. (defclass frame-wpub (frame-url-link) ())
  764. ;;; Identical to frame-txx
  765. (defclass frame-wxxx (frame-txx) ())
  766. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; frame finding/creation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  767. (defun possibly-valid-frame-id? (frame-id)
  768. "test to see if a string is a potentially valid frame id"
  769. (labels ((numeric-char-p (c)
  770. (let ((code (char-code c)))
  771. (and (>= code (char-code #\0))
  772. (<= code (char-code #\9))))))
  773. ;; test each octet to see if it is alphanumeric
  774. (dotimes (i (length frame-id))
  775. (let ((c (aref frame-id i)))
  776. (when (not (or (numeric-char-p c)
  777. (and (alpha-char-p c) (upper-case-p c))))
  778. (return-from possibly-valid-frame-id? nil))))
  779. t))
  780. (defun find-frame-class (id)
  781. "Search by concatenating 'frame-' with ID and look for that symbol in this package"
  782. (log5:with-context "find-frame-class"
  783. (log-id3-frame "looking for class <~a>" id)
  784. (let ((found-class-symbol (find-symbol (string-upcase (concatenate 'string "frame-" id)) :ID3-FRAME))
  785. found-class)
  786. ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
  787. (when found-class-symbol
  788. (setf found-class (find-class found-class-symbol))
  789. (log-id3-frame "found class: ~a" found-class)
  790. (return-from find-frame-class found-class))
  791. (log-id3-frame "didn't find class, checking general cases")
  792. ;; if not a "normal" frame-id, look at general cases of
  793. ;; starting with a 'T' or a 'W'
  794. (setf found-class (case (aref id 0)
  795. (#\T (log-id3-frame "assuming text-info") (find-class (find-symbol "FRAME-TEXT-INFO" :ID3-FRAME)))
  796. (#\W (log-id3-frame "assuming url-link") (find-class (find-symbol "FRAME-URL-LINK" :ID3-FRAME)))
  797. (t
  798. ;; we don't recognize the frame name. if it could possibly be a real frame name,
  799. ;; then just read it raw
  800. (when (possibly-valid-frame-id? id)
  801. (log-id3-frame "just reading raw")
  802. (find-class (find-symbol "FRAME-RAW" :ID3-FRAME))))))
  803. (log-id3-frame "general case for id <~a> is ~a" id found-class)
  804. found-class)))
  805. (defun make-frame (version instream fn)
  806. "Create an appropriate mp3 frame by reading data from INSTREAM."
  807. (log5:with-context "make-frame"
  808. (let* ((pos (stream-seek instream))
  809. (byte (stream-read-u8 instream))
  810. frame-name frame-len frame-flags frame-class)
  811. (log-id3-frame "reading from position ~:d (size of stream = ~:d)" pos (stream-size instream))
  812. (when (zerop byte) ; XXX should this be correlated to PADDING in the extended header???
  813. (log-id3-frame "hit padding of size ~:d while making a frame" (- (stream-size instream) pos))
  814. (return-from make-frame nil)) ; hit padding
  815. (setf frame-name
  816. (concatenate 'string (string (code-char byte)) (stream-read-string-with-len instream (ecase version (2 2) (3 3) (4 3)))))
  817. (setf frame-len (ecase version
  818. (2 (stream-read-u24 instream))
  819. (3 (stream-read-u32 instream))
  820. (4 (stream-read-u32 instream :bits-per-byte 7))))
  821. (when (or (= version 3) (= version 4))
  822. (setf frame-flags (stream-read-u16 instream))
  823. (when (not (valid-frame-flags version frame-flags))
  824. (log-id3-frame "Invalid frame flags found ~a, will ignore" (print-frame-flags version frame-flags nil))
  825. (warn-user "Invalid frame flags found in ~a: ~a, will ignore" fn (print-frame-flags version frame-flags nil))))
  826. (log-id3-frame "making frame: id:~a, version: ~d, len: ~:d, flags: ~a"
  827. frame-name version frame-len
  828. (print-frame-flags version frame-flags nil))
  829. (setf frame-class (find-frame-class frame-name))
  830. ;; edge case where found a frame name, but it is not valid or where making this frame
  831. ;; would blow past the end of the file/buffer
  832. (when (or (> (+ (stream-seek instream) frame-len) (stream-size instream))
  833. (null frame-class))
  834. (error 'id3-frame-condition :message "bad frame found" :object frame-name :location pos))
  835. (make-instance frame-class :pos pos :version version :id frame-name :len frame-len :flags frame-flags :instream instream))))
  836. (defmethod find-id3-frames ((mp3-file mp3-file-stream))
  837. "With an open mp3-file, make sure it is in fact an MP3 file, then read it's header and frames"
  838. (labels ((read-loop (version stream)
  839. (log5:with-context "read-loop-in-find-id3-frames"
  840. (log-id3-frame "Starting loop through ~:d bytes" (stream-size stream))
  841. (let (frames this-frame)
  842. (do ()
  843. ((>= (stream-seek stream) (stream-size stream)))
  844. (handler-case
  845. (progn
  846. (setf this-frame (make-frame version stream (stream-filename mp3-file)))
  847. (when (null this-frame)
  848. (log-id3-frame "hit padding: returning ~d frames" (length frames))
  849. (return-from read-loop (values t (nreverse frames))))
  850. (log-id3-frame "bottom of read-loop: pos = ~:d, size = ~:d" (stream-seek stream) (stream-size stream))
  851. (push this-frame frames))
  852. (condition (c)
  853. (log-id3-frame "got condition ~a when making frame" c)
  854. (return-from read-loop (values nil (nreverse frames))))))
  855. (log-id3-frame "Succesful read: returning ~d frames" (length frames))
  856. (values t (nreverse frames)))))) ; reverse this so we have frames in "file order"
  857. (log5:with-context "find-id3-frames"
  858. (log-id3-frame "~a is a valid mp3 file" (stream-filename mp3-file))
  859. (setf (id3-header mp3-file) (make-instance 'id3-header :instream mp3-file))
  860. (with-slots (size ext-header frames flags version) (id3-header mp3-file)
  861. ;; At this point, we switch from reading the file stream and create a memory stream
  862. ;; rationale: it may need to be unsysnc'ed and it helps prevent run-away reads with
  863. ;; mis-formed frames
  864. (when (not (zerop size))
  865. (let ((mem-stream (make-mem-stream (stream-read-sequence mp3-file size
  866. :bits-per-byte (if (header-unsynchronized-p flags) 7 8)))))
  867. ;; Must make extended header here since it is subject to unsynchronization.
  868. (when (header-extended-p flags)
  869. (setf ext-header (make-instance 'id3-ext-header :instream mem-stream :version version)))
  870. (log-id3-frame "Complete header: ~a" (vpprint (id3-header mp3-file) nil))
  871. ;; Start reading frames from memory stream
  872. (multiple-value-bind (_ok _frames) (read-loop version mem-stream)
  873. (if (not _ok)
  874. (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
  875. (log-id3-frame "ok = ~a, returning ~d frames" _ok (length _frames))
  876. (setf frames _frames)
  877. _ok)))))))
  878. (defun map-id3-frames (mp3-file &key (func (constantly t)))
  879. "Iterates through the ID3 frames found in an MP3 file"
  880. (mapcar func (frames (id3-header mp3-file))))
  881. #|
  882. XXX
  883. Random ideas for rewrite:
  884. -might be simplest to read in frame payloads (sync'ed appropriately) for all frames and then move parsing into
  885. accessor methods? This might be easier to handle sync/compression/etc.
  886. -probably should rewrite name/value pairs as a mixin class? Or more broadly, there is a finite set of frame-encodings,
  887. so abstact to that, then subclass for frame-????
  888. |#