[atom] Allow relative URLs for Tor/i2p mirrors

1 files changed, 12 insertions, 7 deletions

diff --git a/haunt/jakob/builder/atom.scm b/haunt/jakob/builder/atom.scm
index ea2cfd1..81dd78e 100644
--- a/haunt/jakob/builder/atom.scm
+++ b/haunt/jakob/builder/atom.scm
@@ -29,6 +29,9 @@
   #:use-module (web uri)
   #:export (atom-feed))
 
+;; Slight hack to use relative URLs in the Atom feed for Tor and i2p mirrors.
+(define %disable-compliance (make-parameter (getenv "DISABLE_ATOM_COMPLIANCE")))
+
 (define (format-date date)
   "Format DATE into a date-time production as defined in RFC 3339"
   (let* ((formatted       (date->string date "~4"))
@@ -38,13 +41,15 @@
 
 (define (format-relative-path site path)
   "Return an absolute URI for PATH"
-  (let ((path (if (not (string-prefix? "/" path))
-                  (format #f "/~a" path)
-                  path)))
-    (uri->string
-     (build-uri 'https ;; (site-scheme site)
-                #:host (site-domain site)
-                #:path path))))
+  (if (%disable-compliance)
+      path
+      (let ((path (if (not (string-prefix? "/" path))
+                      (format #f "/~a" path)
+                      path)))
+        (uri->string
+         (build-uri 'https ;; (site-scheme site)
+                    #:host (site-domain site)
+                    #:path path)))))
 
 (define* (post->atom-entry site post #:key (blog-prefix ""))
   "Convert POST into an Atom <entry> XML node."