World Playground Deceit.net

Ogg Vorbis cover art embedding: Tcl vs Common Lisp

Published on
Tags: tcl, lisp, programming

If, like me, you try to achieve said task using standard CLI tools, you're going to be very disappointed. First, you search "ffmpeg add ogg cover art" on the Web, to no avail. Then you try to use Xiph's bespoke vorbis-tools, only to find out it doesn't have anything ready-to-use.

The next step is perusing crappy StackOverflow links to see people hack something with shell scripts so horrid they'd make ShellCheck contemplate suicide.

This is what you learn in the process:

  • This can't be done using only ffmpeg or vorbiscomment.
  • opus-tools doesn't even provide something like vorbiscomment…
  • The cover art tag spec is quite involved, requiring base64 encoding (to fit in UTF-8 tag values) and a binary header.

Nothing very hard, but not something you want to do in sh, even with the non-standard xxd Vim helper at hand.

In Tcl §

I initially wrote a very clean Tcl version calling to file, ImageMagick and the aforementioned vorbiscomment:

#!/usr/bin/env tclsh
# Dependencies: file(1), vorbiscomment(1) and ImageMagick 7
package require Tcl 8.6

proc make_metadata_block_picture {img_path {description "Cover Art"}} {
    set size [file size $img_path]
    set mime [exec file --mime-type --brief -- $img_path]
    lassign [exec magick identify -format {%w %h} $img_path] w h
    # https://wiki.xiph.org/VorbisComment#Cover_art
    # https://www.rfc-editor.org/rfc/rfc9639.html#name-picture
    binary encode base64 \
        [binary format IuIua*Iua*IuIuIuIuIua* \
             3 \
             [string length $mime] $mime \
             [string length $description] $description \
             $w $h 0 0 \
             $size [read [open $img_path rb] $size]]
}


if {![<= 2 $argc 3] || ($argc == 1 && [lindex $argv 0] eq "-h")} {
    puts stderr "Usage: [file tail $argv0] IMAGE.(jpg|png) IN.ogg [OUT.ogg]"
    exit 1
}

lassign $argv img_path in_vorb_path out_vorb_path
set vc [regsub -nocase -line {^METADATA_BLOCK_PICTURE=.*\n} \
            [exec -keepnewline vorbiscomment --list --raw $in_vorb_path] {}]
append vc METADATA_BLOCK_PICTURE=[make_metadata_block_picture $img_path]
exec vorbiscomment --write --raw $in_vorb_path {*}[if {$argc == 3} {list $out_vorb_path}] << $vc

30 lines of completely standalone Tcl and a nice showcase of the useful/ergonomic "batteries included" aspect of its stdlib. Really a better sh.

In Common Lisp §

Morbid curiosity then made me translate it in Common Lisp using the least external help possible, knowing I'd have to write some of the missing batteries:

(require :uiop)
(load "~/.local/lib/quicklisp/setup.lisp")
(ql:quickload '("qbase64") :silent t)

(defun run (argv &key input)
  "uiop:run-program wrapper returning a list of output lines and optionally taking
 either a line or a list of lines to use as stdin"
  (apply #'uiop:run-program (if (listp argv) argv (list argv))
         :output :lines
         (when input
           `(:input (,(if (stringp input)
                          input
                          (format nil "~{~A~%~}" input)))))))

(defun read-file-bytes (path)
  "Return the entire contents of the file located at path as a byte array"
  (with-open-file (stream path :element-type '(unsigned-byte 8))
    (let ((len (file-length stream)))
      (assert len () "Couldn't get FILE-LENGTH of ~S (~A)" stream path)
      (let ((buf (make-array len :element-type '(unsigned-byte 8))))
        (read-sequence buf stream :end len)
        buf))))

(defun to-be32 (uint)
  (make-array 4 :element-type '(unsigned-byte 8)
                :initial-contents (list
                                   (ldb (byte 8 24) uint)
                                   (ldb (byte 8 16) uint)
                                   (ldb (byte 8 8)  uint)
                                   (ldb (byte 8 0)  uint))))

(defun ascii-to-bytes (str) (map '(vector (unsigned-byte 8)) #'char-code str))

(defun make-metadata-block-picture (img-path &key (description "Cover Art"))
  (let ((mime (first (run `("file" "--mime-type" "--brief" "--" ,img-path))))
        (dims (mapcar #'parse-integer
                      (uiop:split-string
                       (first (run `("magick" "identify" "-format" "%w %h" ,img-path))))))
        (img-bytes (read-file-bytes img-path)))
    ;; https://wiki.xiph.org/VorbisComment#Cover_art
    (qbase64:encode-bytes
     (concatenate '(vector (unsigned-byte 8))
                  ;; https://www.rfc-editor.org/rfc/rfc9639.html#name-picture
                  (to-be32 3)                    ;; Picture type (3: front cover)
                  (to-be32 (length mime))        ;; MIME type length
                  (ascii-to-bytes mime)          ;; MIME type (ASCII)
                  (to-be32 (length description)) ;; Description length
                  (ascii-to-bytes description)   ;; Description (UTF-8)
                  (to-be32 (first dims))         ;; Image width (optional)
                  (to-be32 (second dims))        ;; Image height (optional)
                  (to-be32 0)                    ;; Image bpp (optional)
                  (to-be32 0)                    ;; Image palette size (optional)
                  (to-be32 (length img-bytes))   ;; Image file size
                  img-bytes))))                  ;; Image file contents

(when (or (not (<= 2 (length (uiop:command-line-arguments)) 3))
          (equal (uiop:command-line-arguments) '("-h")))
  (format *error-output* "Usage: ~A IMAGE.(jpg|png) IN.ogg [OUT.ogg]" (pathname-name (uiop:argv0)))
  (uiop:quit 1))

(destructuring-bind (img-path in-vorb-path &optional out-vorb-path) (uiop:command-line-arguments)
  (let ((vc (delete-if (lambda (line) (uiop:string-prefix-p "METADATA_BLOCK_PICTURE=" line))
                       (run `("vorbiscomment" "--list" "--raw" ,in-vorb-path)))))
    (push (uiop:strcat "METADATA_BLOCK_PICTURE=" (make-metadata-block-picture img-path))
          (cdr (last vc)))
    (run `("vorbiscomment" "--write" "--raw" ,in-vorb-path ,@(uiop:ensure-list out-vorb-path))
         :input vc)))

Conclusions that can be made from this exercise:

  • I still needed the external qbase64 system, thus a package manager (Quicklisp here) while Tcl gave me everything needed (NB: built-in base64 support is a 8.6 feature, I would have had to reach for Tcllib before that).
  • Lisp is a language that once powered entire machines (incl. operating systems) and thus had no concept of an external world with "processes". Which is why you really can't avoid UIOP at least for if you want to portably interact with the OS.
  • The difference in philosophy from Tcl/Python: focused on providing robust and thought-out bricks to build with rather than a hodgepodge of convenient tools (dependent on programming trends and file formats du jour). Where Tcl/Python offer binary/struct, CL hands you ldb/dpb, macros/quasiquote, CLOS/MOP and says to you Now build, my child; and so they did.
  • The ANSI CL standard is very old (1994) and had to unify even older Lisps (that's the "Common" part), so it's even more handicapped compared to non-standardized, single implementation languages that can simply add useful stuff at will.
  • Tcl can't even insert comments within a parameter list, lol.

In MY Common Lisp §

So unless you are Lisp-pilled, a modern scripting language makes much more sense here. But, IF you are, you can easily shape a much prettier ball of mud:

#!/home/user/.local/share/common-lisp/sbcl-wrc --script
(ql:quickload '("qbase64" "trivial-utf-8") :silent t)

(defun make-metadata-block-picture (img-path &key (description "Cover Art"))
  (let ((mime (first (run `("file" "--mime-type" "--brief" "--" ,img-path))))
        (dims (mapcar #'parse-integer
                      (split-str #\Space
                                 (first (run `("magick" "identify" "-format" "%w %h" ,img-path))))))
        (img-bytes (read-file-bytes img-path)))
    ;; https://wiki.xiph.org/VorbisComment#Cover_art
    (qbase64:encode-bytes
     (concatenate '(vector (unsigned-byte 8))
                  ;; https://www.rfc-editor.org/rfc/rfc9639.html#name-picture
                  (to-be32 3)                    ;; Picture type (3: front cover)
                  (to-be32 (length mime))        ;; MIME type length
                  (trivial-utf-8:string-to-utf-8-bytes mime)        ;; MIME type (ASCII)
                  (to-be32 (length description)) ;; Description length
                  (trivial-utf-8:string-to-utf-8-bytes description) ;; Description (UTF-8)
                  (to-be32 (first dims))         ;; Image width (optional)
                  (to-be32 (second dims))        ;; Image height (optional)
                  (to-be32 0)                    ;; Image bpp (optional)
                  (to-be32 0)                    ;; Image palette size (optional)
                  (to-be32 (length img-bytes))   ;; Image file size
                  img-bytes))))                  ;; Image file contents

(when (or (not (<= 2 (length (uiop:command-line-arguments)) 3))
          (equal (uiop:command-line-arguments) '("-h")))
  (format *error-output* "Usage: ~A IMAGE.(jpg|png) IN.ogg [OUT.ogg]" (pathname-name (uiop:argv0)))
  (uiop:quit 1))

(destructuring-bind (img-path in-vorb-path &optional out-vorb-path) (uiop:command-line-arguments)
  (let ((vc (delete-if #λ(prefix-p "METADATA_BLOCK_PICTURE=" _)
                       (run `("vorbiscomment" "--list" "--raw" ,in-vorb-path)))))
    (push-back (str-cat "METADATA_BLOCK_PICTURE=" (make-metadata-block-picture img-path)) vc)
    (run `("vorbiscomment" "--write" "--raw" ,in-vorb-path ,@(ensure-list out-vorb-path))
         :input vc)))

Layers of mud used: .sbclrc, make-sbcl-wrc.sh and q3cpma-utils