opus conversie

README.md

@@ -1,22 +1,129 @@
 # audio-library-manager
 
-First setup for `flac-48khz-manager.rkt`.
+Tools for maintaining audio library trees.
 
-The command keeps a FLAC directory tree at a maximum sample rate of 48 kHz.
+The package currently contains two managers:
-Files above the configured threshold are converted in place through a Racket place.
-The conversion path uses `racket-audio/audio-encoder` dynamically, so the package can still compile on systems where the native audio libraries are not installed yet.
 
-Default files below the FLAC root:
+- `flac-48khz-manager.rkt`: keeps a FLAC tree at a maximum sample rate of 48 kHz.
+- `flac2opus-manager.rkt`: mirrors a FLAC source tree to an Opus target tree.
+
+Both managers use the same administration files in the source tree:
 
 - `.music-info.db`: keystore state database
 - `.flac-48khz-manager.ini`: configuration
 - `.flac-48khz-manager.log`: log file
 
+The `flac2opus` state uses its own key prefix in `.music-info.db`, so it can share
+the same database with the 48 kHz manager without mixing state entries.
+
+## FLAC 48 kHz manager
+
+The command keeps a FLAC directory tree at a maximum sample rate of 48 kHz.
+Files above the configured threshold are converted in place through a Racket
+place. The conversion path uses `racket-audio/audio-encoder` dynamically, so the
+package can still compile on systems where the native audio libraries are not
+installed yet.
+
 Run:
 
 ```sh
 racket flac-48khz-manager.rkt /path/to/flac-tree
 ```
 
+When a FLAC file has no embedded picture and the same directory contains one of
+`cover.jpg`, `folder.jpg`, `cover.png` or `folder.png`, the manager embeds that
+image as front-cover picture before fingerprinting/conversion. This keeps FLAC
+artwork consistent before a later Opus mirror is made.
+
+The `flac-48khz-manager` scanner only processes `.flac` files. Other files such
+as `.mp3`, booklets and cover images are ignored by this manager.
+
+## FLAC to Opus mirror manager
+
+The command mirrors a source directory to a target directory. FLAC files are
+converted to Ogg Opus files with extension `.opus`; all other regular files are
+copied unchanged, preserving their relative path and modification time. Examples
+include `booklet.pdf`, `cover.jpg`, `folder.png`, cue sheets, text files and
+other sidecar files.
+
+Run:
+
+```sh
+racket flac2opus-manager.rkt /path/to/flac-tree /path/to/opus-tree
+racket flac2opus-manager.rkt --kbps 192 /path/to/flac-tree /path/to/opus-tree
+```
+
+The default Opus bitrate is 224 kbps. The library API exposes the same setting
+as keyword argument:
+
+```racket
+(manage-flac2opus-tree source-directory target-directory #:kbps 224)
+```
+
+Metadata is copied through `racket-audio/taglib` and `racket-audio/audio-encoder`:
+ordinary TagLib properties are transferred, embedded pictures are transferred,
+and an additional `FLAC2OPUS` comment is written to mark the conversion.
+
+The manager removes target files that belonged to source files which disappeared
+since the previous run. It deliberately does not mirror its own root-level
+administration files: `.music-info.db`, `.flac-48khz-manager.ini` and
+`.flac-48khz-manager.log`.
+
+Paths are handled as Racket paths rather than by splitting on `/`, so Windows
+absolute paths and UNC paths such as `\\panderleou\music` are preserved by the
+platform path implementation.
+
+## Configuration
+
 Important configuration keys are created automatically in `.flac-48khz-manager.ini`.
-SMTP reports are HTML and only summarize counters and errors.
+The same file is used by both managers.
+
+```ini
+[manager]
+max-sample-rate=48000
+hash-algorithm="sha256"
+change-detection="flac-taglib"
+dry-run=#f
+display-log=#t
+log-file=".flac-48khz-manager.log"
+compression-level=5
+
+[mail]
+enabled=#f
+send-on-success=#f
+send-on-error=#t
+host=""
+port=25
+tls=#f
+username=""
+password=""
+from=""
+to=""
+cc=""
+bcc=""
+subject-prefix="[flac-48khz-manager]"
+```
+
+SMTP reports are HTML and summarize counters and errors.
+
+## Change detection
+
+The default change detection is `flac-taglib`:
+
+1. unchanged files are skipped with a cheap `size` + `mtime` comparison;
+2. new or visibly changed files get a semantic fingerprint;
+3. for FLAC files, the semantic fingerprint consists of FLAC STREAMINFO data,
+   including the FLAC audio MD5 signature, plus TagLib properties and embedded
+   picture metadata/content hash;
+4. for non-FLAC files in the Opus mirror, the default is `mtime` + `size`;
+5. full-file hashing is available by setting `change-detection="hash"`.
+
+This avoids reading every complete audio file during a normal run, which matters
+on Windows and network shares.
+
+## FLAC files with ID3v2 prefixes
+
+Version 0.1.4 accepts native FLAC files that start directly with `fLaC`, and FLAC
+files with an ID3v2 tag before the `fLaC` marker. The latter occurs in some
+libraries and is accepted by players such as foobar2000/libFLAC. The fast
+STREAMINFO reader skips the ID3v2 prefix before reading the FLAC metadata.

flac-48khz-manager.rkt

@@ -7,6 +7,8 @@
          "private/audio.rkt"
          "private/config.rkt"
          "private/convert-place.rkt"
+         "private/cover-art.rkt"
+         "private/fingerprint.rkt"
          "private/hash.rkt"
          "private/log.rkt"
          "private/mail.rkt"
@@ -18,20 +20,59 @@
 (provide manage-flac-tree
          summary->lines)
 
-(define (file-info path digest)
+(define (quick-file-info path)
-  (list (cons 'digest digest)
+  (list (cons 'size (file-size path))
-        (cons 'size (file-size path))
         (cons 'mtime (file-or-directory-modify-seconds path))))
 
-(define (same-file-state? old digest)
+(define (same-quick-state? old path)
   (and old
-       (equal? (alist-ref/default old 'digest #f) digest)
+       (equal? (alist-ref/default old 'size #f) (file-size path))
+       (equal? (alist-ref/default old 'mtime #f) (file-or-directory-modify-seconds path))
        (not (equal? (alist-ref/default old 'status #f) 'error))))
 
-(define (process-one-file ks config path relpath inspect-flac-proc convert-proc summary errors)
+(define (same-signature-state? old signature)
-  (define digest (file-digest path (manager-config-hash-algorithm config)))
+  (and old
+       (equal? (alist-ref/default old 'signature #f) signature)
+       (not (equal? (alist-ref/default old 'status #f) 'error))))
+
+(define (file-signature path config fingerprint-proc)
+  (define mode (manager-config-change-detection config))
+  (cond [(member mode '("hash" "sha256" "full-hash" "full-sha256"))
+         (string-append "file:"
+                        (manager-config-hash-algorithm config)
+                        ":"
+                        (file-digest path (manager-config-hash-algorithm config)))]
+        [(member mode '("mtime-size" "quick"))
+         (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))]
+        [(member mode '("flac" "flac-streaminfo"))
+         (string-append "flac-streaminfo:" (flac-streaminfo-fingerprint path))]
+        [(or (member mode '("flac-taglib" "taglib+flac" "taglib-flac")) (not mode))
+         (string-append "flac-taglib:" (fingerprint-proc path))]
+        [else
+         (error 'file-signature "unsupported change-detection mode: ~a" mode)]))
+
+(define (state-info path signature status sample-rate extra)
+  (append (quick-file-info path)
+          (list (cons 'signature signature)
+                (cons 'status status)
+                (cons 'sample-rate sample-rate))
+          extra))
+
+(define (maybe-set-sidecar-picture! path relpath)
+  (with-handlers ([exn:fail? (lambda (e)
+                               (warn-alm "could not set sidecar cover for ~a: ~a" relpath (exn-message e))
+                               #f)])
+    (define cover (ensure-flac-sidecar-picture! path))
+    (when cover (info-alm "embedded sidecar cover in ~a from ~a" relpath cover))
+    cover))
+
+(define (process-one-file ks config path relpath inspect-flac-proc fingerprint-proc convert-proc summary errors)
+  ;; Only invokes TagLib when a sidecar cover/folder image exists in the same directory.
+  ;; This keeps the cheap mtime/size fast path cheap for most directories, but still
+  ;; lets the manager repair missing embedded artwork before fingerprinting.
+  (maybe-set-sidecar-picture! path relpath)
   (define old (state-get-file ks relpath #f))
-  (cond [(same-file-state? old digest)
+  (cond [(same-quick-state? old path)
          (info-alm "unchanged: ~a" relpath)
          (values (summary-inc (summary-inc summary 'seen) 'unchanged) errors)]
         [else
@@ -41,7 +82,7 @@
                           (lambda (e)
                             (err-alm "error for ~a: ~a" relpath (exn-message e))
                             (state-set-file! ks relpath
-                                             (append (file-info path digest)
+                                             (append (quick-file-info path)
                                                      (list (cons 'status 'error)
                                                            (cons 'message (exn-message e)))))
                             (values (summary-inc summary2 'errors)
@@ -49,35 +90,33 @@
                                                 (cons 'message (exn-message e)))
                                           errors)))])
            (define sample-rate (inspect-flac-proc path))
-           (cond [(> sample-rate (manager-config-max-sample-rate config))
+           (define signature (file-signature path config fingerprint-proc))
+           (cond [(same-signature-state? old signature)
+                  (info-alm "unchanged fingerprint: ~a" relpath)
+                  (state-set-file! ks relpath (state-info path signature 'unchanged sample-rate '()))
+                  (values (summary-inc summary2 'unchanged) errors)]
+                 [(> sample-rate (manager-config-max-sample-rate config))
                   (if (manager-config-dry-run? config)
                       (begin
                         (warn-alm "dry-run: would convert ~a from ~a Hz to ~a Hz" relpath sample-rate (manager-config-max-sample-rate config))
                         (state-set-file! ks relpath
-                                         (append (file-info path digest)
+                                         (state-info path signature 'dry-run sample-rate '()))
-                                                 (list (cons 'status 'dry-run)
-                                                       (cons 'sample-rate sample-rate))))
                         (values (summary-inc (summary-inc summary2 'skipped) 'dry-run) errors))
                       (begin
                         (info-alm "converting ~a from ~a Hz to ~a Hz" relpath sample-rate (manager-config-max-sample-rate config))
                         (let* ((result (convert-proc path
                                                      (manager-config-max-sample-rate config)
                                                      (manager-config-compression-level config)))
-                               (new-digest (file-digest path (manager-config-hash-algorithm config)))
+                               (new-sample-rate (inspect-flac-proc path))
-                               (new-sample-rate (inspect-flac-proc path)))
+                               (new-signature (file-signature path config fingerprint-proc)))
                           (state-set-file! ks relpath
-                                           (append (file-info path new-digest)
+                                           (state-info path new-signature 'converted new-sample-rate
-                                                   (list (cons 'status 'converted)
+                                                       (list (cons 'old-sample-rate sample-rate)
-                                                         (cons 'old-sample-rate sample-rate)
+                                                             (cons 'encoder-result result))))
-                                                         (cons 'sample-rate new-sample-rate)
-                                                         (cons 'encoder-result result))))
                           (values (summary-inc summary2 'converted) errors))))]
                  [else
                   (info-alm "ok: ~a (~a Hz)" relpath sample-rate)
-                  (state-set-file! ks relpath
+                  (state-set-file! ks relpath (state-info path signature 'ok sample-rate '()))
-                                   (append (file-info path digest)
-                                           (list (cons 'status 'ok)
-                                                 (cons 'sample-rate sample-rate))))
                   (values (summary-inc summary2 'ok) errors)]))]))
 
 (define (drop-removed! ks current-relpaths summary)
@@ -92,8 +131,9 @@
 
 (define (manage-flac-tree base-directory
                           #:inspect-flac-proc [inspect-flac-proc inspect-flac-sample-rate]
+                          #:fingerprint-proc [fingerprint-proc flac-taglib-fingerprint]
                           #:convert-proc [convert-proc convert-flac-to-target-in-place])
-  (define base-dir (simple-form-path base-directory))
+  (define base-dir (filesystem-path base-directory))
   (unless (directory-exists? base-dir)
     (raise-argument-error 'manage-flac-tree "existing directory" base-directory))
   (define config (load-manager-config base-dir))
@@ -101,13 +141,14 @@
   (info-alm "base directory: ~a" base-dir)
   (info-alm "state file: ~a" (manager-config-state-file config))
   (info-alm "ini file: ~a" (manager-config-ini-file config))
+  (info-alm "change detection: ~a" (manager-config-change-detection config))
   (define ks (open-manager-state (manager-config-state-file config)))
   (define files (find-flac-files base-dir))
   (define relpaths (map (lambda (p) (relpath-string base-dir p)) files))
   (define summary0 (drop-removed! ks relpaths (make-empty-summary)))
   (define-values (summary errors)
     (for/fold ([summary summary0] [errors '()]) ([p (in-list files)] [rel (in-list relpaths)])
-      (process-one-file ks config p rel inspect-flac-proc convert-proc summary errors)))
+      (process-one-file ks config p rel inspect-flac-proc fingerprint-proc convert-proc summary errors)))
   (define errors* (reverse errors))
   (with-handlers ([exn:fail? (lambda (e) (err-alm "mail report failed: ~a" (exn-message e)) (void))])
     (maybe-send-report-mail config summary errors*))

flac2opus-manager.rkt

@@ -0,0 +1,229 @@
+#lang racket/base
+
+(require racket/cmdline
+         racket/file
+         racket/list
+         racket/path
+         "private/config.rkt"
+         "private/flac2opus-state.rkt"
+         "private/fingerprint.rkt"
+         "private/hash.rkt"
+         "private/log.rkt"
+         "private/mail.rkt"
+         "private/opus-convert-place.rkt"
+         "private/report.rkt"
+         "private/util.rkt")
+
+(provide manage-flac2opus-tree
+         summary->lines)
+
+(define manager-admin-relpaths '(".music-info.db" ".flac-48khz-manager.ini" ".flac-48khz-manager.log"))
+
+(define (quick-file-info path)
+  (list (cons 'size (file-size path))
+        (cons 'mtime (file-or-directory-modify-seconds path))))
+
+(define (manager-admin-relpath? relpath)
+  (member relpath manager-admin-relpaths))
+
+(define (source-file-signature path config)
+  (define mode (manager-config-change-detection config))
+  (cond [(member mode '("hash" "sha256" "full-hash" "full-sha256"))
+         (string-append "file:" (manager-config-hash-algorithm config) ":"
+                        (file-digest path (manager-config-hash-algorithm config)))]
+        [(flac-path? path)
+         (cond [(member mode '("flac" "flac-streaminfo"))
+                (string-append "flac-streaminfo:" (flac-streaminfo-fingerprint path))]
+               [(or (member mode '("flac-taglib" "taglib+flac" "taglib-flac")) (not mode))
+                (string-append "flac-taglib:" (flac-taglib-fingerprint path))]
+               [else (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))])]
+        [else (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))]))
+
+(define (same-quick-state? old path target-path target-relpath kbps)
+  (and old
+       (file-exists? target-path)
+       (equal? (alist-ref/default old 'size #f) (file-size path))
+       (equal? (alist-ref/default old 'mtime #f) (file-or-directory-modify-seconds path))
+       (equal? (alist-ref/default old 'target-relpath #f) target-relpath)
+       (equal? (alist-ref/default old 'kbps #f) kbps)
+       (not (equal? (alist-ref/default old 'status #f) 'error))))
+
+(define (same-signature-state? old signature target-path target-relpath kbps)
+  (and old
+       (file-exists? target-path)
+       (equal? (alist-ref/default old 'signature #f) signature)
+       (equal? (alist-ref/default old 'target-relpath #f) target-relpath)
+       (equal? (alist-ref/default old 'kbps #f) kbps)
+       (not (equal? (alist-ref/default old 'status #f) 'error))))
+
+(define (source-relpath base-dir path)
+  (find-relative-path (filesystem-path base-dir) (filesystem-path path)))
+
+(define (source-relpath-string base-dir path)
+  (path->string (source-relpath base-dir path)))
+
+(define (flac-extension-path? p)
+  (let-values ([(base name dir?) (split-path p)])
+    (and (path? name)
+         (let ([ext (path-get-extension name)])
+           (and ext (string-ci=? (bytes->string/utf-8 ext) ".flac"))))))
+
+(define (target-relpath-for rel)
+  (if (flac-extension-path? rel) (replace-path-extension rel #".opus") rel))
+
+(define (target-path-for target-dir target-rel)
+  (build-path target-dir target-rel))
+
+(define (delete-file/quiet path)
+  (with-handlers ([exn:fail? (lambda (_) #f)])
+    (and (file-exists? path) (delete-file path) #t)))
+
+(define (delete-old-target-if-needed! target-dir old new-target-relpath)
+  (define old-target-relpath (and old (alist-ref/default old 'target-relpath #f)))
+  (when (and old-target-relpath (not (equal? old-target-relpath new-target-relpath)))
+    (define old-target (build-path target-dir old-target-relpath))
+    (when (delete-file/quiet old-target)
+      (info-alm "removed obsolete target: ~a" old-target-relpath))))
+
+(define (copy-file/preserve-mtime! source target)
+  (ensure-parent-directory! target)
+  (copy-file source target #t)
+  (file-or-directory-modify-seconds target (file-or-directory-modify-seconds source))
+  (void))
+
+(define (state-info source target-relpath signature status kbps extra)
+  (append (quick-file-info source)
+          (list (cons 'signature signature)
+                (cons 'status status)
+                (cons 'target-relpath target-relpath)
+                (cons 'kbps kbps))
+          extra))
+
+(define (process-one-source-file ks config source-dir target-dir path rel relpath target-rel target-relpath
+                                 kbps convert-proc summary errors)
+  (define target-path (target-path-for target-dir target-rel))
+  (define old (flac2opus-state-get-file ks relpath #f))
+  (cond [(same-quick-state? old path target-path target-relpath kbps)
+         (info-alm "unchanged: ~a" relpath)
+         (values (summary-inc (summary-inc summary 'seen) 'unchanged) errors)]
+        [else
+         (define summary1 (summary-inc (summary-inc summary 'seen) 'processed))
+         (define summary2 (if old (summary-inc summary1 'changed) (summary-inc summary1 'new)))
+         (with-handlers ([exn:fail?
+                          (lambda (e)
+                            (err-alm "error for ~a: ~a" relpath (exn-message e))
+                            (flac2opus-state-set-file! ks relpath
+                                                        (append (quick-file-info path)
+                                                                (list (cons 'status 'error)
+                                                                      (cons 'target-relpath target-relpath)
+                                                                      (cons 'kbps kbps)
+                                                                      (cons 'message (exn-message e)))))
+                            (values (summary-inc summary2 'errors)
+                                    (cons (list (cons 'file relpath)
+                                                (cons 'message (exn-message e)))
+                                          errors)))])
+           (define signature (source-file-signature path config))
+           (cond [(same-signature-state? old signature target-path target-relpath kbps)
+                  (info-alm "unchanged fingerprint: ~a" relpath)
+                  (flac2opus-state-set-file! ks relpath
+                                             (state-info path target-relpath signature 'unchanged kbps '()))
+                  (values (summary-inc summary2 'unchanged) errors)]
+                 [(manager-config-dry-run? config)
+                  (warn-alm "dry-run: would mirror ~a -> ~a" relpath target-relpath)
+                  (flac2opus-state-set-file! ks relpath
+                                             (state-info path target-relpath signature 'dry-run kbps '()))
+                  (values (summary-inc (summary-inc summary2 'skipped) 'dry-run) errors)]
+                 [(flac-path? path)
+                  (info-alm "converting ~a -> ~a at ~a kbps" relpath target-relpath kbps)
+                  (delete-old-target-if-needed! target-dir old target-relpath)
+                  (define result (convert-proc path target-path kbps))
+                  (flac2opus-state-set-file! ks relpath
+                                             (state-info path target-relpath signature 'converted kbps
+                                                         (list (cons 'encoder-result result))))
+                  (values (summary-inc summary2 'converted) errors)]
+                 [else
+                  (info-alm "copying ~a -> ~a" relpath target-relpath)
+                  (delete-old-target-if-needed! target-dir old target-relpath)
+                  (copy-file/preserve-mtime! path target-path)
+                  (flac2opus-state-set-file! ks relpath
+                                             (state-info path target-relpath signature 'copied kbps '()))
+                  (values (summary-inc summary2 'copied) errors)]))]))
+
+(define (drop-removed! ks target-dir current-relpaths summary)
+  (define current (for/hash ([r (in-list current-relpaths)]) (values r #t)))
+  (for/fold ([s summary]) ([old-rel (in-list (flac2opus-state-known-relpaths ks))])
+    (if (hash-ref current old-rel #f)
+        s
+        (let* ([old (flac2opus-state-get-file ks old-rel #f)]
+               [target-relpath (and old (alist-ref/default old 'target-relpath #f))])
+          (when target-relpath
+            (define target-path (build-path target-dir target-relpath))
+            (when (delete-file/quiet target-path)
+              (info-alm "removed target for deleted source: ~a" target-relpath)))
+          (info-alm "removed from flac2opus state: ~a" old-rel)
+          (flac2opus-state-drop-file! ks old-rel)
+          (summary-inc s 'removed)))))
+
+(define (find-source-files source-dir)
+  (filter (lambda (p) (not (manager-admin-relpath? (source-relpath-string source-dir p))))
+          (directory-file-paths source-dir)))
+
+(define (manage-flac2opus-tree source-directory target-directory
+                               #:kbps [kbps 224]
+                               #:convert-proc [convert-proc convert-flac-to-opus])
+  (unless (and (integer? kbps) (positive? kbps))
+    (raise-argument-error 'manage-flac2opus-tree "positive integer kbps" kbps))
+  (define source-dir (filesystem-path source-directory))
+  (define target-dir (filesystem-path target-directory))
+  (unless (directory-exists? source-dir)
+    (raise-argument-error 'manage-flac2opus-tree "existing source directory" source-directory))
+  (make-directory* target-dir)
+  (define config (load-manager-config source-dir))
+  (setup-logging! (manager-config-log-file config) (manager-config-display-log? config))
+  (info-alm "flac2opus source directory: ~a" source-dir)
+  (info-alm "flac2opus target directory: ~a" target-dir)
+  (info-alm "state file: ~a" (manager-config-state-file config))
+  (info-alm "ini file: ~a" (manager-config-ini-file config))
+  (info-alm "change detection: ~a" (manager-config-change-detection config))
+  (info-alm "opus bitrate: ~a kbps" kbps)
+  (define ks (open-flac2opus-state (manager-config-state-file config)))
+  (define files (find-source-files source-dir))
+  (define rels (map (lambda (p) (source-relpath source-dir p)) files))
+  (define relpaths (map path->string rels))
+  (define target-rels (map target-relpath-for rels))
+  (define target-relpaths (map path->string target-rels))
+  (define summary0 (drop-removed! ks target-dir relpaths (make-empty-summary)))
+  (define-values (summary errors)
+    (for/fold ([summary summary0] [errors '()]) ([p (in-list files)]
+                                                  [rel (in-list rels)]
+                                                  [relpath (in-list relpaths)]
+                                                  [target-rel (in-list target-rels)]
+                                                  [target-relpath (in-list target-relpaths)])
+      (process-one-source-file ks config source-dir target-dir p rel relpath target-rel target-relpath
+                               kbps convert-proc summary errors)))
+  (define errors* (reverse errors))
+  (with-handlers ([exn:fail? (lambda (e) (err-alm "mail report failed: ~a" (exn-message e)) (void))])
+    (maybe-send-report-mail config summary errors*
+                            #:manager-name "FLAC to Opus manager"
+                            #:result-label "converted/copied"))
+  (for ([line (in-list (summary->lines summary))]) (info-alm "summary: ~a" line))
+  summary)
+
+(module+ main
+  (define kbps 224)
+  (define source-dir #f)
+  (define target-dir #f)
+  (command-line
+   #:program "flac2opus-manager.rkt"
+   #:once-each
+   [("--kbps") k "Opus bitrate in kbps; default 224"
+    (define n (string->number k))
+    (unless (and (integer? n) (positive? n))
+      (raise-argument-error 'flac2opus-manager "positive integer kbps" k))
+    (set! kbps n)]
+   #:args (source-directory target-directory)
+   (set! source-dir source-directory)
+   (set! target-dir target-directory))
+  (define summary (manage-flac2opus-tree source-dir target-dir #:kbps kbps))
+  (for ([line (in-list (summary->lines summary))])
+    (displayln line)))

info.rkt

@@ -4,6 +4,7 @@
 (define deps '("base"
                "db-lib"
                "keystore"
+               "racket-audio"
                "simple-ini"
                "simple-log"
                "smtp"
@@ -11,5 +12,5 @@
 (define scribblings '(("scribblings/audio-library-manager.scrbl" ())))
 (define build-deps '("rackunit-lib" "scribble-lib" "racket-doc"))
 (define pkg-desc "Audio library maintenance tools for FLAC and Opus trees")
-(define version "0.1.1")
+(define version "0.1.5")
 (define pkg-authors '(hans-dijkema))

main.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 
-(require "flac-48khz-manager.rkt")
+(require "flac-48khz-manager.rkt"
+         "flac2opus-manager.rkt")
 
 (provide manage-flac-tree
+         manage-flac2opus-tree
          summary->lines)

private/audio.rkt

@@ -1,16 +1,8 @@
 #lang racket/base
 
+(require "fingerprint.rkt")
+
 (provide inspect-flac-sample-rate)
 
 (define (inspect-flac-sample-rate path)
-  (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
+  (flac-streaminfo-sample-rate (read-flac-streaminfo path)))
-  (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
-  (define tags-sample-rate (dynamic-require 'racket-audio/taglib 'tags-sample-rate))
-  (define sr
-    (call-with-id3-tags path
-      (lambda (tags)
-        (and (tags-valid? tags) (tags-sample-rate tags)))
-      #:mode 'read))
-  (unless (and (integer? sr) (positive? sr))
-    (error 'inspect-flac-sample-rate "cannot determine sample rate for ~a" path))
-  sr)

private/config.rkt

@@ -12,6 +12,7 @@
          manager-config-log-file
          manager-config-max-sample-rate
          manager-config-hash-algorithm
+         manager-config-change-detection
          manager-config-dry-run?
          manager-config-display-log?
          manager-config-compression-level
@@ -32,7 +33,7 @@
          ensure-default-config!)
 
 (struct manager-config
-  (base-dir ini-file state-file log-file max-sample-rate hash-algorithm dry-run?
+  (base-dir ini-file state-file log-file max-sample-rate hash-algorithm change-detection dry-run?
             display-log? compression-level mail-enabled? mail-send-on-success?
             mail-send-on-error? mail-host mail-port mail-tls? mail-username
             mail-password mail-from mail-to mail-cc mail-bcc mail-subject-prefix)
@@ -52,6 +53,7 @@
     (define ini (make-ini))
     (ini-set! ini 'manager 'max-sample-rate 48000)
     (ini-set! ini 'manager 'hash-algorithm "sha256")
+    (ini-set! ini 'manager 'change-detection "flac-taglib")
     (ini-set! ini 'manager 'dry-run #f)
     (ini-set! ini 'manager 'display-log #t)
     (ini-set! ini 'manager 'log-file ".flac-48khz-manager.log")
@@ -87,6 +89,7 @@
   (manager-config base-dir ini-file (default-state base-dir) log-file
                   (int-value (ini-get ini 'manager 'max-sample-rate 48000) 48000)
                   (string-downcase (string-value (ini-get ini 'manager 'hash-algorithm "sha256") "sha256"))
+                  (string-downcase (string-value (ini-get ini 'manager 'change-detection "flac-taglib") "flac-taglib"))
                   (bool-value (ini-get ini 'manager 'dry-run #f) #f)
                   (bool-value (ini-get ini 'manager 'display-log #t) #t)
                   (int-value (ini-get ini 'manager 'compression-level 5) 5)

private/cover-art.rkt

@@ -0,0 +1,55 @@
+#lang racket/base
+
+(require racket/file
+         racket/list
+         racket/path
+         racket/string)
+
+(provide sidecar-cover-path
+         ensure-flac-sidecar-picture!)
+
+(define cover-names '("cover.jpg" "folder.jpg" "cover.png" "folder.png"))
+
+(define (path-name-ci=? p s)
+  (define-values (_base name _dir?) (split-path p))
+  (and (path? name) (string-ci=? (path->string name) s)))
+
+(define (sidecar-cover-path audio-path)
+  (define-values (dir _name _dir?) (split-path audio-path))
+  (and (path? dir)
+       (for/or ([wanted (in-list cover-names)])
+         (or (let ([candidate (build-path dir wanted)])
+               (and (file-exists? candidate) candidate))
+             (for/or ([p (in-list (with-handlers ([exn:fail? (lambda (_) '())])
+                                    (directory-list dir #:build? #t)))])
+               (and (file-exists? p) (path-name-ci=? p wanted) p))))))
+
+(define (cover-mimetype path)
+  (define ext (let-values ([(base name dir?) (split-path path)])
+                (and (path? name) (path-get-extension name))))
+  (cond [(and ext (member (string-downcase (bytes->string/utf-8 ext)) '(".jpg" ".jpeg"))) "image/jpeg"]
+        [(and ext (string-ci=? (bytes->string/utf-8 ext) ".png")) "image/png"]
+        [else (error 'cover-mimetype "unsupported cover image extension: ~a" path)]))
+
+(define (ensure-flac-sidecar-picture! flac-path)
+  (define cover (sidecar-cover-path flac-path))
+  (and cover
+       (let ()
+         (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
+         (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
+         (define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
+         (define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!))
+         (define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!))
+         (define make-tags-picture (dynamic-require 'racket-audio/taglib 'make-tags-picture))
+         (call-with-id3-tags
+          flac-path
+          (lambda (tags)
+            (cond [(not (tags-valid? tags)) #f]
+                  [(tags-picture tags) #f]
+                  [else
+                   (define picture (make-tags-picture (cover-mimetype cover) 3 (file->bytes cover)
+                                                      #:description "Front cover"))
+                   (tags-picture! tags picture)
+                   (tags-save! tags)
+                   cover]))
+          #:mode 'read-write))))

private/fingerprint.rkt

@@ -0,0 +1,177 @@
+#lang racket/base
+
+(require file/sha1
+         racket/list
+         racket/port
+         racket/string
+         "util.rkt")
+
+(provide read-flac-streaminfo
+         flac-streaminfo-sample-rate
+         flac-streaminfo-fingerprint
+         flac-taglib-fingerprint)
+
+(struct flac-streaminfo
+  (min-blocksize max-blocksize min-framesize max-framesize sample-rate channels bits-per-sample total-samples audio-md5)
+  #:transparent)
+
+(define (u16be b i)
+  (+ (arithmetic-shift (bytes-ref b i) 8)
+     (bytes-ref b (+ i 1))))
+
+(define (u24be b i)
+  (+ (arithmetic-shift (bytes-ref b i) 16)
+     (arithmetic-shift (bytes-ref b (+ i 1)) 8)
+     (bytes-ref b (+ i 2))))
+
+(define (u64be b i)
+  (for/fold ([n 0]) ([j (in-range i (+ i 8))])
+    (+ (arithmetic-shift n 8) (bytes-ref b j))))
+
+(define (hex-bytes b)
+  (bytes->hex-string b))
+
+(define (sha256-string s)
+  (bytes->hex-string (sha256-bytes (string->bytes/utf-8 s))))
+
+(define (read-exact-bytes who in n)
+  (define b (read-bytes n in))
+  (unless (and (bytes? b) (= (bytes-length b) n))
+    (error who "unexpected end of file"))
+  b)
+
+(define (syncsafe-byte? b)
+  (< b #x80))
+
+(define (u28-syncsafe b i)
+  (unless (and (syncsafe-byte? (bytes-ref b i))
+               (syncsafe-byte? (bytes-ref b (+ i 1)))
+               (syncsafe-byte? (bytes-ref b (+ i 2)))
+               (syncsafe-byte? (bytes-ref b (+ i 3))))
+    (error 'read-flac-streaminfo "invalid ID3v2 syncsafe size"))
+  (+ (arithmetic-shift (bytes-ref b i) 21)
+     (arithmetic-shift (bytes-ref b (+ i 1)) 14)
+     (arithmetic-shift (bytes-ref b (+ i 2)) 7)
+     (bytes-ref b (+ i 3))))
+
+(define (read-flac-marker path in)
+  (define first (read-exact-bytes 'read-flac-streaminfo in 4))
+  (cond [(bytes=? first #"fLaC") 'native]
+        [(and (= (bytes-ref first 0) (char->integer #\I))
+              (= (bytes-ref first 1) (char->integer #\D))
+              (= (bytes-ref first 2) (char->integer #\3)))
+         (let* ([_0 (file-position in 0)]
+                [id3-header (read-exact-bytes 'read-flac-streaminfo in 10)]
+                [flags (bytes-ref id3-header 5)]
+                [tag-size (u28-syncsafe id3-header 6)]
+                [footer-size (if (not (zero? (bitwise-and flags #x10))) 10 0)]
+                [_1 (file-position in (+ 10 tag-size footer-size))]
+                [marker (read-exact-bytes 'read-flac-streaminfo in 4)])
+           (unless (bytes=? marker #"fLaC")
+             (error 'read-flac-streaminfo
+                    "ID3v2 prefix found, but no FLAC marker after prefix: ~a"
+                    path))
+           'id3v2-prefixed)]
+        [else
+         (error 'read-flac-streaminfo "not a native FLAC file: ~a" path)]))
+
+(define (read-flac-streaminfo path)
+  (call-with-input-file path
+    (lambda (in)
+      (read-flac-marker path in)
+      (let loop ()
+        (define header (read-exact-bytes 'read-flac-streaminfo in 4))
+        (define last? (not (zero? (bitwise-and (bytes-ref header 0) #x80))))
+        (define block-type (bitwise-and (bytes-ref header 0) #x7f))
+        (define len (u24be header 1))
+        (cond [(= block-type 0)
+               (unless (= len 34)
+                 (error 'read-flac-streaminfo "invalid STREAMINFO length ~a for ~a" len path))
+               (define b (read-exact-bytes 'read-flac-streaminfo in len))
+               (define packed (u64be b 10))
+               (define sample-rate (bitwise-and (arithmetic-shift packed -44) #xfffff))
+               (define channels (+ 1 (bitwise-and (arithmetic-shift packed -41) #x7)))
+               (define bits-per-sample (+ 1 (bitwise-and (arithmetic-shift packed -36) #x1f)))
+               (define total-samples (bitwise-and packed #xfffffffff))
+               (flac-streaminfo (u16be b 0)
+                                (u16be b 2)
+                                (u24be b 4)
+                                (u24be b 7)
+                                sample-rate
+                                channels
+                                bits-per-sample
+                                total-samples
+                                (subbytes b 18 34))]
+              [last? (error 'read-flac-streaminfo "STREAMINFO block not found in ~a" path)]
+              [else
+               (define skipped (read-bytes len in))
+               (unless (and (bytes? skipped) (= (bytes-length skipped) len))
+                 (error 'read-flac-streaminfo "unexpected end of file while skipping metadata block"))
+               (loop)])))
+    #:mode 'binary))
+
+(define (flac-streaminfo-fingerprint-data path)
+  (define si (read-flac-streaminfo path))
+  (list (cons 'kind 'flac-streaminfo)
+        (cons 'min-blocksize (flac-streaminfo-min-blocksize si))
+        (cons 'max-blocksize (flac-streaminfo-max-blocksize si))
+        (cons 'min-framesize (flac-streaminfo-min-framesize si))
+        (cons 'max-framesize (flac-streaminfo-max-framesize si))
+        (cons 'sample-rate (flac-streaminfo-sample-rate si))
+        (cons 'channels (flac-streaminfo-channels si))
+        (cons 'bits-per-sample (flac-streaminfo-bits-per-sample si))
+        (cons 'total-samples (flac-streaminfo-total-samples si))
+        (cons 'audio-md5 (hex-bytes (flac-streaminfo-audio-md5 si)))))
+
+(define (canonical-value v)
+  (cond [(string? v) v]
+        [(symbol? v) (symbol->string v)]
+        [(number? v) v]
+        [(boolean? v) v]
+        [(bytes? v) (list 'bytes-sha256 (bytes-length v) (hex-bytes (sha256-bytes v)))]
+        [(list? v) (map canonical-value v)]
+        [(eq? v #f) #f]
+        [else (format "~s" v)]))
+
+(define (taglib-fingerprint-data path)
+  (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
+  (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
+  (define tags-keys (dynamic-require 'racket-audio/taglib 'tags-keys))
+  (define tags-ref (dynamic-require 'racket-audio/taglib 'tags-ref))
+  (define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
+  (define id3-picture? (dynamic-require 'racket-audio/taglib 'id3-picture?))
+  (define id3-picture-mimetype (dynamic-require 'racket-audio/taglib 'id3-picture-mimetype))
+  (define id3-picture-kind (dynamic-require 'racket-audio/taglib 'id3-picture-kind))
+  (define id3-picture-size (dynamic-require 'racket-audio/taglib 'id3-picture-size))
+  (define id3-picture-bytes (dynamic-require 'racket-audio/taglib 'id3-picture-bytes))
+  (define id3-picture-description (dynamic-require 'racket-audio/taglib 'id3-picture-description))
+  (call-with-id3-tags
+   path
+   (lambda (tags)
+     (unless (tags-valid? tags)
+       (error 'taglib-fingerprint-data "invalid tags for ~a" path))
+     (define keys (sort (map canonical-value (tags-keys tags)) string<? #:key (lambda (x) (format "~a" x))))
+     (define values
+       (for/list ([k (in-list keys)])
+         (cons k (canonical-value (tags-ref tags k)))))
+     (define picture (tags-picture tags))
+     (define picture-data
+       (if (and picture (id3-picture? picture))
+           (list (cons 'mimetype (id3-picture-mimetype picture))
+                 (cons 'kind (id3-picture-kind picture))
+                 (cons 'size (id3-picture-size picture))
+                 (cons 'description (id3-picture-description picture))
+                 (cons 'bytes-sha256 (hex-bytes (sha256-bytes (id3-picture-bytes picture)))))
+           #f))
+     (list (cons 'kind 'taglib)
+           (cons 'properties values)
+           (cons 'picture picture-data)))
+   #:mode 'read))
+
+(define (flac-taglib-fingerprint path)
+  (sha256-string (format "~s" (list (flac-streaminfo-fingerprint-data path)
+                                    (taglib-fingerprint-data path)))))
+
+(define (flac-streaminfo-fingerprint path)
+  (sha256-string (format "~s" (flac-streaminfo-fingerprint-data path))))
+

private/flac2opus-state.rkt

@@ -0,0 +1,30 @@
+#lang racket/base
+
+(require keystore)
+
+(provide open-flac2opus-state
+         flac2opus-state-get-file
+         flac2opus-state-set-file!
+         flac2opus-state-drop-file!
+         flac2opus-state-known-relpaths)
+
+(define prefix "flac2opus:file:")
+
+(define (open-flac2opus-state state-file)
+  (ks-open state-file))
+
+(define (file-state-key relpath)
+  (string-append prefix relpath))
+
+(define (flac2opus-state-get-file ks relpath [default #f])
+  (ks-get ks (file-state-key relpath) default))
+
+(define (flac2opus-state-set-file! ks relpath value)
+  (ks-set! ks (file-state-key relpath) value))
+
+(define (flac2opus-state-drop-file! ks relpath)
+  (ks-drop! ks (file-state-key relpath)))
+
+(define (flac2opus-state-known-relpaths ks)
+  (map (lambda (k) (substring k (string-length prefix)))
+       (ks-keys-glob ks (string-append prefix "*"))))

private/mail.rkt

@@ -1,12 +1,121 @@
 #lang racket/base
 
-(require smtp
+(require racket/list
+         racket/string
+         racket/tcp
+         net/base64
          "config.rkt"
          "report.rkt")
 
-(provide maybe-send-report-mail)
+(provide maybe-send-report-mail
+         mail-address->envelope-address
+         strict-send-smtp-mail)
 
-(define (maybe-send-report-mail config summary errors)
+
+(define (smtp-proc name)
+  (dynamic-require 'smtp name))
+
+(define (non-empty-string? v)
+  (and (string? v) (not (string=? (string-trim v) ""))))
+
+(define (base64-line s)
+  (bytes->string/utf-8 (base64-encode (string->bytes/utf-8 (or s "")) #"")))
+
+(define (trim-envelope-address s)
+  (define t (string-replace s "\"" ""))
+  (regexp-replace* #rx"^[<> \t\r\n]+|[<> \t\r\n]+$" t ""))
+
+(define (mail-address->envelope-address v)
+  (define s (string-trim (format "~a" v)))
+  (define m (regexp-match #px"<([^<>]+)>" s))
+  (define addr (if m (cadr m) s))
+  (trim-envelope-address addr))
+
+(define (clean-address-list xs)
+  (filter non-empty-string?
+          (for/list ([x (in-list xs)])
+            (mail-address->envelope-address x))))
+
+(define (write-smtp-command out command)
+  (display (string-append (string-trim command) "\r\n") out)
+  (flush-output out))
+
+(define (read-smtp-response in expected host)
+  (let loop ([lines '()])
+    (define line (read-line in 'any))
+    (when (eof-object? line)
+      (error 'strict-send-smtp-mail "smtp server ~a: unexpected EOF" host))
+    (define lines* (cons line lines))
+    (define ok-code?
+      (and (>= (string-length line) 3)
+           (equal? (substring line 0 3) (number->string expected))))
+    (unless ok-code?
+      (error 'strict-send-smtp-mail "smtp server ~a:\n     ~a" host (string-join (reverse lines*) "\n     ")))
+    (if (and (> (string-length line) 3) (char=? (string-ref line 3) #\-))
+        (loop lines*)
+        (reverse lines*))))
+
+(define (strict-send-smtp-mail mail
+                               #:host host
+                               #:port port
+                               #:tls-encode [tls-encode #f]
+                               #:username [username ""]
+                               #:password [password ""])
+  ;; The smtp package writes commands as "MAIL FROM: <addr>" and
+  ;; "RCPT TO: <addr>". Some servers reject the whitespace before the path.
+  ;; This sender keeps using smtp's mail struct and MIME header generation,
+  ;; but sends the SMTP envelope as "MAIL FROM:<addr>" / "RCPT TO:<addr>".
+  (when tls-encode
+    (error 'strict-send-smtp-mail "TLS/STARTTLS is not supported by the strict sender yet"))
+  (define mail-sender (smtp-proc 'mail-sender))
+  (define mail-recipients (smtp-proc 'mail-recipients))
+  (define mail-cc-recipients (smtp-proc 'mail-cc-recipients))
+  (define mail-bcc-recipients (smtp-proc 'mail-bcc-recipients))
+  (define mail-header (smtp-proc 'mail-header))
+  (define sender (mail-address->envelope-address (mail-sender mail)))
+  (define recipients (append (clean-address-list (mail-recipients mail))
+                             (clean-address-list (mail-cc-recipients mail))
+                             (clean-address-list (mail-bcc-recipients mail))))
+  (unless (non-empty-string? host)
+    (error 'strict-send-smtp-mail "missing SMTP host"))
+  (unless (non-empty-string? sender)
+    (error 'strict-send-smtp-mail "missing SMTP sender"))
+  (when (null? recipients)
+    (error 'strict-send-smtp-mail "missing SMTP recipient"))
+  (define-values (in out) (tcp-connect host port))
+  (dynamic-wind
+   void
+   (lambda ()
+     (read-smtp-response in 220 host)
+     (write-smtp-command out "EHLO localhost.localdomain")
+     (read-smtp-response in 250 host)
+     (when (non-empty-string? username)
+       (write-smtp-command out "AUTH LOGIN")
+       (read-smtp-response in 334 host)
+       (write-smtp-command out (base64-line username))
+       (read-smtp-response in 334 host)
+       (write-smtp-command out (base64-line password))
+       (read-smtp-response in 235 host))
+     (write-smtp-command out (format "MAIL FROM:<~a>" sender))
+     (read-smtp-response in 250 host)
+     (for ([r (in-list recipients)])
+       (write-smtp-command out (format "RCPT TO:<~a>" r))
+       (read-smtp-response in 250 host))
+     (write-smtp-command out "DATA")
+     (read-smtp-response in 354 host)
+     (display (mail-header mail) out)
+     (display "\r\n.\r\n" out)
+     (flush-output out)
+     (read-smtp-response in 250 host)
+     (write-smtp-command out "QUIT")
+     (read-smtp-response in 221 host))
+   (lambda ()
+     (close-input-port in)
+     (close-output-port out))))
+
+(define (maybe-send-report-mail config summary errors
+                                #:manager-name [manager-name "FLAC 48 kHz manager"]
+                                #:result-label [result-label "converted"])
   (define has-errors? (positive? (summary-ref summary 'errors 0)))
   (define should-send?
     (and (manager-config-mail-enabled? config)
@@ -14,20 +123,27 @@
          (or (and has-errors? (manager-config-mail-send-on-error? config))
              (and (not has-errors?) (manager-config-mail-send-on-success? config)))))
   (when should-send?
-    (define subject (format "~a FLAC 48 kHz manager: ~a error(s), ~a converted"
+    (define from (mail-address->envelope-address (manager-config-mail-from config)))
+    (define to (clean-address-list (manager-config-mail-to config)))
+    (define cc (clean-address-list (manager-config-mail-cc config)))
+    (define bcc (clean-address-list (manager-config-mail-bcc config)))
+    (define subject (format "~a ~a: ~a error(s), ~a ~a"
                             (manager-config-mail-subject-prefix config)
+                            manager-name
                             (summary-ref summary 'errors 0)
-                            (summary-ref summary 'converted 0)))
+                            (summary-ref summary 'converted 0)
+                            result-label))
     (define body (html-report subject summary errors))
+    (define make-mail (smtp-proc 'make-mail))
     (define mail (make-mail subject body
-                            #:from (manager-config-mail-from config)
+                            #:from from
-                            #:to (manager-config-mail-to config)
+                            #:to to
-                            #:cc (manager-config-mail-cc config)
+                            #:cc cc
-                            #:bcc (manager-config-mail-bcc config)
+                            #:bcc bcc
                             #:body-content-type "text/html"))
-    (send-smtp-mail mail
+    (strict-send-smtp-mail mail
-                    #:host (manager-config-mail-host config)
+                           #:host (string-trim (manager-config-mail-host config))
-                    #:port (manager-config-mail-port config)
+                           #:port (manager-config-mail-port config)
-                    #:tls-encode (manager-config-mail-tls? config)
+                           #:tls-encode (manager-config-mail-tls? config)
-                    #:username (manager-config-mail-username config)
+                           #:username (string-trim (manager-config-mail-username config))
-                    #:password (manager-config-mail-password config))))
+                           #:password (manager-config-mail-password config))))

private/opus-convert-place.rkt

@@ -0,0 +1,111 @@
+#lang racket/base
+
+(require racket/file
+         racket/list
+         racket/path
+         racket/place
+         racket/string
+         "util.rkt")
+
+(provide convert-flac-to-opus)
+
+(define conversion-note "Converted from FLAC to Opus by flac2opus-manager")
+
+(define (temp-output-path output-path)
+  (define-values (base name dir?) (split-path output-path))
+  (define name-str (if (path? name) (path->string name) "output.opus"))
+  (build-path base (format ".~a.tmp-~a.opus" name-str (current-inexact-milliseconds))))
+
+(define (list-of-strings? v)
+  (and (list? v) (andmap string? v)))
+
+(define (property-key-symbol k)
+  (cond [(symbol? k) k]
+        [(string? k) (string->symbol (string-downcase k))]
+        [else (string->symbol (string-downcase (format "~a" k)))]))
+
+(define (first-comment-value v)
+  (cond [(and (pair? v) (string? (car v))) (car v)]
+        [(string? v) v]
+        [else #f]))
+
+(define (source-tags-data input-file)
+  (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
+  (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
+  (define tags-keys (dynamic-require 'racket-audio/taglib 'tags-keys))
+  (define tags-ref (dynamic-require 'racket-audio/taglib 'tags-ref))
+  (define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
+  (call-with-id3-tags
+   input-file
+   (lambda (tags)
+     (if (not (tags-valid? tags))
+         (list (cons 'properties '()) (cons 'picture #f))
+         (let* ((keys (sort (tags-keys tags) string<? #:key (lambda (x) (format "~a" x))))
+                (properties (for/list ([k (in-list keys)])
+                              (cons (property-key-symbol k) (tags-ref tags k)))))
+           (list (cons 'properties properties)
+                 (cons 'picture (tags-picture tags))))))
+   #:mode 'read))
+
+(define (source-tags->settings input-file kbps)
+  (define data (source-tags-data input-file))
+  (define properties (alist-ref/default data 'properties '()))
+  (define picture (alist-ref/default data 'picture #f))
+  (define comments (make-hash))
+  (for ([kv (in-list properties)])
+    (define v (first-comment-value (cdr kv)))
+    (when v (hash-set! comments (car kv) v)))
+  (hash-set! comments 'flac2opus conversion-note)
+  (define settings (make-hash))
+  (hash-set! settings 'bitrate (* kbps 1000))
+  (hash-set! settings 'vbr? #t)
+  (hash-set! settings 'comments comments)
+  (unless (eq? picture #f) (hash-set! settings 'picture picture))
+  (values settings properties picture))
+
+(define (copy-all-tag-properties! output-file properties picture)
+  (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
+  (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
+  (define tags-set-values! (dynamic-require 'racket-audio/taglib 'tags-set-values!))
+  (define tags-set! (dynamic-require 'racket-audio/taglib 'tags-set!))
+  (define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!))
+  (define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!))
+  (call-with-id3-tags
+   output-file
+   (lambda (tags)
+     (when (tags-valid? tags)
+       (for ([kv (in-list properties)])
+         (define v (cdr kv))
+         (cond [(list-of-strings? v) (tags-set-values! tags (car kv) v)]
+               [(string? v) (tags-set! tags (car kv) v)]
+               [else (void)]))
+       (tags-set! tags 'flac2opus conversion-note)
+       (unless (eq? picture #f) (tags-picture! tags picture))
+       (tags-save! tags)))
+   #:mode 'read-write))
+
+(define (convert-flac-to-opus input-path output-path kbps)
+  (define tmp-path (temp-output-path output-path))
+  (ensure-parent-directory! tmp-path)
+  (define worker
+    (place ch
+      (define msg (place-channel-get ch))
+      (define in-file (list-ref msg 0))
+      (define out-file (list-ref msg 1))
+      (define kbps (list-ref msg 2))
+      (with-handlers ([exn:fail? (lambda (e) (place-channel-put ch (list 'error (exn-message e))))])
+        (define-values (settings properties picture) (source-tags->settings in-file kbps))
+        (define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
+        (define result (audio-encode in-file out-file settings #:encoder 'opus #:copy-tags? #f))
+        (copy-all-tag-properties! out-file properties picture)
+        (place-channel-put ch (list 'ok result)))))
+  (place-channel-put worker (list (path->string input-path) (path->string tmp-path) kbps))
+  (define response (place-channel-get worker))
+  (cond [(and (pair? response) (eq? (car response) 'ok))
+         (ensure-parent-directory! output-path)
+         (rename-file-or-directory tmp-path output-path #t)
+         (cadr response)]
+        [else
+         (when (file-exists? tmp-path) (delete-file tmp-path))
+         (error 'convert-flac-to-opus "conversion failed for ~a: ~a" input-path
+                (if (and (pair? response) (pair? (cdr response))) (cadr response) response))]))

private/report.rkt

@@ -11,7 +11,7 @@
          summary->lines
          html-report)
 
-(define summary-keys '(seen processed new changed unchanged ok converted removed skipped errors dry-run))
+(define summary-keys '(seen processed new changed unchanged ok converted copied removed skipped errors dry-run))
 
 (define (make-empty-summary)
   (append (for/list ([k (in-list summary-keys)]) (cons k 0))

private/scan.rkt

@@ -1,12 +1,39 @@
 #lang racket/base
 
-(require racket/file
+(require racket/list
-         racket/list
+         racket/path
          "util.rkt")
 
-(provide find-flac-files)
+(provide find-flac-files
+         find-regular-files)
+
+(define (directory-list/quiet dir)
+  (with-handlers ([exn:fail? (lambda (_) '())])
+    (directory-list dir #:build? #t)))
+
+(define (directory-exists?/quiet p)
+  (with-handlers ([exn:fail? (lambda (_) #f)])
+    (directory-exists? p)))
+
+(define (file-exists?/quiet p)
+  (with-handlers ([exn:fail? (lambda (_) #f)])
+    (file-exists? p)))
+
+(define (sort-paths paths)
+  (sort paths string<? #:key path->string))
+
+(define (find-regular-files base-dir)
+  ;; Do not use racket/file:find-files here.  On Windows UNC trees, especially
+  ;; with long paths, fold-files can raise "path disappeared" for a single
+  ;; entry and abort the whole scan.  This walker treats entries that disappear,
+  ;; are inaccessible, or cannot be represented by the platform path layer as a
+  ;; skipped entry and continues the scan.
+  (define root (filesystem-path base-dir))
+  (let loop ([dir root] [acc '()])
+    (for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))])
+      (cond [(directory-exists?/quiet p) (loop p acc)]
+            [(file-exists?/quiet p) (cons p acc)]
+            [else acc]))))
 
 (define (find-flac-files base-dir)
-  (sort (find-files flac-path? base-dir)
+  (sort-paths (filter flac-path? (find-regular-files base-dir))))
-        string<?
-        #:key path->string))

private/util.rkt

@@ -10,7 +10,11 @@
          string-value
          split-addresses
          relpath-string
+         filesystem-path
          flac-path?
+         opus-path?
+         directory-file-paths
+         replace-path-extension
          ensure-parent-directory!
          alist-ref/default
          alist-set)
@@ -44,14 +48,74 @@
   (filter (lambda (x) (not (string=? x "")))
           (map string-trim (regexp-split #px"[,;]" s))))
 
+(define (windows-extended-path-string s)
+  (cond [(or (< (string-length s) 3)
+             (not (eq? (system-type 'os) 'windows))
+             (string-prefix? s "\\\\?\\"))
+         s]
+        [(and (>= (string-length s) 2)
+              (char=? (string-ref s 0) #\\)
+              (char=? (string-ref s 1) #\\))
+         (string-append "\\\\?\\UNC\\" (substring s 2))]
+        [(and (>= (string-length s) 3)
+              (char-alphabetic? (string-ref s 0))
+              (char=? (string-ref s 1) #\:)
+              (char=? (string-ref s 2) #\\))
+         (string-append "\\\\?\\" s)]
+        [else s]))
+
+(define (filesystem-path p)
+  (define s (cond [(path? p) (path->string p)]
+                  [(string? p) p]
+                  [else (raise-argument-error 'filesystem-path "path-string? or path?" p)]))
+  (simple-form-path (string->path (windows-extended-path-string s))))
+
 (define (relpath-string base p)
-  (path->string (find-relative-path (simple-form-path base) (simple-form-path p))))
+  (path->string (find-relative-path (filesystem-path base) (filesystem-path p))))
+
+(define (extension-ci=? p ext)
+  (let-values ([(base name dir?) (split-path p)])
+    (and (path? name)
+         (let ([e (path-get-extension name)])
+           (and e (string-ci=? (bytes->string/utf-8 e) ext))))))
+
+(define (file-exists?/quiet p)
+  (with-handlers ([exn:fail? (lambda (_) #f)]) (file-exists? p)))
 
 (define (flac-path? p)
-  (and (file-exists? p)
+  (and (file-exists?/quiet p) (extension-ci=? p ".flac")))
-       (let-values ([(base name dir?) (split-path p)])
+
-         (and (path? name)
+(define (opus-path? p)
-              (string-ci=? (bytes->string/utf-8 (or (path-get-extension name) #"")) ".flac")))))
+  (and (file-exists?/quiet p) (extension-ci=? p ".opus")))
+
+(define (regular-file-path? p)
+  (file-exists?/quiet p))
+
+(define (directory-list/quiet dir)
+  (with-handlers ([exn:fail? (lambda (_) '())])
+    (directory-list dir #:build? #t)))
+
+(define (directory-exists?/quiet p)
+  (with-handlers ([exn:fail? (lambda (_) #f)])
+    (directory-exists? p)))
+
+(define (sort-paths paths)
+  (sort paths string<? #:key path->string))
+
+(define (directory-file-paths base-dir)
+  ;; Tolerant recursive walker for Windows UNC/long-path trees.  A single
+  ;; vanished or unreadable entry is skipped instead of aborting the scan.
+  (define root (filesystem-path base-dir))
+  (let loop ([dir root] [acc '()])
+    (for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))])
+      (cond [(directory-exists?/quiet p) (loop p acc)]
+            [(file-exists?/quiet p) (cons p acc)]
+            [else acc]))))
+
+(define (replace-path-extension p ext)
+  (let-values ([(base name dir?) (split-path p)])
+    (unless (path? name) (error 'replace-path-extension "path has no file name: ~a" p))
+    (build-path base (path-replace-extension name ext))))
 
 (define (ensure-parent-directory! p)
   (define-values (base name dir?) (split-path p))

scribblings/audio-library-manager.scrbl

@@ -9,11 +9,23 @@
 The @racketmodname[audio-library-manager] package contains command-line tools for
 maintaining audio library trees.
 
+@section{Administration files}
+
+The managers use these files below the source directory:
+
+@itemlist[
+ @item{@filepath{.music-info.db}: keystore database with file state.}
+ @item{@filepath{.flac-48khz-manager.ini}: configuration.}
+ @item{@filepath{.flac-48khz-manager.log}: log file.}]
+
+The FLAC-to-Opus manager uses a separate key prefix in @filepath{.music-info.db},
+so it can share the same database with the 48 kHz manager.
+
 @section{FLAC 48 kHz manager}
 
-The first tool is @filepath{flac-48khz-manager.rkt}. It keeps a FLAC tree at a
+The tool @filepath{flac-48khz-manager.rkt} keeps a FLAC tree at a maximum sample
-maximum sample rate of 48 kHz. Files with a higher sample rate are converted in
+rate of 48 kHz. Files with a higher sample rate are converted in place through a
-place through a worker place. The conversion path uses
+worker place. The conversion path uses
 @racketmodname[racket-audio/audio-encoder] dynamically, so the manager module can
 still be compiled on systems where the native audio libraries are not available.
 
@@ -21,12 +33,40 @@ Run the manager as:
 
 @verbatim{racket flac-48khz-manager.rkt <base-directory>}
 
-The manager creates these files below @filepath{<base-directory>}:
+When a FLAC file has no embedded picture and its directory contains
+@filepath{cover.jpg}, @filepath{folder.jpg}, @filepath{cover.png} or
+@filepath{folder.png}, the manager embeds that image as front-cover picture
+before fingerprinting and conversion.
 
-@itemlist[
+The manager only processes @filepath{.flac} files; @filepath{.mp3} files and
- @item{@filepath{.music-info.db}: keystore database with file state.}
+other sidecar files are ignored by this command.
- @item{@filepath{.flac-48khz-manager.ini}: configuration.}
+
- @item{@filepath{.flac-48khz-manager.log}: log file.}]
+@section{FLAC to Opus mirror manager}
+
+The tool @filepath{flac2opus-manager.rkt} mirrors a source directory to a target
+directory. FLAC files are converted to Ogg Opus files with extension
+@filepath{.opus}. Other regular files are copied unchanged, preserving their
+relative path and modification time. This includes sidecar files such as
+@filepath{booklet.pdf}, @filepath{cover.jpg}, cue sheets and text files.
+
+Run the manager as:
+
+@verbatim{racket flac2opus-manager.rkt <source-directory> <target-directory>}
+
+The default Opus bitrate is 224 kbps. A different bitrate can be selected with:
+
+@verbatim{racket flac2opus-manager.rkt --kbps 192 <source-directory> <target-directory>}
+
+Metadata is copied through @racketmodname[racket-audio/taglib] and
+@racketmodname[racket-audio/audio-encoder]. TagLib properties and embedded
+pictures are transferred to the Opus file. The manager also writes a
+@tt{FLAC2OPUS} comment indicating that the file was converted by the manager.
+
+When a source file disappears, the corresponding target file is removed on the
+next run. The manager does not mirror its own root-level administration files.
+Paths are handled as Racket paths instead of by splitting on @litchar{/}, so
+Windows absolute paths and UNC paths are left to the platform path
+implementation.
 
 @section{Configuration}
 
@@ -37,6 +77,7 @@ settings are:
 [manager]
 max-sample-rate=48000
 hash-algorithm="sha256"
+change-detection="flac-taglib"
 dry-run=#f
 display-log=#t
 log-file=".flac-48khz-manager.log"
@@ -61,11 +102,24 @@ subject-prefix="[flac-48khz-manager]"
 When mail is enabled, the report is sent as HTML. The message contains the
 summary counters and the error table; it does not dump the full log by default.
 
+@section{Change detection}
+
+The default @tt{change-detection} mode is @tt{flac-taglib}. Unchanged files are
+first skipped by comparing @tt{size} and @tt{mtime} from the keystore state. New
+or visibly changed files get a semantic fingerprint made from FLAC STREAMINFO
+and TagLib metadata. The FLAC part includes the STREAMINFO audio MD5 signature;
+the TagLib part includes properties and an embedded-picture content hash.
+
+For non-FLAC files mirrored by @filepath{flac2opus-manager.rkt}, the default
+signature is @tt{mtime} plus @tt{size}. A full-file hash remains available by
+setting @tt{change-detection="hash"}.
+
 @section{Library API}
 
 @defproc[(manage-flac-tree
           [base-directory path-string?]
           [#:inspect-flac-proc inspect-flac-proc procedure? inspect-flac-sample-rate]
+          [#:fingerprint-proc fingerprint-proc procedure? flac-taglib-fingerprint]
           [#:convert-proc convert-proc procedure? convert-flac-to-target-in-place])
          list?]{
 Scans @racket[base-directory], updates the keystore state, converts FLAC files
@@ -73,7 +127,18 @@ above the configured maximum sample rate, sends the optional HTML mail report,
 and returns a summary association list.
 
 The keyword arguments are intended for tests and dry integration work. In normal
-use, the default inspector and converter are used.}
+use, the default inspector, fingerprint function and converter are used.}
+
+@defproc[(manage-flac2opus-tree
+          [source-directory path-string?]
+          [target-directory path-string?]
+          [#:kbps kbps exact-positive-integer? 224]
+          [#:convert-proc convert-proc procedure? convert-flac-to-opus])
+         list?]{
+Mirrors @racket[source-directory] to @racket[target-directory]. FLAC files are
+converted to Opus at @racket[kbps] kbps; all other regular files are copied.
+The state is stored in the source directory's @filepath{.music-info.db} using a
+separate @tt{flac2opus} prefix.}
 
 @defproc[(summary->lines [summary list?]) (listof string?)]{
 Formats the summary association list as display lines.}

test/flac-48khz-manager-test.rkt

@@ -3,7 +3,8 @@
 (require rackunit
          racket/file
          racket/path
-         "../flac-48khz-manager.rkt")
+         "../flac-48khz-manager.rkt"
+         "../private/fingerprint.rkt")
 
 (define tmp (make-temporary-file "alm-test-~a" 'directory))
 (define hi (build-path tmp "hires.flac"))
@@ -11,6 +12,37 @@
 (call-with-output-file hi #:exists 'replace (lambda (out) (display "hires" out)))
 (call-with-output-file cd #:exists 'replace (lambda (out) (display "cd" out)))
 
+(define (u64be-bytes n)
+  (define b (make-bytes 8 0))
+  (for ([i (in-range 8)])
+    (bytes-set! b i (bitwise-and (arithmetic-shift n (- (* 8 (- 7 i)))) #xff)))
+  b)
+
+(define (minimal-flac-bytes sample-rate)
+  (define streaminfo (make-bytes 34 0))
+  (bytes-set! streaminfo 0 #x10)
+  (bytes-set! streaminfo 1 #x00)
+  (bytes-set! streaminfo 2 #x10)
+  (bytes-set! streaminfo 3 #x00)
+  (define packed (bitwise-ior (arithmetic-shift sample-rate 44)
+                              (arithmetic-shift 1 41)
+                              (arithmetic-shift 15 36)
+                              1000))
+  (bytes-copy! streaminfo 10 (u64be-bytes packed))
+  (bytes-append #"fLaC" (bytes #x80 #x00 #x00 #x22) streaminfo))
+
+(define native-flac (build-path tmp "native.flac"))
+(define id3-flac (build-path tmp "id3-prefix.flac"))
+(call-with-output-file native-flac #:exists 'replace
+  (lambda (out) (write-bytes (minimal-flac-bytes 96000) out)))
+(call-with-output-file id3-flac #:exists 'replace
+  (lambda (out)
+    (write-bytes (bytes-append #"ID3" (bytes 4 0 0 0 0 0 3) #"abc" (minimal-flac-bytes 88200)) out)))
+(check-equal? (flac-streaminfo-sample-rate (read-flac-streaminfo native-flac)) 96000)
+(check-equal? (flac-streaminfo-sample-rate (read-flac-streaminfo id3-flac)) 88200)
+(delete-file native-flac)
+(delete-file id3-flac)
+
 (define convert-count 0)
 
 (define (mock-inspect p)
@@ -19,6 +51,9 @@
         [(regexp-match? #rx"hires" s) 96000]
         [else 44100]))
 
+(define (mock-fingerprint p)
+  (string-append "mock:" (file->string p)))
+
 (define (mock-convert p rate compression)
   (set! convert-count (add1 convert-count))
   (call-with-output-file p #:exists 'replace
@@ -26,21 +61,21 @@
   (list (cons 'mock #t) (cons 'target-sample-rate rate)))
 
 (define first-summary
-  (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:convert-proc mock-convert))
+  (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
 (check-equal? (assoc 'seen first-summary) '(seen . 2))
 (check-equal? (assoc 'new first-summary) '(new . 2))
 (check-equal? (assoc 'converted first-summary) '(converted . 1))
 (check-equal? convert-count 1)
 
 (define second-summary
-  (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:convert-proc mock-convert))
+  (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
 (check-equal? (assoc 'seen second-summary) '(seen . 2))
 (check-equal? (assoc 'unchanged second-summary) '(unchanged . 2))
 (check-equal? convert-count 1)
 
 (delete-file cd)
 (define third-summary
-  (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:convert-proc mock-convert))
+  (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
 (check-equal? (assoc 'removed third-summary) '(removed . 1))
 (check-equal? (assoc 'unchanged third-summary) '(unchanged . 1))
 

test/flac2opus-manager-test.rkt

@@ -0,0 +1,61 @@
+#lang racket/base
+
+(require rackunit
+         racket/file
+         racket/path
+         "../flac2opus-manager.rkt")
+
+(define tmp (make-temporary-file "alm-flac2opus-src-~a" 'directory))
+(define out (make-temporary-file "alm-flac2opus-out-~a" 'directory))
+(define sub (build-path tmp "disc1"))
+(make-directory* sub)
+
+(call-with-output-file (build-path tmp ".flac-48khz-manager.ini") #:exists 'replace
+  (lambda (o)
+    (display "[manager]\n" o)
+    (display "change-detection=quick\n" o)
+    (display "display-log=false\n" o)
+    (display "dry-run=false\n" o)
+    (display "log-file=.flac-48khz-manager.log\n" o)
+    (display "[mail]\n" o)
+    (display "enabled=false\n" o)))
+
+(define flac (build-path sub "track.flac"))
+(define pdf (build-path sub "booklet.pdf"))
+(define jpg (build-path tmp "cover.jpg"))
+(call-with-output-file flac #:exists 'replace (lambda (o) (display "fake flac" o)))
+(call-with-output-file pdf #:exists 'replace (lambda (o) (display "booklet" o)))
+(call-with-output-file jpg #:exists 'replace (lambda (o) (display "jpg" o)))
+
+(define convert-count 0)
+(define (mock-convert src dst kbps)
+  (set! convert-count (add1 convert-count))
+  (make-directory* (let-values ([(base name dir?) (split-path dst)]) base))
+  (call-with-output-file dst #:exists 'replace
+    (lambda (o) (fprintf o "opus from ~a at ~a" (path->string src) kbps)))
+  (list (cons 'mock #t) (cons 'kbps kbps)))
+
+(define first-summary
+  (manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))
+(check-equal? (assoc 'seen first-summary) '(seen . 3))
+(check-equal? (assoc 'converted first-summary) '(converted . 1))
+(check-equal? (assoc 'copied first-summary) '(copied . 2))
+(check-true (file-exists? (build-path out "disc1" "track.opus")))
+(check-true (file-exists? (build-path out "disc1" "booklet.pdf")))
+(check-true (file-exists? (build-path out "cover.jpg")))
+(check-equal? convert-count 1)
+
+(define second-summary
+  (manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))
+(check-equal? (assoc 'seen second-summary) '(seen . 3))
+(check-equal? (assoc 'unchanged second-summary) '(unchanged . 3))
+(check-equal? convert-count 1)
+
+(delete-file pdf)
+(define third-summary
+  (manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))
+(check-equal? (assoc 'removed third-summary) '(removed . 1))
+(check-false (file-exists? (build-path out "disc1" "booklet.pdf")))
+
+(delete-directory/files tmp)
+(delete-directory/files out)