opus conversie

2026-06-09 08:41:01 +02:00
parent 92c8e40518
commit ce5c4d6de5
18 changed files with 1202 additions and 86 deletions
@@ -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)))
@@ -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)
@@ -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))))
@@ -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))))
+
@@ -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 "*"))))
@@ -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)
-                            #: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))))
@@ -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))]))
@@ -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))
@@ -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 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)
-        string<?
-        #:key path->string))
+  (sort-paths (filter flac-path? (find-regular-files base-dir))))
@@ -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 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))