archimag / restas

Common Lisp web framework
http://restas.lisper.ru/
Other
257 stars 50 forks source link

Fix for gen-full-url uri scheme #9

Open bahollis opened 12 years ago

bahollis commented 12 years ago

I have prepared a small patch that fixes the assumption that all urls use the :http uri scheme

From 8deaa520518d8c24e4fb140929d36c3e90ac9fd3 Mon Sep 17 00:00:00 2001
From: Brian Hollis <b.a.hollis@gmail.com>
Date: Sun, 26 Feb 2012 01:11:22 -0600
Subject: [PATCH] Modified gen-full-url to detect bound ssl acceptor and set
 uri scheme accordingly.

---
 src/route.lisp |   14 ++++++++------
 1 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/src/route.lisp b/src/route.lisp
index 6c3cea1..a4fe5c6 100644
--- a/src/route.lisp
+++ b/src/route.lisp
@@ -211,12 +211,14 @@
                                        (submodule-full-baseurl *submodule*)
                                        (route-symbol-template route))
                           args)))
-    (setf (puri:uri-scheme uri)
-          :http)
-    (setf (puri:uri-host uri)
-          (if (boundp 'hunchentoot:*request*)
-                      (hunchentoot:host)
-                      "localhost"))
+
+    (if (boundp 'hunchentoot:*request*)
+       (setf (puri:uri-scheme uri) (if (hunchentoot:ssl-p) :https :http)
+             (puri:uri-host uri) (hunchentoot:host))
+
+       (setf (puri:uri-scheme uri) :http
+             (puri:uri-host uri) "localhost"))
+
     (puri:render-uri uri nil)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--
1.7.6.4