From 5263ebee71faec192ce9b47b0a4e7509d7a617dc Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 9 Jun 2026 15:25:27 +0200 Subject: [PATCH] Genormaliseerde paden in keystore. --- README.md | 4 +- flac2opus-manager.rkt | 52 ++++++++++++------------- private/flac2opus-state.rkt | 38 ++++++++++++++---- private/state.rkt | 40 ++++++++++++++----- private/util.rkt | 34 +++++++++++++++- scribblings/audio-library-manager.scrbl | 4 +- test/path-state-test.rkt | 45 +++++++++++++++++++++ 7 files changed, 170 insertions(+), 47 deletions(-) create mode 100644 test/path-state-test.rkt diff --git a/README.md b/README.md index de4c0fa..f1e9645 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,9 @@ Both managers use the same administration files in the source tree: - `.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. +the same database with the 48 kHz manager without mixing state entries. State +keys use only normalized paths relative to the configured source/base directory: +absolute mount points are not stored, and path separators are always `/`. ## FLAC 48 kHz manager diff --git a/flac2opus-manager.rkt b/flac2opus-manager.rkt index 7284a6d..77bb84c 100644 --- a/flac2opus-manager.rkt +++ b/flac2opus-manager.rkt @@ -39,12 +39,16 @@ [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 (state-target-relpath old) + (define v (and old (alist-ref/default old 'target-relpath #f))) + (and v (normalize-relpath-string v))) + (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? (state-target-relpath old) target-relpath) (equal? (alist-ref/default old 'kbps #f) kbps) (not (equal? (alist-ref/default old 'status #f) 'error)))) @@ -52,36 +56,36 @@ (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? (state-target-relpath old) 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))) + (normalized-relpath-string base-dir path)) -(define (flac-extension-path? p) - (let-values ([(base name dir?) (split-path p)]) +(define (flac-extension-relpath? relpath) + (let-values ([(base name dir?) (split-path (string->path relpath))]) (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-relpath-for relpath) + (if (flac-extension-relpath? relpath) + (normalize-relpath-string + (path->string (replace-path-extension (string->path relpath) #".opus"))) + relpath)) -(define (target-path-for target-dir target-rel) - (build-path target-dir target-rel)) +(define (target-path-for target-dir target-relpath) + (build-path target-dir (normalized-relpath->path target-relpath))) (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))) + (define old-target-relpath (state-target-relpath old)) (when (and old-target-relpath (not (equal? old-target-relpath new-target-relpath))) - (define old-target (build-path target-dir old-target-relpath)) + (define old-target (target-path-for target-dir old-target-relpath)) (when (delete-file/quiet old-target) (info-alm "removed obsolete target: ~a" old-target-relpath)))) @@ -99,9 +103,8 @@ (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 (process-one-source-file ks config target-dir path relpath target-relpath kbps convert-proc summary errors) + (define target-path (target-path-for target-dir target-relpath)) (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) @@ -155,9 +158,9 @@ (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))]) + [target-relpath (state-target-relpath old)]) (when target-relpath - (define target-path (build-path target-dir target-relpath)) + (define target-path (target-path-for 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) @@ -188,19 +191,14 @@ (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 relpaths (map (lambda (p) (source-relpath-string source-dir p)) files)) + (define target-relpaths (map target-relpath-for relpaths)) (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))) + (process-one-source-file ks config target-dir p relpath 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* diff --git a/private/flac2opus-state.rkt b/private/flac2opus-state.rkt index 3045696..27c0365 100644 --- a/private/flac2opus-state.rkt +++ b/private/flac2opus-state.rkt @@ -1,6 +1,8 @@ #lang racket/base -(require keystore) +(require racket/list + keystore + "util.rkt") (provide open-flac2opus-state flac2opus-state-get-file @@ -14,17 +16,39 @@ (ks-open state-file)) (define (file-state-key relpath) - (string-append prefix relpath)) + (string-append prefix (normalize-relpath-string relpath))) + +(define (legacy-file-state-key relpath) + (string-append prefix (legacy-backslash-relpath-string relpath))) + +(define (ks-drop/quiet! ks key) + (with-handlers ([exn:fail? (lambda (_) (void))]) + (ks-drop! ks key))) (define (flac2opus-state-get-file ks relpath [default #f]) - (ks-get ks (file-state-key relpath) default)) + (define key (file-state-key relpath)) + (define legacy-key (legacy-file-state-key relpath)) + (define missing (gensym 'missing)) + (define value (ks-get ks key missing)) + (cond [(not (eq? value missing)) value] + [(equal? key legacy-key) default] + [else (ks-get ks legacy-key default)])) (define (flac2opus-state-set-file! ks relpath value) - (ks-set! ks (file-state-key relpath) value)) + (define key (file-state-key relpath)) + (define legacy-key (legacy-file-state-key relpath)) + (ks-set! ks key value) + (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key))) (define (flac2opus-state-drop-file! ks relpath) - (ks-drop! ks (file-state-key relpath))) + (define key (file-state-key relpath)) + (define legacy-key (legacy-file-state-key relpath)) + (ks-drop/quiet! ks key) + (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key))) (define (flac2opus-state-known-relpaths ks) - (map (lambda (k) (substring k (string-length prefix))) - (ks-keys-glob ks (string-append prefix "*")))) + (remove-duplicates + (map (lambda (k) + (normalize-relpath-string (substring k (string-length prefix)))) + (ks-keys-glob ks (string-append prefix "*"))) + equal?)) diff --git a/private/state.rkt b/private/state.rkt index e8bce2b..ebeba18 100644 --- a/private/state.rkt +++ b/private/state.rkt @@ -1,7 +1,8 @@ #lang racket/base -(require racket/string - keystore) +(require racket/list + keystore + "util.rkt") (provide open-manager-state file-state-key @@ -16,18 +17,39 @@ (ks-open state-file)) (define (file-state-key relpath) - (string-append prefix relpath)) + (string-append prefix (normalize-relpath-string relpath))) + +(define (legacy-file-state-key relpath) + (string-append prefix (legacy-backslash-relpath-string relpath))) + +(define (ks-drop/quiet! ks key) + (with-handlers ([exn:fail? (lambda (_) (void))]) + (ks-drop! ks key))) (define (state-get-file ks relpath [default #f]) - (ks-get ks (file-state-key relpath) default)) + (define key (file-state-key relpath)) + (define legacy-key (legacy-file-state-key relpath)) + (define missing (gensym 'missing)) + (define value (ks-get ks key missing)) + (cond [(not (eq? value missing)) value] + [(equal? key legacy-key) default] + [else (ks-get ks legacy-key default)])) (define (state-set-file! ks relpath value) - (ks-set! ks (file-state-key relpath) value)) + (define key (file-state-key relpath)) + (define legacy-key (legacy-file-state-key relpath)) + (ks-set! ks key value) + (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key))) (define (state-drop-file! ks relpath) - (ks-drop! ks (file-state-key relpath))) + (define key (file-state-key relpath)) + (define legacy-key (legacy-file-state-key relpath)) + (ks-drop/quiet! ks key) + (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key))) (define (state-known-relpaths ks) - (map (lambda (k) - (substring k (string-length prefix))) - (ks-keys-glob ks (string-append prefix "*")))) + (remove-duplicates + (map (lambda (k) + (normalize-relpath-string (substring k (string-length prefix)))) + (ks-keys-glob ks (string-append prefix "*"))) + equal?)) diff --git a/private/util.rkt b/private/util.rkt index 045e040..b3a367e 100644 --- a/private/util.rkt +++ b/private/util.rkt @@ -9,6 +9,10 @@ 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? @@ -70,8 +74,34 @@ [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 (filesystem-path base) (filesystem-path p)))) +(define (replace-char s from to) + (list->string + (for/list ([ch (in-string s)]) + (if (char=? ch from) to ch)))) + +(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)]) diff --git a/scribblings/audio-library-manager.scrbl b/scribblings/audio-library-manager.scrbl index e7f6d58..cfdfeef 100644 --- a/scribblings/audio-library-manager.scrbl +++ b/scribblings/audio-library-manager.scrbl @@ -138,7 +138,9 @@ use, the default inspector, fingerprint function and converter are used.} 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.} +separate @tt{flac2opus} prefix. Keystore keys and stored target paths use +normalized paths relative to the configured source or target base directory; +absolute mount points are not stored and separators are always @tt{/}.} @defproc[(summary->lines [summary list?]) (listof string?)]{ Formats the summary association list as display lines.} diff --git a/test/path-state-test.rkt b/test/path-state-test.rkt new file mode 100644 index 0000000..769f75b --- /dev/null +++ b/test/path-state-test.rkt @@ -0,0 +1,45 @@ +#lang racket/base + +(require rackunit + racket/file + keystore + "../private/flac2opus-state.rkt" + "../private/state.rkt" + "../private/util.rkt") + +(check-equal? (normalize-relpath-string "disc1\\track.flac") "disc1/track.flac") +(check-equal? (legacy-backslash-relpath-string "disc1/track.flac") "disc1\\track.flac") +(check-exn exn:fail:contract? (lambda () (normalize-relpath-string "../track.flac"))) +(check-exn exn:fail:contract? (lambda () (normalize-relpath-string "/music/track.flac"))) +(check-exn exn:fail:contract? (lambda () (normalize-relpath-string "C:/music/track.flac"))) + +(define state-file (make-temporary-file "alm-state-~a.db")) +(define ks (open-manager-state state-file)) +(void (state-set-file! ks "disc1\\track.flac" '((status . normalized)))) +(check-equal? (state-get-file ks "disc1/track.flac") '((status . normalized))) +(check-equal? (state-known-relpaths ks) '("disc1/track.flac")) +(check-not-false (member "flac-48khz:file:disc1/track.flac" (ks-keys-glob ks "flac-48khz:file:*"))) +(check-false (member "flac-48khz:file:disc1\\track.flac" (ks-keys-glob ks "flac-48khz:file:*"))) + +(define legacy-48-key (string-append "flac-48khz:file:" (legacy-backslash-relpath-string "legacy/track.flac"))) +(void (ks-set! ks legacy-48-key '((status . legacy)))) +(check-equal? (state-get-file ks "legacy/track.flac") '((status . legacy))) +(void (state-set-file! ks "legacy/track.flac" '((status . migrated)))) +(check-equal? (state-get-file ks "legacy/track.flac") '((status . migrated))) +(check-false (member legacy-48-key (ks-keys-glob ks "flac-48khz:file:*"))) + +(define ks2 (open-flac2opus-state state-file)) +(void (flac2opus-state-set-file! ks2 "disc1\\track.flac" '((target-relpath . "disc1/track.opus")))) +(check-equal? (flac2opus-state-get-file ks2 "disc1/track.flac") '((target-relpath . "disc1/track.opus"))) +(check-equal? (flac2opus-state-known-relpaths ks2) '("disc1/track.flac")) +(check-not-false (member "flac2opus:file:disc1/track.flac" (ks-keys-glob ks2 "flac2opus:file:*"))) +(check-false (member "flac2opus:file:disc1\\track.flac" (ks-keys-glob ks2 "flac2opus:file:*"))) + +(define legacy-opus-key (string-append "flac2opus:file:" (legacy-backslash-relpath-string "legacy/track.flac"))) +(void (ks-set! ks2 legacy-opus-key '((target-relpath . "legacy\\track.opus")))) +(check-equal? (flac2opus-state-get-file ks2 "legacy/track.flac") '((target-relpath . "legacy\\track.opus"))) +(void (flac2opus-state-set-file! ks2 "legacy/track.flac" '((target-relpath . "legacy/track.opus")))) +(check-equal? (flac2opus-state-get-file ks2 "legacy/track.flac") '((target-relpath . "legacy/track.opus"))) +(check-false (member legacy-opus-key (ks-keys-glob ks2 "flac2opus:file:*"))) + +(delete-file state-file)