[bknr-cvs] hans changed trunk/

BKNR Commits bknr at bknr.net
Tue Sep 23 19:26:11 UTC 2008


Revision: 3949
Author: hans
URL: http://bknr.net/trac/changeset/3949

Implement :filename-separator for directory-handler.  If specified,
the handler can concatenate multiple files.  The file names need
to be separated by the given separator (string or character).  The
handler requires that all files are of the same type (as determined
by pathname-type).  The last-modified HTTP header will be set to
the maximum file-write-date of the files concatenated.  All files
specified must exist, otherwise the handler will generate an error.
The path may never contain ".." as a security measure.

This is meant to be used to concatenate Javascript and CSS files in
order to minimize the number of browser-server interactions.

U   trunk/bknr/web/src/web/handlers.lisp
U   trunk/projects/quickhoney/src/webserver.lisp
U   trunk/projects/quickhoney/website/templates/index.xml

Modified: trunk/bknr/web/src/web/handlers.lisp
===================================================================
--- trunk/bknr/web/src/web/handlers.lisp	2008-09-22 23:41:05 UTC (rev 3948)
+++ trunk/bknr/web/src/web/handlers.lisp	2008-09-23 19:26:10 UTC (rev 3949)
@@ -447,27 +447,78 @@
 
 (defclass directory-handler (cachable-handler prefix-handler)
   ((destination :initarg :destination
-		:reader page-handler-destination))
+		:reader page-handler-destination)
+   (filename-separator :initarg :filename-separator
+                       :reader directory-handler-filename-separator
+                       :initform nil))
   (:documentation
    "Handler for a directory in the file system.  Publishes all files
-in the directory DESTINATION under their relative path name."))
+in the directory DESTINATION under their relative path name.  Multiple
+files can be served in one request by separating their relative file
+names using the ampersand sign."))
 
-(defgeneric request-relative-pathname (directory-handler)
-  (:documentation "Return the relative pathname for the current
-request as determined by DIRECTORY-HANDLER.")
-  (:method ((handler directory-handler))
-    (or (aux-request-value 'request-relative-pathname)
-        (setf (aux-request-value 'request-relative-pathname)
-              (pathname (subseq (script-name*) (1+ (length (page-handler-prefix handler)))))))))
+(define-condition directory-handler-error (error)
+  ((pathnames-argument :initarg :pathnames-argument))
+  (:report (lambda (e stream)
+             (format stream "~A while processing pathnames argument ~A"
+                     (class-name (class-of e)) (slot-value e 'pathnames-argument)))))
 
+(define-condition invalid-pathname-syntax (directory-handler-error) ())
+(define-condition non-matching-filetypes-in-combination (directory-handler-error) ())
+(define-condition files-not-found (directory-handler-error)
+  ((files :initarg :files))
+  (:report (lambda (e stream)
+             (format stream "~A while processing pathnames argument ~A, file~:P ~S could not be found"
+                     (class-name (class-of e))
+                     (slot-value e 'pathnames-argument)
+                     (slot-value e 'files)))))
+
+(defun request-relative-pathnames (handler)
+  "Return the relative pathnames for the current request as determined
+by DIRECTORY-HANDLER.  Caches the list of validated relative pathnames
+in the aux-request-value 'request-relative-pathnames."
+  (or (aux-request-value 'request-relative-pathnames)
+      (setf (aux-request-value 'request-relative-pathnames)
+            (let* ((pathnames-argument (subseq (script-name*) (1+ (length (page-handler-prefix handler))))))
+              (when (or (search ".." pathnames-argument)
+                        (eql #\/ (aref pathnames-argument 0)))
+                (error 'invalid-pathname-syntax :pathnames-argument pathnames-argument))
+              (let* ((*default-pathname-defaults* (page-handler-destination handler))
+                     (filenames (if (directory-handler-filename-separator handler)
+                                    (mapcar #'pathname (split (directory-handler-filename-separator handler)
+                                                              pathnames-argument))
+                                    pathnames-argument))
+                     (types (mapcar #'pathname-type filenames)))
+                (unless (every #'equal types (cdr types))
+                  (error 'non-matching-filetypes-in-combination :pathnames-argument pathnames-argument))
+                (unless (every #'probe-file filenames)
+                  (error 'files-not-found
+                         :pathnames-argument pathnames-argument
+                         :files (remove-if #'probe-file filenames)))
+                filenames)))))
+
 (defmethod handler-matches-p ((handler directory-handler))
   (and (call-next-method)
-       (probe-file (merge-pathnames (request-relative-pathname handler)
-				    (page-handler-destination handler)))))
+       (let ((*default-pathname-defaults* (page-handler-destination handler)))
+         (some #'probe-file (request-relative-pathnames handler)))))
 
 (defmethod handle ((handler directory-handler))
-  (handle-static-file (merge-pathnames (request-relative-pathname handler)
-				       (page-handler-destination handler))))
+  (let* ((*default-pathname-defaults* (page-handler-destination handler))
+         (last-modified (reduce #'max (mapcar #'file-write-date (request-relative-pathnames handler)))))
+    (handle-if-modified-since last-modified)
+    (let (open-files)
+      (unwind-protect
+           (progn
+             (dolist (pathname (request-relative-pathnames handler))
+               (push (open pathname :element-type '(unsigned-byte 8)) open-files))
+             (setf (header-out :content-type) (or (mime-type (first (request-relative-pathnames handler)))
+                                                  "application/octet-stream")
+                   (header-out :last-modified) (rfc-1123-date last-modified)
+                   (header-out :content-length) (reduce #'+ (mapcar #'file-length open-files)))
+             (let ((out (send-headers)))
+               (dolist (open-file (nreverse open-files))
+                 (copy-stream open-file out))))
+        (mapcar #'close open-files)))))
 
 (defclass file-handler (page-handler)
   ((destination :initarg :destination
@@ -538,6 +589,7 @@
     (handle-object-form handler action object)))
 
 (defmethod handle-object-form ((handler edit-object-handler) action (object (eql nil)))
+  (declare (ignore action))
   (with-bknr-page (:title "No such object")
     (html "No such object, ieeeh")))
 
@@ -573,6 +625,7 @@
 
 (defgeneric object-date-list-handler-date (handler object)
   (:method ((handler object-date-list-handler) object)
+    (declare (ignore object))
     (with-query-params (date)
       (get-daytime (if date
                        (or (parse-integer date :junk-allowed t)

Modified: trunk/projects/quickhoney/src/webserver.lisp
===================================================================
--- trunk/projects/quickhoney/src/webserver.lisp	2008-09-22 23:41:05 UTC (rev 3948)
+++ trunk/projects/quickhoney/src/webserver.lisp	2008-09-23 19:26:10 UTC (rev 3949)
@@ -41,7 +41,8 @@
 					user
 					images
 					("/static" directory-handler
-					 :destination ,(merge-pathnames #p"static/" *website-directory*))
+					 :destination ,(merge-pathnames #p"static/" *website-directory*)
+                                         :filename-separator #\,)
 					("/MochiKit" directory-handler
 					 :destination ,(merge-pathnames #p"static/MochiKit/" *website-directory*))
 					("/favicon.ico" file-handler

Modified: trunk/projects/quickhoney/website/templates/index.xml
===================================================================
--- trunk/projects/quickhoney/website/templates/index.xml	2008-09-22 23:41:05 UTC (rev 3948)
+++ trunk/projects/quickhoney/website/templates/index.xml	2008-09-23 19:26:10 UTC (rev 3949)
@@ -7,17 +7,9 @@
    xmlns:quickhoney="http://quickhoney.com/">
   <head>
     <meta name="verify-v1" content="0lfE42KxaTLpCzUEkuTA7V2a9Ojdwk9BG2XSaZGPaoA=" />
-    <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css" />
-    <link rel="stylesheet" href="/static/quickhoney.css" />
-    <link rel="stylesheet" href="/static/index.css" />
-    <link rel="stylesheet" href="/static/ydsf.css" />
+    <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css,quickhoney.css,index.css,ydsf.css" />
     <link rel="alternate" type="application/rss+xml" title="RSS Feed" href="/rss/quickhoney" />
-    <script src="/static/detectplugins.js" type="text/javascript"> </script> 
-    <script src="/static/AC_QuickTime.js" type="text/javascript"> </script> 
-    <script src="/MochiKit/MochiKit.js" type="text/javascript"> </script> 
-    <script src="/static/javascript.js" type="text/javascript"> </script> 
-    <script src="/static/yui/yahoo-dom-event/yahoo-dom-event.js" type="text/javascript"> </script>
-    <script src="/static/yui/animation/animation-min.js" type="text/javascript"> </script>
+    <script src="/static/detectplugins.js,AC_QuickTime.js,MochiKit/MochiKit.js,yui/yahoo-dom-event/yahoo-dom-event.js,yui/animation/animation-min.js,javascript.js" type="text/javascript"> </script>
     <title>QuickHoney</title>
   </head>
 




More information about the Bknr-cvs mailing list