added @nginx-accel-redirect and @apache-xsendfile decorators

dym · Mar 4, 2011 · 74a25a3 · 74a25a3
1 parent 83bd8d7
commit 74a25a3
Show file tree

Hide file tree

Showing 3 changed files with 47 additions and 13 deletions.
diff --git a/src/decorators.lisp b/src/decorators.lisp
@@ -23,26 +23,49 @@
   (make-instance 'no-cache-route :target route))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Nginx X-Accel-Redirect support
+;;;; Nginx X-Accel-Redirect decorator
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass nginx-accel-redirect-route (routes:proxy-route) ())
 
+(defvar *nginx-internal-location* nil)
+(defvar *nginx-internal-alias* nil)
+(defvar *nginx-internal-root* nil)
+
+(defun concat-pathnames (path1 path2)
+  (merge-pathnames (make-pathname
+                    :directory (cons :relative
+                                     (cdr (pathname-directory path2))))
+                   (fad:pathname-as-directory path1)))
+
 (defmethod process-route ((route nginx-accel-redirect-route) bindings)
+  (unless *nginx-internal-location*
+    (error "*nginx-internal-location* is not set!"))
   (let ((result (call-next-method)))
     (cond
       ((pathnamep result)
+       (setf (hunchentoot:header-out :content-type)
+             (or (hunchentoot:mime-type result)
+                 (hunchentoot:content-type*)))
        (setf (hunchentoot:header-out :x-accel-redirect)
-             #+sbcl (sb-ext:native-namestring result)
-             #-sbcl (namestring result))
+             (or (and *nginx-internal-root*
+                      (cffi-sys:native-namestring
+                       (merge-pathnames (enough-namestring result
+                                                           (concat-pathnames *nginx-internal-root*
+                                                                             *nginx-internal-location*))
+                                        (fad:pathname-as-directory *nginx-internal-location*))))
+                 (and *nginx-internal-alias*
+                      (merge-pathnames (cffi-sys:native-namestring (enough-namestring result *nginx-internal-alias*))
+                                       *nginx-internal-location*))
+                 (error "*nginx-internal-root* or *nginx-internal-alias* should be set!")))
        "")
       (t result))))
 
 (defun @nginx-accel-redirect (origin)
   (make-instance 'nginx-accel-redirect-route :target origin))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Apache X-Sendifle support
+;;;; Apache X-Sendifle decorator
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass apache-xsendfile-route (routes:proxy-route) ())
@@ -55,8 +78,7 @@
              (or (hunchentoot:mime-type result)
                  (hunchentoot:content-type*)))
        (setf (hunchentoot:header-out :x-sendfile)
-             #+sbcl (sb-ext:native-namestring result)
-             #-sbcl (namestring result))
+             (cffi-sys:native-namestring result))
        "")
       (t result))))
 

diff --git a/src/packages.lisp b/src/packages.lisp
@@ -80,5 +80,10 @@
 
            ;; decorators
            #:@no-cache
+
            #:@nginx-accel-redirect
+           #:*nginx-internal-location*
+           #:*nginx-internal-alias*
+           #:*nginx-internal-root*
+
            #:@apache-xsendfile))
diff --git a/src/route.lisp b/src/route.lisp
@@ -9,10 +9,11 @@
 (in-package :restas)
 
 (defgeneric process-route (route bindings))
+(defgeneric route-submodule (route))
 
 (defclass route (routes:route)
   ((symbol :initarg :symbol :reader route-symbol)
-   (submodule :initarg :submodule :initform nil)
+   (submodule :initarg :submodule :initform nil :reader route-submodule)
    (required-method :initarg :required-method :initform nil :reader route-required-method)
    (arbitrary-requirement :initarg :arbitrary-requirement :initform nil :reader route-arbitrary-requirement)
    (render-method :initarg :render-method :initform #'identity)
@@ -44,18 +45,24 @@
 (defmethod routes:route-name ((route route))
   (string-downcase (write-to-string (slot-value route 'symbol))))
 
+(defmethod route-submodule ((route routes:proxy-route))
+  (route-submodule (routes:proxy-route-target route)))
+
+(defmethod process-route :around ((route routes:base-route) bindings)
+  (with-submodule (route-submodule route)
+    (call-next-method)))
+
 (defmethod process-route ((route route) bindings)
   (alexandria:doplist (name value (route-headers route))
     (setf (hunchentoot:header-out name)
           (if (functionp value)
               (funcall value)
               value)))
-  (with-submodule (slot-value route 'submodule)
-    (let ((*route* route)
-          (*bindings* bindings))
-      (render-object (route-render-method route)
-                     (catch 'route-done
-                       (funcall (slot-value route 'symbol)))))))
+  (let ((*route* route)
+        (*bindings* bindings))
+    (render-object (route-render-method route)
+                   (catch 'route-done
+                     (funcall (slot-value route 'symbol))))))
 
 (defun abort-route-handler (obj &key return-code content-type)
   (when return-code