reworked how files are opened and parsed

audio-streams.lisp

@@ -26,102 +26,107 @@
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 
 (defclass mem-stream ()
-  ((fn    :accessor fn    :initform nil :initarg :fn)
-   (index :accessor index :initform 0)
-   (len   :accessor len   :initform 0)
-   (vect  :accessor vect  :initform nil :initarg :vect)))
-
-(defmacro with-mem-stream-slots ((instance) &body body)
-  `(with-slots (fn index len vect) ,instance
-     (declare (integer index len))
-     ;; XXX Breaks things: (type (simple-array (unsigned-byte 8) (*)) vect))
-     ,@body))
-
-(defun make-mem-stream (v) (make-instance 'mem-stream :vect v))
-(defun make-mmap-stream (f) (make-instance 'mem-stream :fn f))
-
-(defmethod initialize-instance :after ((stream mem-stream) &key)
-  (with-mem-stream-slots (stream)
-    (when fn
-      (setf vect (ccl:map-file-to-octet-vector fn)))
-    (setf len (length vect))))
-
-(defmethod stream-close ((stream mem-stream))
-  (with-mem-stream-slots (stream)
-    (when fn
-      (ccl:unmap-octet-vector vect))
-    (setf vect nil)))
-
-(defmethod stream-seek ((stream mem-stream) &optional (offset 0) (from :current))
-  (with-mem-stream-slots (stream)
-    (ecase from
-      (:start (setf index offset))
-      (:current
-       (if (zerop offset)
-           index
-           (incf index offset)))
-       (:end (setf index (- len offset))))))
-
-;;; probably should just rename :ACCESSOR LEN to STREAM-SIZE? XXX
-(defmethod stream-size ((stream mem-stream)) (len stream))
-
-(defun read-n-bytes (stream n-bytes &key (bits-per-byte 8))
-  (fastest
-    (with-mem-stream-slots (stream)
-      (when (<= (+ index n-bytes) len)
-        (loop with value = 0
-              for low-bit downfrom (* bits-per-byte (1- n-bytes)) to 0 by bits-per-byte do
-                (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
-                (incf index)
-              finally (return-from read-n-bytes value))))
-    nil))
-
-(declaim (inline read-n-bytes))
-
-(defmethod stream-read-u8  ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 1 :bits-per-byte bits-per-byte))
-(defmethod stream-read-u16 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 2 :bits-per-byte bits-per-byte))
-(defmethod stream-read-u24 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 3 :bits-per-byte bits-per-byte))
-(defmethod stream-read-u32 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 4 :bits-per-byte bits-per-byte))
-(defmethod stream-read-u64 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 8 :bits-per-byte bits-per-byte))
-
-(defmethod stream-read-sequence ((stream mem-stream) size &key (bits-per-byte 8))
-  (fastest
-    (with-mem-stream-slots (stream)
-      (when (> (+ index size) len)
-        (setf size (- len index)))
-      (ecase bits-per-byte
-        (8 (let ((octets (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
-             (incf index size)
-             (values octets size)))
-        (7
-         (let* ((last-byte-was-FF nil)
-                (byte nil)
-                (octets (ccl:with-output-to-vector (out)
-                          (dotimes (i size)
-                            (setf byte (stream-read-u8 stream))
-                            (if last-byte-was-FF
-                                (if (not (zerop byte))
-                                    (write-byte byte out))
-                                (write-byte byte out))
-                            (setf last-byte-was-FF (= byte #xFF))))))
-           (values octets size)))))))
-
-(defclass mp3-file-stream (mem-stream)
-  ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")
-   (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
-  (:documentation "Stream for parsing MP3 files"))
-
-(defclass mp4-file-stream (mem-stream)
-  ((mp4-atoms  :accessor mp4-atoms  :initform nil :documentation "holds tree of parsed MP4 atoms/boxes")
-   (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
-  (:documentation "Stream for parsing MP4A files"))
-
-(defun make-file-stream (filename)
-  "Convenience function for creating a file stream."
-  (let ((new-stream (cond ((utils:has-extension filename "m4a") (make-instance 'mp4-file-stream :fn filename))
-                          ((utils:has-extension filename "mp3") (make-instance 'mp3-file-stream :fn filename))
-                          (t (error "unknown filename extension for file ~a" filename)))))
-    new-stream))
+   ((fn    :accessor fn    :initform nil :initarg :fn)
+    (index :accessor index :initform 0)
+    (len   :accessor len   :initform 0)
+    (vect  :accessor vect  :initform nil :initarg :vect))
+   (:documentation "A thin-wrapper class over mmaped-files and/or vectors"))
+
+ (defmacro with-mem-stream-slots ((instance) &body body)
+   `(with-slots (fn index len vect) ,instance
+      (declare (integer index len)
+               (type (array (unsigned-byte 8) 1) vect))
+      ,@body))
+
+ (defun make-mem-stream (v) (make-instance 'mem-stream :vect v))
+ (defun make-mmap-stream (f) (make-instance 'mem-stream :fn f))
+
+ (defmethod initialize-instance :after ((stream mem-stream) &key)
+   (with-mem-stream-slots (stream)
+     (when fn
+       (setf vect (ccl:map-file-to-octet-vector fn)))
+     (setf len (length vect))))
+
+ (defmethod stream-close ((stream mem-stream))
+   (with-mem-stream-slots (stream)
+     (when fn
+       (ccl:unmap-octet-vector vect))
+     (setf vect nil)))
+
+ (defmethod stream-seek ((stream mem-stream) &optional (offset 0) (from :current))
+   (with-mem-stream-slots (stream)
+     (ecase from
+       (:start (setf index offset))
+       (:current
+        (if (zerop offset)
+            index
+            (incf index offset)))
+        (:end (setf index (- len offset))))))
+
+ ;;; probably should just rename :ACCESSOR LEN to STREAM-SIZE? XXX
+ (defmethod stream-size ((stream mem-stream)) (len stream))
+
+ (defun read-n-bytes (stream n-bytes &key (bits-per-byte 8))
+   (fastest
+     (with-mem-stream-slots (stream)
+       (when (<= (+ index n-bytes) len)
+         (loop with value = 0
+               for low-bit downfrom (* bits-per-byte (1- n-bytes)) to 0 by bits-per-byte do
+                 (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
+                 (incf index)
+               finally (return-from read-n-bytes value))))
+     nil))
+
+ (declaim (inline read-n-bytes))
+
+ (defmethod stream-read-u8  ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 1 :bits-per-byte bits-per-byte))
+ (defmethod stream-read-u16 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 2 :bits-per-byte bits-per-byte))
+ (defmethod stream-read-u24 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 3 :bits-per-byte bits-per-byte))
+ (defmethod stream-read-u32 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 4 :bits-per-byte bits-per-byte))
+ (defmethod stream-read-u64 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 8 :bits-per-byte bits-per-byte))
+
+ (defmethod stream-read-sequence ((stream mem-stream) size &key (bits-per-byte 8))
+   (fastest
+     (with-mem-stream-slots (stream)
+       (when (> (+ index size) len)
+         (setf size (- len index)))
+       (ecase bits-per-byte
+         (8 (let ((octets (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
+              (incf index size)
+              (values octets size)))
+         (7
+          (let* ((last-byte-was-FF nil)
+                 (byte nil)
+                 (octets (ccl:with-output-to-vector (out)
+                           (dotimes (i size)
+                             (setf byte (stream-read-u8 stream))
+                             (if last-byte-was-FF
+                                 (if (not (zerop byte))
+                                     (write-byte byte out))
+                                 (write-byte byte out))
+                             (setf last-byte-was-FF (= byte #xFF))))))
+            (values octets size)))))))
+
+ (defclass mp3-file-stream (mem-stream)
+   ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")
+    (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
+   (:documentation "Stream for parsing MP3 files"))
+
+ (defclass mp4-file-stream (mem-stream)
+   ((mp4-atoms  :accessor mp4-atoms  :initform nil :documentation "holds tree of parsed MP4 atoms/boxes")
+    (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
+   (:documentation "Stream for parsing MP4A files"))
+
+ (defun make-file-stream (filename)
+   "Convenience function for creating a file stream."
+   (let* ((new-stream (make-mmap-stream filename))
+          (ret-stream))
+     (cond ((mp4-atom:is-valid-m4-file new-stream)
+            (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :fn (fn new-stream))))
+           ((id3-frame:is-valid-mp3-file new-stream)
+            (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :fn (fn new-stream)))))
+     (stream-close new-stream)
+     ret-stream))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Strings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -263,32 +268,23 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar *get-audio-info* t "controls whether the parsing functions also parse audio info like bit-rate, etc")
 
-(defun parse-mp4-file (filename &key (get-audio-info *get-audio-info*))
+(defmethod parse-audio-file ((stream mp4-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
   "Parse an MP4A file by reading it's ATOMS and decoding them."
-  (let (stream)
-    (handler-case
-        (progn
-          (setf stream (make-file-stream filename))
-          (mp4-atom:find-mp4-atoms stream)
-          (when get-audio-info
-            (setf (audio-info stream) (mp4-atom:get-mp4-audio-info stream))))
-      (mp4-atom:mp4-atom-condition (c)
-        (utils:warn-user "make-mp4-stream got condition: ~a" c)
-        (when stream (stream-close stream))
-        (setf stream nil)))
-    stream))
-
-(defun parse-mp3-file (filename &key (get-audio-info *get-audio-info*))
+  (handler-case
+      (progn
+        (mp4-atom:find-mp4-atoms stream)
+        (when get-audio-info
+          (setf (audio-info stream) (mp4-atom:get-mp4-audio-info stream))))
+    (mp4-atom:mp4-atom-condition (c)
+      (utils:warn-user "make-mp4-stream got condition: ~a" c))))
+
+
+(defmethod parse-audio-file ((stream mp3-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
   "Parse an MP3 file by reading it's FRAMES and decoding them."
-  (let (stream)
-      (handler-case
-          (progn
-            (setf stream (make-file-stream filename))
-            (id3-frame:find-id3-frames stream)
-            (when get-audio-info
-              (setf (audio-info stream) (mpeg:get-mpeg-audio-info stream))))
-        (id3-frame:id3-frame-condition (c)
-          (utils:warn-user "make-mp3-stream got condition: ~a" c)
-          (when stream (stream-close stream))
-          (setf stream nil)))
-    stream))
+  (handler-case
+      (progn
+        (id3-frame:find-id3-frames stream)
+        (when get-audio-info
+          (setf (audio-info stream) (mpeg:get-mpeg-audio-info stream))))
+    (id3-frame:id3-frame-condition (c)
+      (utils:warn-user "make-mp3-stream got condition: ~a" c))))

id3-frame.lisp

@@ -29,31 +29,41 @@
   (:documentation "The ID3 header, found at start of file"))
 
 (defun is-valid-mp3-file (mp3-file)
-  "Make sure this is an MP3 file. Look for ID3 header at begining (versions 2, 3, 4)
-and/or end (version 2.1)"
+  "Make sure this is an MP3 file. Look for ID3 header at begining (versions 2, 3, 4) and/or end (version 2.1)
+Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
+
   (log5:with-context "is-valid-mp3-file"
-    (stream-seek mp3-file 0 :start)
-    (let* ((id3 (stream-read-string-with-len mp3-file 3))
-           (version (stream-read-u8 mp3-file))
-           (tag))
-      (stream-seek mp3-file 128 :end)
-      (setf tag (stream-read-string-with-len mp3-file 3))
-      (stream-seek mp3-file 0 :start)
-
-      (log-id3-frame "id3 = ~a, version = ~d" id3 version)
-
-      (or (and (string= "ID3" id3)
-               (or (= 2 version) (= 3 version) (= 4 version)))
-          (string= tag "TAG")))))
-
-(defclass v21-tag-header ()
-  ((title    :accessor title    :initarg :title    :initform nil)
-   (artist   :accessor artist   :initarg :artist   :initform nil)
-   (album    :accessor album    :initarg :album    :initform nil)
-   (year     :accessor year     :initarg :year     :initform nil)
-   (comment  :accessor comment  :initarg :comment  :initform nil)
-   (track    :accessor track    :initarg :track    :initform nil :documentation "some taggers allow the last 2 bytes of comment to be used as track number")
-   (genre    :accessor genre    :initarg :genre    :initform nil))
+    (let ((id3)
+          (valid)
+          (version)
+          (tag))
+      (unwind-protect
+           (handler-case
+               (progn
+                 (stream-seek mp3-file 0 :start)
+                 (setf id3 (stream-read-string-with-len mp3-file 3))
+                 (setf version (stream-read-u8 mp3-file))
+                 (stream-seek mp3-file 128 :end)
+                 (setf tag (stream-read-string-with-len mp3-file 3))
+
+                 (log-id3-frame "id3 = ~a, version = ~d" id3 version)
+
+                 (setf valid (or (and (string= "ID3" id3)
+                                      (or (= 2 version) (= 3 version) (= 4 version)))
+                                 (string= tag "TAG"))))
+             (condition (c)
+               (declare (ignore c))))
+        (stream-seek mp3-file 0 :start))
+        valid)))
+
+ (defclass v21-tag-header ()
+   ((title    :accessor title    :initarg :title    :initform nil)
+    (artist   :accessor artist   :initarg :artist   :initform nil)
+    (album    :accessor album    :initarg :album    :initform nil)
+    (year     :accessor year     :initarg :year     :initform nil)
+    (comment  :accessor comment  :initarg :comment  :initform nil)
+    (track    :accessor track    :initarg :track    :initform nil :documentation "some taggers allow the last 2 bytes of comment to be used as track number")
+    (genre    :accessor genre    :initarg :genre    :initform nil))
   (:documentation "ID3 V2.1 old-style tag.  If present, found in last 128 bytes of file."))
 
 (defmethod vpprint ((me v21-tag-header) stream)
@@ -882,7 +892,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 
       (make-instance frame-class :pos pos :version version :id frame-name :len frame-len :flags frame-flags :instream instream))))
 
-(defun find-id3-frames (mp3-file)
+(defmethod find-id3-frames ((mp3-file mp3-file-stream))
   "With an open mp3-file, make sure it is in fact an MP3 file, then read it's header and frames"
 
   (labels ((read-loop (version stream)
@@ -908,9 +918,6 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
                  (values t (nreverse frames)))))) ; reverse this so we have frames in "file order"
 
     (log5:with-context "find-id3-frames"
-      (when (not (is-valid-mp3-file mp3-file))
-        (log-id3-frame "~a is not an mp3 file" (fn mp3-file))
-        (error 'id3-frame-condition :location "find-id3-frames" :object (fn mp3-file) :message "is not an mp3 file"))
 
       (log-id3-frame "~a is a valid mp3 file" (fn mp3-file))
 

mp4-atom.lisp

@@ -502,19 +502,27 @@ Loop through this container and construct constituent atoms"
                                       (if (typep atom-value 'array) (printable-array atom-value) atom-value)))))))
 
 (defun is-valid-m4-file (mp4-file)
-  "Make sure this is an MP4 file.  Quick check: is first atom (at file-offset 4) == FSTYP?"
-  (stream-seek mp4-file 0 :start)
-  (let* ((size (stream-read-u32 mp4-file))
-         (header (stream-read-u32 mp4-file)))
-    (declare (ignore size))
-    (stream-seek mp4-file 0 :start)
-    (= header +m4-ftyp+)))
-
-(defun find-mp4-atoms (mp4-file)
+  "Make sure this is an MP4 file.  Quick check: is first atom (at file-offset 4) == FSTYP?
+Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
+  (let ((valid)
+        (size)
+        (header))
+    (unwind-protect
+         (handler-case
+             (progn
+               (stream-seek mp4-file 0 :start)
+               (setf size (stream-read-u32 mp4-file))
+               (setf header (stream-read-u32 mp4-file))
+               (setf valid (and (<= size (stream-size mp4-file))
+                                (= header +m4-ftyp+))))
+           (condition (c)
+             (declare (ignore c))))
+      (stream-seek mp4-file 0 :start))
+    valid))
+
+(defmethod find-mp4-atoms ((mp4-file mp4-file-stream))
   "Given a valid MP4 file mp4-file, look for the 'right' atoms and return them."
   (log5:with-context "find-mp4-atoms"
-    (when (not (is-valid-m4-file mp4-file))
-      (error 'mp4-atom-condition :location "find-mp4-atoms" :object mp4-file :message "is not an mp4-file" ))
 
     (log-mp4-atom "find-mp4-atoms: ~a, before read-file loop, file-position = ~:d, end = ~:d"
                   (fn mp4-file) (stream-seek mp4-file) (stream-size mp4-file))

packages.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:utils
-  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:has-extension)
+  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:has-extension #:redirect)
   (:use #:common-lisp))
 
 (defpackage #:iso-639-2
@@ -14,7 +14,7 @@
   (:export #:octets #:make-octets *get-audio-info* #:audio-stream-condition
            #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
            #:id3-header #:audio-info #:mp4-atoms
-           #:parse-mp3-file #:parse-mp4-file
+           #:parse-mp3-file #:parse-mp4-file #:parse-audio-file
            #:make-mem-stream #:make-file-stream #:fn
            #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32 #:stream-read-u64 #:stream-read-octets
            #:stream-decode-iso-string #:stream-deocode-ucs-string #:stream-decode-ucs-be-string
@@ -31,7 +31,7 @@
   (:export #:mp4-atom #:map-mp4-atom #:find-mp4-atoms #:traverse #:mp4-atom-condition
            #:atom-file-position #:atom-children #:atom-size #:atom-of-interest #:atom-decoded
            #:atom-type #:vpprint #:*tag-path* #:tag-get-value #:mp4-atom-condition
-           #:mp4-show-raw-tag-atoms #:get-mp4-audio-info
+           #:mp4-show-raw-tag-atoms #:get-mp4-audio-info #:is-valid-m4-file
            #:+itunes-album+
            #:+itunes-album-artist+
            #:+itunes-artist+
@@ -57,7 +57,7 @@
   (:use #:common-lisp #:audio-streams #:utils))
 
 (defpackage #:id3-frame
-  (:export #:id3-frame #:find-id3-frames #:id3-frame-condition #:vpprint #:header #:get-frame-info
+  (:export #:id3-frame #:find-id3-frames #:id3-frame-condition #:vpprint #:header #:get-frame-info #:is-valid-mp3-file
            #:encoding #:lang #:desc #:val #:comment #:artist #:album #:year #:comment #:year
            #:map-id3-frames #:frames #:year #:title #:genre #:id #:v21-tag-header #:info #:version)
   (:use #:common-lisp #:audio-streams #:utils #:iso-639-2))