aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-03-21 02:59:49 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2022-03-28 14:17:47 +0200
commitea97ad4e9d01bfb66791e397444ed1a7ccc006f6 (patch)
tree6004494032fd299fa23f9e47b23cf4adef80012c
parentCheck system-error errno correctly. (diff)
downloadcalp-ea97ad4e9d01bfb66791e397444ed1a7ccc006f6.tar.gz
calp-ea97ad4e9d01bfb66791e397444ed1a7ccc006f6.tar.xz
Rewrote symlink creator for HTML
-rw-r--r--module/calp/entry-points/html.scm42
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)