diff --git a/tekuti/config.scm b/tekuti/config.scm index 65fd182..27b6fa6 100644 --- a/tekuti/config.scm +++ b/tekuti/config.scm @@ -1,5 +1,5 @@ ;; Tekuti -;; Copyright (C) 2008, 2010, 2012 Andy Wingo +;; Copyright (C) 2008, 2010, 2012, 2014 Andy Wingo ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -27,13 +27,14 @@ (define-module (tekuti config) #:use-module (tekuti util) #:use-module ((sxml ssax) #:select (define-parsed-entity!)) - #:export (*public-host* *public-port* *public-path-base* + #:export (*public-scheme* *public-host* *public-port* *public-path-base* *private-host* *private-port* *private-path-base* *git-dir* *git* *debug* *admin-user* *admin-pass* *css-file* *navbar-links* *navbar-infix* *title* *subtitle* *name* *server-impl* *server-impl-args*)) +(define *public-scheme* 'http) (define *public-host* "127.0.0.1") (define *public-port* 8080) (define *public-path-base* '()) diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm index ab0a5e7..47f8cc4 100644 --- a/tekuti/page-helpers.scm +++ b/tekuti/page-helpers.scm @@ -65,13 +65,23 @@ ((_ tail) tail))) -(define (ensure-public-uri x) +(define (ensure-uri x) (cond ((uri? x) x) ((string? x) - (build-uri 'http #:host *public-host* #:port *public-port* #:path x)) + (build-uri *public-scheme* #:host *public-host* #:port *public-port* + #:path x)) ((list? x) - (ensure-public-uri (relurl x))) + (ensure-uri (relurl x))) + (else (error "can't turn into a uri" x)))) + +(define (ensure-uri-reference x) + (cond + ((uri? x) x) + ((string? x) + (build-uri-reference #:path x)) + ((list? x) + (ensure-uri-reference (relurl x))) (else (error "can't turn into a uri" x)))) (define* (respond #:optional body #:key @@ -88,7 +98,7 @@ (values (build-response #:code status #:headers (build-headers - location (and=> redirect ensure-public-uri) + location (and=> redirect ensure-uri-reference) last-modified last-modified content-type (cons content-type content-type-params) date (current-date) @@ -377,7 +387,7 @@ (define (atom-header last-modified) (define (relurl . tail) - (uri->string (ensure-public-uri tail))) + (uri->string (ensure-uri tail))) `(feed (@ (xmlns "http://www.w3.org/2005/Atom") (xml:base ,(relurl))) (title (@ (type "text")) ,*title*) @@ -396,7 +406,7 @@ (define (atom-entry post) (define (relurl . tail) - (uri->string (ensure-public-uri tail))) + (uri->string (ensure-uri tail))) `(entry (author (name ,*name*) (uri ,(relurl))) (title (@ (type "text")) ,(post-title post))