aliens/tekuti
1
0
Fork 0
Code Activity

Support for relative URIs for https + http access.

Browse source 
* tekuti/page-helpers.scm (ensure-uri): Rename from ensure-public-uri.
  A URI is absolute by definition.
  (ensure-uri-reference): New helper.  Requires git guile.
  (respond): Use ensure-URI-reference to get the reference.
  (atom-header, atom-entry): Use ensure-uri.

* tekuti/page.scm (atom-feed-from-posts): Pass the URI scheme from the
  request-uri when reconstructing

* tekuti/config.scm (*public-scheme*): New config variable, defaulting
  to http.
This commit is contained in:
Andy Wingo 2014-10-15 12:08:51 +02:00
parent c631aaf35c
commit ab54aca59f
2 changed files with 19 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
tekuti/config.scm
View file

@ -1,5 +1,5 @@
;; Tekuti
;; Copyright (C) 2008, 2010, 2012 Andy Wingo <wingo at pobox dot com>
;; Copyright (C) 2008, 2010, 2012, 2014 Andy Wingo <wingo at pobox dot com>
;; 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* '())

22
tekuti/page-helpers.scm
View file

@ -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))