diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-21 02:59:49 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-28 14:17:47 +0200 |
commit | ea97ad4e9d01bfb66791e397444ed1a7ccc006f6 (patch) | |
tree | 6004494032fd299fa23f9e47b23cf4adef80012c /module | |
parent | Check system-error errno correctly. (diff) | |
download | calp-ea97ad4e9d01bfb66791e397444ed1a7ccc006f6.tar.gz calp-ea97ad4e9d01bfb66791e397444ed1a7ccc006f6.tar.xz |
Rewrote symlink creator for HTML
Diffstat (limited to '')
-rw-r--r-- | module/calp/entry-points/html.scm | 42 |
1 files changed, 26 insertions, 16 deletions
diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index 37b0285b..04b09cf3 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -1,6 +1,7 @@ (define-module (calp entry-points html) :export (main) :use-module (hnh util) + :use-module ((hnh util exceptions) :select (warning)) :use-module ((hnh util path) :select (path-append)) :use-module (calp util time) :use-module (hnh util options) @@ -66,22 +67,31 @@ ;; file existing but is of wrong type, (define (create-files output-directory) - - (let* ((link (path-append output-directory "static"))) - - (unless (file-exists? output-directory) - (mkdir output-directory)) - - ;; TODO nicer way to resolve static - (let ((link (path-append output-directory "static"))) - (unless (file-exists? link) - (if (catch 'system-error - (lambda () (lstat link)) - (lambda (err proc fmt fmt-args data) - #f)) - (format #t "WARNING: broken symlink ~s → ~s~%" - link (readlink link)) - (symlink (path-append (xdg-data-home) "calp" "www" "static") link)))))) + (define link (path-append output-directory "static")) + ;; NOTE the target path is newer created + (define target (path-append (xdg-data-home) "calp" "www" "static")) + + (unless (file-exists? output-directory) + (mkdir output-directory)) + + (catch 'system-error + (lambda () (symlink target link)) + (lambda (err proc fmt fmt-args data) + (define errno (car data)) + (cond ((= errno EACCES) + (warning (format #f "~?" fmt fmt-args))) + ((= errno EEXIST) + (let ((st (lstat link))) + (cond ((not (eq? 'symlink (stat:type st))) + (warning "File ~s exists, but isn't a symlink" link)) + ((not (string=? target (readlink link))) + (warning "~s is a symlink, but points to ~s instead of expected ~s" + link (readlink link) target)))) + ;; else, file exists as a symlink, and points where we want, + ;; which is expected. Do nothing and be happy. + ) + ;; Rethrow + (else (scm-error err proc fmt fmt-args data)))))) (define (re-root-static tree) |