diff --git a/README.md b/README.md index 25cf0ba..de4c0fa 100644 --- a/README.md +++ b/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. -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. +The package currently contains two managers: -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. diff --git a/flac-48khz-manager.rkt b/flac-48khz-manager.rkt index 7918a69..3c946ba 100644 --- a/flac-48khz-manager.rkt +++ b/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) - (list (cons 'digest digest) - (cons 'size (file-size path)) +(define (quick-file-info path) + (list (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 digest (file-digest path (manager-config-hash-algorithm config))) +(define (same-signature-state? old signature) + (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) - (list (cons 'status 'dry-run) - (cons 'sample-rate sample-rate)))) + (state-info path signature 'dry-run 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) - (list (cons 'status 'converted) - (cons 'old-sample-rate sample-rate) - (cons 'sample-rate new-sample-rate) - (cons 'encoder-result result)))) + (state-info path new-signature 'converted new-sample-rate + (list (cons 'old-sample-rate 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 - (append (file-info path digest) - (list (cons 'status 'ok) - (cons 'sample-rate sample-rate)))) + (state-set-file! ks relpath (state-info path signature 'ok 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*)) diff --git a/flac2opus-manager.rkt b/flac2opus-manager.rkt new file mode 100644 index 0000000..7284a6d --- /dev/null +++ b/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))) diff --git a/info.rkt b/info.rkt index 066904a..537b051 100644 --- a/info.rkt +++ b/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)) diff --git a/main.rkt b/main.rkt index f742000..7f6f044 100644 --- a/main.rkt +++ b/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) diff --git a/private/audio.rkt b/private/audio.rkt index d55972c..092b6a0 100644 --- a/private/audio.rkt +++ b/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)) - (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) + (flac-streaminfo-sample-rate (read-flac-streaminfo path))) diff --git a/private/config.rkt b/private/config.rkt index aef0c82..a747daf 100644 --- a/private/config.rkt +++ b/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) diff --git a/private/cover-art.rkt b/private/cover-art.rkt new file mode 100644 index 0000000..61b83d3 --- /dev/null +++ b/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)))) diff --git a/private/fingerprint.rkt b/private/fingerprint.rkt new file mode 100644 index 0000000..51bfa90 --- /dev/null +++ b/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)) stringenvelope-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: " and + ;; "RCPT TO: ". 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:" / "RCPT TO:". + (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) - #:to (manager-config-mail-to config) - #:cc (manager-config-mail-cc config) - #:bcc (manager-config-mail-bcc config) + #:from from + #:to to + #:cc cc + #:bcc bcc #:body-content-type "text/html")) - (send-smtp-mail mail - #:host (manager-config-mail-host config) - #:port (manager-config-mail-port config) - #:tls-encode (manager-config-mail-tls? config) - #:username (manager-config-mail-username config) - #:password (manager-config-mail-password config)))) + (strict-send-smtp-mail mail + #:host (string-trim (manager-config-mail-host config)) + #:port (manager-config-mail-port config) + #:tls-encode (manager-config-mail-tls? config) + #:username (string-trim (manager-config-mail-username config)) + #:password (manager-config-mail-password config)))) diff --git a/private/opus-convert-place.rkt b/private/opus-convert-place.rkt new file mode 100644 index 0000000..c8b9349 --- /dev/null +++ b/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) stringsettings 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))])) diff --git a/private/report.rkt b/private/report.rkt index ae4d4dd..fdd90c4 100644 --- a/private/report.rkt +++ b/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)) diff --git a/private/scan.rkt b/private/scan.rkt index cfa24b5..3f46e86 100644 --- a/private/scan.rkt +++ b/private/scan.rkt @@ -1,12 +1,39 @@ #lang racket/base -(require racket/file - racket/list +(require 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 stringstring)) + +(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) - stringstring)) + (sort-paths (filter flac-path? (find-regular-files base-dir)))) diff --git a/private/util.rkt b/private/util.rkt index 821a7c9..045e040 100644 --- a/private/util.rkt +++ b/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) - (let-values ([(base name dir?) (split-path p)]) - (and (path? name) - (string-ci=? (bytes->string/utf-8 (or (path-get-extension name) #"")) ".flac"))))) + (and (file-exists?/quiet p) (extension-ci=? p ".flac"))) + +(define (opus-path? p) + (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 stringstring)) + +(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)) diff --git a/scribblings/audio-library-manager.scrbl b/scribblings/audio-library-manager.scrbl index d665d68..e7f6d58 100644 --- a/scribblings/audio-library-manager.scrbl +++ b/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 -maximum sample rate of 48 kHz. Files with a higher sample rate are converted in -place through a worker place. The conversion path uses +The tool @filepath{flac-48khz-manager.rkt} keeps a FLAC tree at a maximum sample +rate of 48 kHz. Files with a higher sample rate are converted in place through a +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 } -The manager creates these files below @filepath{}: +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[ - @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 manager only processes @filepath{.flac} files; @filepath{.mp3} files and +other sidecar files are ignored by this command. + +@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 } + +The default Opus bitrate is 224 kbps. A different bitrate can be selected with: + +@verbatim{racket flac2opus-manager.rkt --kbps 192 } + +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.} diff --git a/test/flac-48khz-manager-test.rkt b/test/flac-48khz-manager-test.rkt index 1564af9..f119d7e 100644 --- a/test/flac-48khz-manager-test.rkt +++ b/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)) diff --git a/test/flac2opus-manager-test.rkt b/test/flac2opus-manager-test.rkt new file mode 100644 index 0000000..605653b --- /dev/null +++ b/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)