Full conversion done

.gitignore

@@ -16,3 +16,4 @@ compiled/
 *.dep
 
 /private/*.bak
+/*.bak

audio-manager.rkt

@@ -0,0 +1,369 @@
+#lang racket/base
+
+(require racket/file)
+(require racket/serialize)
+(require racket/string)
+(require "private/file-walker.rkt")
+(require "private/util.rkt")
+(require "private/mail.rkt")
+(require "private/flac-handling.rkt")
+(require "private/opus-handling.rkt")
+(require "private/log.rkt")
+(require racket-audio)
+(require simple-log)
+(require simple-ini)
+
+(provide audio-manager)
+
+(define (audio-manager music-path opus-path #:log-level [log-level 'debug])
+  (let* ((ini-config-file (build-path music-path ".audio-manager.ini"))
+         (ini (file->ini ini-config-file))
+         (report-flacs-with-id3 "FLAC files with id3 tags\n\n")
+         (report-flac "")
+         (report-opus "")
+         (file-db-path (build-path music-path ".audio-manager.db"))
+         (file-db-hash (if (file-exists? file-db-path)
+                           (deserialize (file->value file-db-path))
+                           (make-hash)
+                           ))
+         (processed-dirs 0)
+         (processed-files 0)
+         (processed-opus 0)
+         (changed-files 0)
+         (unchanged-files 0)
+         (deleted-files 0)
+         (new-files 0)
+         (pictures-set 0)
+         (converted-files 0)
+         (copied-files 0)
+         (failed-converts 0)
+         (failed-copies 0)
+         (processed-kind (make-hash))
+         (base-rate (ini-get ini 'flac 'max-khz 48000))
+         (dirs-logged -1)
+         (known-exts '(mp3 flac opus mp4 m4a mpg jpg jpeg png pdf))
+         (unknown-exts '())
+        )
+
+    (define (kinds< a b)
+      (string<? (symbol->string a) (symbol->string b)))
+
+    (define (needs-processing? path info)
+      (let ((state (hash-ref info 'file-db #f)))
+        (and (eq? (hash-ref info 'type #f) 'file)
+             (not-hidden? path)
+             (or 
+              (eq? state 'changed)
+              (eq? state 'new)))))
+
+    (define (needs-copying? info)
+      (and (eq? (hash-ref info 'type #f) 'file)
+           (not (eq? (hash-ref info 'file-db #f) 'deleted))
+           (let ((path-part (get-path-part info)))
+             (if (eq? path-part #f)
+                 #f
+                 (not (file-exists? (build-path opus-path path-part)))))))
+
+    (define (deleted? info)
+      (eq? (hash-ref info 'file-db #f) 'deleted))
+
+    (define (get-path-part info)
+      (let ((p (hash-ref info 'path #f)))
+        (unless (eq? p #f)
+          (let ((path (build-path
+                       (os-path
+                        (if (string? p) p (path->string p))))))
+            path))))
+
+    (define (flac-id3? info)
+      (and
+       (eq? (hash-ref info 'type) 'file)
+       (eq? (hash-ref info 'ext) 'flac)
+       (eq? (hash-ref info 'sniffed #f) 'mp3)))
+
+    (define (flac? path info)
+      (when (eq? (hash-ref info 'type) 'file)
+        (let ((s (hash-ref info 'sniffed #f)))
+          (when (eq? s #f)
+            (hash-set! info 'sniffed (audio-sniff-format path))
+            )))
+      (and
+       (eq? (hash-ref info 'type) 'file)
+       (eq? (hash-ref info 'ext) 'flac)
+       (eq? (hash-ref info 'sniffed) 'flac)
+       )
+      )
+
+    (define (rep-id3 path)
+      (set! report-flacs-with-id3
+            (string-append report-flacs-with-id3
+                           (format "- ~a\n" path))))
+
+    (define (rep-flac msg)
+      (set! report-flac
+            (string-append report-flac
+                           "- " msg "\n")))
+
+    (define (rep-opus msg)
+      (set! report-opus
+            (string-append report-opus
+                           "- " msg "\n")))
+
+    (define (adjust-ext base-path path info)
+      (let ((ext (hash-ref info 'ext)))
+        (hash-set! info 'orig-ext ext)
+        (unless (eq? ext '||)
+          (unless (memq ext known-exts)
+            (hash-set! info 'ext 'unkown)
+            (unless (memq ext unknown-exts)
+              (set! unknown-exts (sort (cons ext unknown-exts)
+                                       kinds<))
+              )
+            ))
+        (values base-path path info)))
+
+    (define (flac-with-id3 base-path path info)
+      (if (needs-processing? path info)
+        (when (eq? (hash-ref info 'ext) 'flac)
+         (let ((sniffed (audio-sniff-format path)))
+           (hash-set! info 'sniffed sniffed)
+           (when (flac-id3? info)
+             (rep-id3 path))
+           )
+         )
+        (when (flac-id3? info)
+          (rep-id3 path))
+        )
+      (values base-path path info))
+
+    (define (flac-khz-bits base-path path info)
+      (when (and (needs-processing? path info) (flac? path info))
+        (when (or (eq? (hash-ref info 'khz #f) #f)
+                  (eq? (hash-ref info 'bits #f) #f))
+          (let-values (((khz bits) (determine-flac-khz-and-bits path)))
+            (hash-set! info 'khz khz)
+            (hash-set! info 'bits bits)
+            )
+          )
+        )
+      (values base-path path info)
+      )
+
+    (define (flac-convert base-path path info)
+      (when (and (needs-processing? path info) (flac? path info))
+        (let ((rate (hash-ref info 'khz 0)))
+          (when (> rate base-rate)
+            (info-am "Need to convert flac file ~a (rate = ~a)" path rate)
+            (rep-flac (format "Convert ~a from ~a to ~a\n" path rate base-rate))
+            (if (convert-flac-to-rate path base-rate)
+              (hash-set! info 'khz base-rate)
+              (begin
+                (err-am "  Cannot convert!")
+                (rep-flac "  CANNOT CONVERT!")))
+            )
+          )
+        )
+      (values base-path path info))
+
+    (define (flac-picture base-path path info)
+      (when (and (needs-processing? path info) (flac? path info))
+        (let ((t (id3-tags path)))
+          (when (eq? (tags-picture t) #f)
+            (let-values (((kind cover-file) (get-cover-file path)))
+              (unless (eq? cover-file #f)
+                (info-am "Flac file has no picture, cover/folder.jpg|png available, setting picture")
+                (let ((cover (if (eq? kind 'jpg)
+                                 (make-tags-picture "image/jpeg"
+                                                    'front-cover
+                                                    (file->bytes cover-file)
+                                                    #:description "Cover")
+                                 (make-tags-picture "image/png"
+                                                    'front-cover
+                                                    (file->bytes cover-file)
+                                                    #:description "Cover"))
+                             ))
+                  (call-with-id3-tags path
+                       (λ (tags)
+                         (tags-picture! tags cover)
+                         (tags-save! tags))
+                       #:mode 'read-write))
+                (info-am "  Picture set")
+                (set! pictures-set (+ pictures-set 1))
+                )
+              )
+            )
+          )
+        )
+      (values base-path path info))
+
+    (define (to-opus base-path path info)
+      (when (or (needs-processing? path info)
+                (needs-copying? info))
+        (if (flac? path info)
+          (let ((path-part (get-path-part info)))
+            (unless (eq? path-part #f)
+              (let ((opus-file (path-replace-extension
+                                (build-path opus-path path-part)
+                                #".opus")))
+                (set! processed-opus (+ processed-opus 1))
+                (unless (file-exists? opus-file)
+                  (rep-opus
+                   (format "Converting flac to opus: ~a" (basename opus-file)))
+                  (with-handlers ([exn? (λ (e)
+                                          (set! failed-converts (+ failed-converts 1))
+                                          (err-am "Conversion of ~a: ~a" path e))])
+                    (unless (directory-exists? (basedir opus-file))
+                      (make-directory* (basedir opus-file)))
+                    (if (convert-to-opus path opus-file ini)
+                        (begin
+                          (set! converted-files (+ converted-files 1))
+                          (info-am "  Converted")
+                          )
+                        (begin
+                          (info-am "  CONVERSION PROBLEM")
+                          (rep-opus "  Conversion failed!")
+                          (set! failed-converts (+ failed-converts 1))
+                          )
+                        )
+                    )
+                  )
+                )
+              )
+            )
+          (begin ; copy files rechtstreeks indien nodig
+            (with-handlers ([exn? (λ (e)
+                                    (set! failed-copies (+ failed-copies 1))
+                                    (err-am "Copy file ~a: ~a" path e))])
+              (let ((path-part (get-path-part info)))
+                (unless (eq? path-part #f)
+                  (let ((dest-path (build-path opus-path path-part)))
+                    (unless (directory-exists? (basedir dest-path))
+                      (make-directory* (basedir dest-path)))
+                    (copy-file path dest-path #:exists-ok? #t)
+                    (set! copied-files (+ copied-files 1)))))
+              )
+            )
+          )
+        )
+      (values base-path path info))
+
+    (define (deleter base-path path info)
+      (when (deleted? info)
+        (let ((path-part (get-path-part info)))
+          (unless (eq? path-part #f)
+            (let ((rm-path (build-path opus-path path-part)))
+              (delete-directory/files rm-path #:must-exist? #f)
+              (let ((normalized-sub-path (hash-ref info 'path)))
+                (hash-remove! file-db-hash normalized-sub-path))
+              )
+            )
+          )
+        )
+      (values base-path path info))
+
+    (define (log-processed-file base-path path info)
+      (dbg-am "processing ~a" path)
+      (if (eq? (hash-ref info 'type) 'dir)
+          (set! processed-dirs (+ processed-dirs 1))
+          (begin
+            (set! processed-files (+ processed-files 1))
+            (let ((k (hash-ref info 'file-db 'unknown)))
+              (cond ((eq? k 'new) (set! new-files (+ new-files 1)))
+                    ((eq? k 'changed) (set! changed-files (+ changed-files 1)))
+                    ((eq? k 'deleted) (set! deleted-files (+ deleted-files 1)))
+                    ((eq? k 'unchanged) (set! unchanged-files (+ unchanged-files 1)))
+                    ))
+            (let* ((ext (hash-ref info 'ext))
+                   (n (hash-ref processed-kind ext 0)))
+              (set! n (+ n 1))
+              (hash-set! processed-kind ext n)))
+          )
+
+      (when (or (= (remainder processed-dirs 10) 0)
+                (= (remainder processed-files 250) 0))
+        (unless (= dirs-logged processed-dirs)
+          (set! dirs-logged processed-dirs)
+          (info-am (format "processed dirs: ~a, files: ~a, kinds: ~a, unknown kinds: ~a"
+                                      processed-dirs
+                                      processed-files
+                                      (string-join
+                                       (map (λ (ext)
+                                              (format "~a: ~a" ext (hash-ref processed-kind ext)))
+                                            (sort (hash-keys processed-kind)
+                                                  kinds<))
+                                       ", ")
+                                      (string-join
+                                       (map (λ (ext) (symbol->string ext)) unknown-exts)
+                                       ", ")
+                                      ))
+          ))
+      
+      (when (flac-id3? info)
+        (warn-am (format "  FLAC heeft een id3v2 tag: ~a" path)))
+
+      (values base-path path info))
+
+    (define (report)
+      (rep-flac (format "Processed ~a flac files"
+                        (hash-ref processed-kind 'flac 0)))
+      (rep-opus (format "Processed ~a opus files"
+                        processed-opus))
+      (let* ((message (list "FLACS with id3 tags\n"
+                           "-------------------\n"
+                           report-flacs-with-id3
+                           "\n"
+                           "FLAC report\n"
+                           "-----------\n"
+                           report-flac
+                           "OPUS report\n"
+                           "-----------\n"
+                           report-opus
+                           "File report\n"
+                           "-----------\n"
+                           (format "Processed ~a files" processed-files)
+                           (format "Processed ~a directories" processed-dirs)
+                           (format "Deleted files  : ~a" deleted-files)
+                           (format "New files      : ~a" new-files)
+                           (format "Changed files  : ~a" changed-files)
+                           (format "Unchanged files: ~a" unchanged-files)
+                           (format "Pictures set   : ~a" pictures-set)
+                           (format "Converted files: ~a" converted-files)
+                           (format "Copied files   : ~a" copied-files)
+                           (format "Failed convert : ~a" failed-converts)
+                           (format "Failed copies  : ~a" failed-copies)
+                           ))
+            (subj (format "Audio manager report d.d. ~a" (date->yyyy-mm-dd (now))))
+            )
+        (mail-report ini
+                     subj
+                     message)
+        )
+      )
+
+    (sl-log-to-file&display (build-path music-path ".audio-manager.log"))
+    (info-am "Setting log level to ~a" log-level)
+    (sl-set-log-level log-level)
+
+    (let ((fw (make-file-admin music-path file-db-hash)))
+      (set! fw (fw-add-filter fw adjust-ext))
+      (set! fw (fw-add-filter fw flac-with-id3))
+      (set! fw (fw-add-filter fw flac-khz-bits))
+      (set! fw (fw-add-filter fw flac-convert))
+      (set! fw (fw-add-filter fw flac-picture))
+      (set! fw (fw-add-filter fw to-opus))
+      (set! fw (fw-add-filter fw deleter))
+      (set! fw (fw-add-filter fw log-processed-file))
+      (let loop ()
+        (let-values (((base-path path info) (fw)))
+          (if (eq? info #f)
+              (begin
+                (info-am "Finished walking music library")
+                (write-to-file (serialize file-db-hash) file-db-path  #:exists 'replace)
+                (report)
+                'done)
+              (loop))))
+      )
+    )
+  )
+      
+              

private/file-walker.rkt

@@ -7,10 +7,16 @@
          file/glob)
 
 (provide make-file-walker
+         make-file-admin
+         fw-add-filter
+         os-path
          )
 
+(define (os-path str)
+  (let ((delim (if (eq? (system-path-convention-type) 'windows) "\\" "/")))
+    (string-replace str "/" delim)))
 
-(define (make-file-walker base-path glob-pattern callback)
+(define (make-file-walker base-path glob-pattern filter-func)
   (let* ((gen (sequence->generator
                (sequence-filter
                 (λ (p)
@@ -28,27 +34,115 @@
     (λ ()
       (let ((path (gen)))
         (if (void? path)
-            result
+            (values #f #f #f)
             (let* ((str-path (path->string path))
                    (ext* (path-get-extension path))
-                   (ext (substring
-                         (if (eq? ext* #f)
-                             "."
-                             (bytes->string/utf-8 ext*)) 1))
+                   (ext (string->symbol
+                         (substring
+                          (if (eq? ext* #f)
+                              "."
+                              (let ((e (string-downcase (bytes->string/utf-8 ext*))))
+                                (if (string-contains? e " ")
+                                    "."
+                                    e))) 1)))
                    (path-part (substring str-path base-path-len))
                    (str-n-path (string-replace path-part "\\" "/"))
-                   (info (if (directory-exists? path)
-                             (list 'dir str-n-path ext)
-                             (list 'file str-n-path ext
-                                   (file-size path)
-                                   (file-or-directory-modify-seconds path))
-                             ))
+                   (info (let ((h (make-hash (list
+                                              (cons 'type 'dir)
+                                              (cons 'path str-n-path)
+                                              (cons 'ext ext)))))
+                           (when (file-exists? path)
+                             (hash-set! h 'type 'file)
+                             (hash-set! h 'size (file-size path))
+                             (hash-set! h 'mtime (file-or-directory-modify-seconds path))
+                             )
+                           h))
                    )
-              (set! result (callback (eq? (car info) 'dir)
-                                     base-path
-                                     path
-                                     path-part ext info))
-              'more))))
+              (filter-func base-path path info)))
+        )
+      )
     )
   )
-  
+
+(define (make-file-admin base-path db-hash)
+
+  (define (file-info-equal? i1 i2)
+    (if (eq? (hash-ref i1 'type) (hash-ref i2 'type))
+        (if (eq? (hash-ref i1 'type) 'file)
+            (and
+             (string=? (hash-ref i1 'path) (hash-ref i2 'path))
+             (= (hash-ref i1 'size) (hash-ref i2 'size))
+             (= (hash-ref i1 'mtime) (hash-ref i2 'mtime)))
+            (string=? (hash-ref i1 'path) (hash-ref i2 'path))
+            )
+        #f))
+  
+  (define (file-admin base-path path info)
+    (let* ((normalized-sub-path (hash-ref info 'path))
+           (in-db (hash-ref db-hash normalized-sub-path #f))
+           )
+      (cond
+        ((eq? in-db #f)
+         (hash-set! info 'file-db 'new)
+         (hash-set! db-hash normalized-sub-path info)
+         )
+        (else
+         (if (file-info-equal? info in-db)
+             (hash-set! info 'file-db 'unchanged)
+             (hash-set! info 'file-db 'changed))
+         (hash-set! db-hash normalized-sub-path info)
+         )
+        )
+      (values base-path path info)
+      ))
+
+  (define (init-db-sweep)
+    (hash-for-each db-hash
+                   (λ (key value)
+                     (if (eq? (hash-ref value 'file-db #f) 'deleted)
+                         (hash-remove! db-hash key)
+                         (hash-set! value 'file-db 'unknown)))))
+
+  (define (get-deleted)
+    (let ((keys (hash-keys db-hash)))
+      (map (λ (key)
+             (let ((info (hash-ref db-hash key)))
+               (hash-set! info 'file-db 'deleted)
+               info))
+           (filter (λ (key)
+                     (let ((v (hash-ref db-hash key)))
+                       (eq? (hash-ref v 'file-db) 'unknown)))
+                   keys))))
+  
+  (let* ((fw (make-file-walker base-path "*" file-admin))
+         (deleted #f))
+    (init-db-sweep)
+    (letrec ((f (λ ()
+                  (if (list? deleted)
+                      (if (null? deleted)
+                          (values #f #f #f)
+                          (let ((r (car deleted)))
+                            (set! deleted (cdr deleted))
+                            (values base-path (build-path base-path (os-path (hash-ref r 'path))) r))
+                          )
+                      (let-values (((base-path path info) (fw)))
+                        (if (eq? info #f)
+                            (begin
+                              (set! deleted (get-deleted))
+                              (f))
+                            (values base-path path info))
+                        )
+                      )
+                  )
+                ))
+      f))
+  )
+
+(define (fw-add-filter fw filter-func)
+  (λ ()
+    (let-values (((base-path path info) (fw)))
+      (if (eq? info #f)
+          (values #f #f #f)
+          (filter-func base-path path info))))
+  )
+

private/flac-handling.rkt

@@ -0,0 +1,50 @@
+#lang racket/base
+(require racket-audio/flac-decoder
+         racket-audio/audio-encoder
+         "log.rkt"
+         )
+
+(provide determine-flac-khz-and-bits
+         convert-flac-to-rate)
+
+
+(define (determine-flac-khz-and-bits path)
+  (with-handlers ((exn? (λ args
+                          (error (format "Cannot process ~a" path)))))
+    (let* ((meta #f)
+           (flac-handle (flac-open path
+                                   (λ (info) (set! meta info))
+                                   (λ data #t)))
+           )
+      (flac-read-meta flac-handle)
+      (flac-stop flac-handle)
+      (if (eq? meta #f)
+          (values #f #f)
+          (values (hash-ref meta 'sample-rate)
+                  (hash-ref meta 'audio-bits-per-sample))
+          )
+      )
+    )
+  )
+
+
+(define (convert-flac-to-rate path rate)
+  (let* ((tmp-file (build-path (string-append (path->string path) ".tmp.flac")))
+         (encoder-settings (hash 'target-sample-rate rate
+                                 'compression-level 8))
+         )
+    (with-handlers ([exn? (λ (e)
+                            (err-am (format "~a" e))
+                            (when (file-exists? tmp-file)
+                              (delete-file tmp-file))
+                            #f)])
+      (let ((result (audio-encode path tmp-file
+                                  encoder-settings
+                                  #:encoder 'flac
+                                  #:copy-tags? #t
+                                  )))
+        (rename-file-or-directory tmp-file path #t)
+        #t)
+      )
+    )
+  )

private/log.rkt

@@ -1,22 +1,17 @@
 #lang racket/base
 
-(require racket/file
-         simple-log)
+(require simple-log)
 
-(provide setup-logging!
-         dbg-alm
-         info-alm
-         warn-alm
-         err-alm
-         fatal-alm
-         sync-log-alm)
+(provide dbg-am
+         info-am
+         warn-am
+         err-am
+         fatal-am
+         sync-log-am)
 
-(sl-def-log audio-library-manager alm)
+(define log-defined #f)
+(displayln (format "log-defined: ~a" log-defined))
+(set! log-defined #t)
+
+(sl-def-log audio-manager am)
 
-(define (setup-logging! log-file display-log?)
-  (make-directory* (let-values ([(base name dir?) (split-path log-file)]) base))
-  (if display-log?
-      (sl-log-to-file&display log-file)
-      (sl-log-to-file log-file))
-  (sl-set-log-level 'debug)
-  (info-alm "logging initialized: ~a" log-file))

private/mail.rkt

@@ -1,149 +1,28 @@
 #lang racket/base
 
-(require racket/list
-         racket/string
-         racket/tcp
-         net/base64
-         "manager-ini.rkt"
-         "report.rkt")
+(require net/smtp
+         net/head
+         simple-ini)
 
-(provide maybe-send-report-mail
-         mail-address->envelope-address
-         strict-send-smtp-mail)
+(provide mail-report)
 
 
-(define (smtp-proc name)
-  (dynamic-require 'smtp name))
+(define (mail-report ini subject report)
+  (let* ((get (λ (key msg)
+                (let ((v (ini-get ini 'mail key 'nil)))
+                  (when (eq? v 'nil)
+                    (error msg))
+                  v)))
+         (from (get 'from "configure from address as name <email>"))
+         (to (get 'to "configure to address as name <email>"))
+         (server (get 'server "configure the smtp server"))
+         (port (ini-get ini 'mail 'port 25))
+         )
+    (let* ((hdr (standard-message-header from (list to) '() '() subject)))
+      (smtp-send-message server from (list to) hdr
+                         (if (list? report) report (list report))
+                         #:port-no port)
+      )
+    )
+  )
 
-(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 ini 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 (ini-ref/bool ini 'mail 'enabled #f)
-         (not (null? (ini-ref/addresses ini 'mail 'to "")))
-         (or (and has-errors? (ini-ref/bool ini 'mail 'send-on-error #t))
-             (and (not has-errors?) (ini-ref/bool ini 'mail 'send-on-success #f)))))
-  (when should-send?
-    (define from (mail-address->envelope-address (ini-ref/string ini 'mail 'from "")))
-    (define to (clean-address-list (ini-ref/addresses ini 'mail 'to "")))
-    (define cc (clean-address-list (ini-ref/addresses ini 'mail 'cc "")))
-    (define bcc (clean-address-list (ini-ref/addresses ini 'mail 'bcc "")))
-    (define subject (format "~a ~a: ~a error(s), ~a ~a"
-                            (ini-ref/string ini 'mail 'subject-prefix "[flac-48khz-manager]")
-                            manager-name
-                            (summary-ref summary 'errors 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 from
-                            #:to to
-                            #:cc cc
-                            #:bcc bcc
-                            #:body-content-type "text/html"))
-    (strict-send-smtp-mail mail
-                           #:host (string-trim (ini-ref/string ini 'mail 'host ""))
-                           #:port (ini-ref/int ini 'mail 'port 25)
-                           #:tls-encode (ini-ref/bool ini 'mail 'tls #f)
-                           #:username (string-trim (ini-ref/string ini 'mail 'username ""))
-                           #:password (ini-ref/string ini 'mail 'password ""))))

private/opus-handling.rkt

@@ -0,0 +1,29 @@
+#lang racket/base
+(require racket-audio/audio-encoder
+         "log.rkt"
+         "util.rkt"
+         simple-ini
+         )
+
+(provide convert-to-opus
+         )
+
+
+(define (convert-to-opus flac-in opus-out ini)
+  (let* ((opus-kbps (ini-get ini 'opus 'kbps 224))
+         (settings (hash 'bitrate (* opus-kbps 1000)
+                         'vbr #t))
+         )
+    (with-handlers ([exn? (λ (e)
+                            (err-am (format "~a" e))
+                            (when (file-exists? opus-out)
+                              (delete-file opus-out))
+                            #f)])
+      (let ((result (audio-encode flac-in opus-out
+                                  settings
+                                  #:encoder 'opus
+                                  #:copy-tags? #t)))
+        #t)
+      )
+    )
+  )

private/util.rkt

@@ -1,165 +1,54 @@
 #lang racket/base
 
-(require racket/file
-         racket/list
+(require racket/date
+         racket/format
          racket/path
-         racket/string)
+         racket/string
+         )
 
-(provide bool-value
-         int-value
-         string-value
-         split-addresses
-         normalized-relpath-string
-         normalized-relpath->path
-         normalize-relpath-string
-         legacy-backslash-relpath-string
-         relpath-string
-         filesystem-path
-         flac-path?
-         opus-path?
-         manager-temp-path?
-         directory-file-paths
-         replace-path-extension
-         ensure-parent-directory!
-         alist-ref/default
-         alist-set)
+(provide date->yyyy-mm-dd
+         now
+         get-cover-file
+         basename
+         basedir
+         not-hidden?
+         )
 
-(define (bool-value v [default #f])
-  (cond [(boolean? v) v]
-        [(number? v) (not (zero? v))]
-        [(string? v)
-         (define s (string-downcase (string-trim v)))
-         (cond [(member s '("#t" "true" "yes" "y" "1" "on")) #t]
-               [(member s '("#f" "false" "no" "n" "0" "off" "")) #f]
-               [else default])]
-        [else default]))
+(define (now)
+  (seconds->date (current-seconds)))
 
-(define (int-value v [default 0])
-  (cond [(integer? v) v]
-        [(number? v) (inexact->exact (round v))]
-        [(string? v) (or (string->number (string-trim v)) default)]
-        [else default]))
+(define (date->yyyy-mm-dd d)
+  (format "~a-~a-~a"
+          (date-year d)
+          (~r (date-month d) #:min-width 2 #:pad-string "0")
+          (~r (date-day d) #:min-width 2 #:pad-string "0")))
 
-(define (string-value v [default ""])
-  (cond [(string? v) v]
-        [(symbol? v) (symbol->string v)]
-        [(number? v) (number->string v)]
-        [(boolean? v) (if v "#t" "#f")]
-        [(not v) default]
-        [else (format "~a" v)]))
+(define (get-cover-file path)
+  (let-values (((base name dir) (split-path path)))
+    (let ((names '((jpg "cover.jpg") (jpg "cover.jpeg")
+                   (jpg "folder.jpg") (jpg "folder.jpeg")
+                   (png "cover.png") (png "folder.png"))))
+      (letrec ((f (λ (l)
+                    (if (null? l)
+                        (values #f #f)
+                        (if (file-exists? (build-path base (cadar l)))
+                            (values (caar l) (build-path base (cadar l)))
+                            (f (cdr l)))))))
+        (f names)))))
 
-(define (split-addresses v)
-  (define s (string-value v ""))
-  (filter (lambda (x) (not (string=? x "")))
-          (map string-trim (regexp-split #px"[,;]" s))))
+(define (basename path)
+  (file-name-from-path path))
 
-(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 (basedir path)
+  (path-only path))
 
-(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 (replace-char s from to)
-  (list->string
-   (for/list ([ch (in-string s)])
-     (if (char=? ch from) to ch))))
+(define (hidden-path? p)
+  (for/or ([part (in-list (explode-path p))])
+    (and (path? part)
+         (let ([s (path->string part)])
+           (and (string-prefix? s ".")
+                (not (member s '("." ".."))))))))
 
-(define (normalize-relpath-string s)
-  (define normalized (replace-char s #\\ #\/))
-  (when (or (string=? normalized "")
-            (regexp-match? #rx"^[A-Za-z]:" normalized)
-            (regexp-match? #rx"^/" normalized)
-            (regexp-match? #rx"(^|/)\\.\\.(/|$)" normalized))
-    (raise-argument-error 'normalize-relpath-string "relative path without .." s))
-  normalized)
-
-(define (legacy-backslash-relpath-string relpath)
-  (replace-char (normalize-relpath-string relpath) #\/ #\\))
-
-(define (normalized-relpath-string base p)
-  (normalize-relpath-string
-   (path->string (find-relative-path (filesystem-path base) (filesystem-path p)))))
-
-(define relpath-string normalized-relpath-string)
-
-(define (normalized-relpath->path relpath)
-  (define parts (regexp-split #rx"/+" (normalize-relpath-string relpath)))
-  (when (ormap (lambda (part) (or (string=? part "") (string=? part "."))) parts)
-    (raise-argument-error 'normalized-relpath->path "relative normalized path" relpath))
-  (apply build-path parts))
-
-(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?/quiet p) (extension-ci=? p ".flac")))
-
-(define (opus-path? p)
-  (and (file-exists?/quiet p) (extension-ci=? p ".opus")))
-
-(define (manager-temp-path? p)
-  (define-values (_base name _dir?) (split-path p))
-  (and (path? name)
-       (regexp-match? #rx"^\\..*\\.tmp-[0-9.]+\\.(flac|opus)$" (path->string name))))
-
-(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)]
-            [(and (file-exists?/quiet p) (not (manager-temp-path? 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))
-  (when (path? base) (make-directory* base)))
-
-(define (alist-ref/default a k [default #f])
-  (define e (assoc k a))
-  (if e (cdr e) default))
-
-(define (alist-set a k v)
-  (cons (cons k v) (filter (lambda (e) (not (equal? (car e) k))) a)))
+(define (not-hidden? path)
+  (not (hidden-path? path)))