Support for embedded file blobs
authorMatthew Mondor <mmondor@pulsar-zone.net>
Wed, 26 Sep 2012 09:44:42 +0000 (09:44 +0000)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Wed, 26 Sep 2012 09:44:42 +0000 (09:44 +0000)
mmsoftware/cl/server/GNUmakefile
mmsoftware/cl/server/const-file.lisp
mmsoftware/cl/server/embedded-files.lisp [new file with mode: 0644]

index b14ef89..c7ed844 100644 (file)
@@ -1,4 +1,4 @@
-MODULES := character dlist syslog ecl-mp-server html httpd
+MODULES := character dlist syslog ecl-mp-server html const-file embedded-files httpd
 FASLS := $(addsuffix .fas,$(MODULES))
 OBJECTS := $(addsuffix .o,$(MODULES))
 
@@ -12,6 +12,8 @@ BINARY := crow-httpd
 
 all: $(ARCHIVE) $(BINARY)
 
+embedded-files.fas: htdocs/crow-httpd-logo.png htdocs/crow-httpd.css htdocs/valid-xhtml.png
+
 $(ARCHIVE): $(FASLS) $(APPLICATIONS)
        tar czvf $(ARCHIVE) $(FASLS) $(APPLICATIONS) $(CONFIGS)
 
index 4184416..ced56b3 100644 (file)
@@ -38,7 +38,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (in-package :const-file)
 
 (defparameter *rcsid*
-  "$Id: const-file.lisp,v 1.2 2012/09/26 03:19:33 mmondor Exp $")
+  "$Id: const-file.lisp,v 1.3 2012/09/26 09:44:42 mmondor Exp $")
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -47,36 +47,37 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     (type "" :type string :read-only t)
     (data nil :type (simple-array (unsigned-byte 8) *) :read-only t)))
 
-(defmacro const-file-embed (symbol mime-type file-path)
-  "Macro to easily embed the file at FILE-PATH of type MIME-TYPE into the
+(eval-when (:compile-toplevel :load-toplevel)
+  (defun const-file-embed-gen (symbol mime-type file-path)
+    "Macro to easily embed the file at FILE-PATH of type MIME-TYPE into the
 current compiled Lisp module and bind the symbol SYMBOL to a structure of
 type CONST-FILE holding the type and byte-specialized vector to its data.
 As this uses ECL C inline features, it may only be used in files to be
 compiled, not in interpreted byte-code."
-  (with-open-file (file-stream file-path
-                              :direction :input
-                              :element-type '(unsigned-byte 8))
-    (let* ((c-symbol-name (string (gensym "const_file_")))
-          (file-length (file-length file-stream))
-          (file-data (with-output-to-string (string-stream)
-                       (loop
-                          repeat file-length
-                          for byte = (read-byte file-stream)
-                          do
+    (with-open-file (file-stream file-path
+                                :direction :input
+                                :element-type '(unsigned-byte 8))
+      (let* ((c-symbol-name (string (gensym "const_file_")))
+            (file-length (file-length file-stream))
+            (file-data (with-output-to-string (string-stream)
+                         (loop
+                            repeat file-length
+                            for byte = (read-byte file-stream)
+                            do
                             (format string-stream " 0x~2,'0X," byte))))
-          (file-data-length (length file-data)))
-      (when (> file-data-length 0)
-       (setf (char file-data (1- file-data-length)) #\Space))
-      `(progn
-        (ffi:clines
-         ,(format nil "~%static const uint8_t ~A[~D] = {~A};~%"
-                  c-symbol-name file-length file-data))
-        (defvar ,symbol
-          (make-const-file :type ,(string-downcase (string mime-type))
-                           :data
-                           (ffi:c-inline () () :object
-                                         ,(format nil
-                                                  "
+            (file-data-length (length file-data)))
+       (when (> file-data-length 0)
+         (setf (char file-data (1- file-data-length)) #\Space))
+       `(progn
+          (ffi:clines
+           ,(format nil "~%static const uint8_t ~A[~D] = {~A};~%"
+                    c-symbol-name file-length file-data))
+          (defvar ,symbol
+            (make-const-file :type ,(string-downcase (string mime-type))
+                             :data
+                             (ffi:c-inline () () :object
+                                           ,(format nil
+                                                    "
 {
        cl_object       vector;
 
@@ -87,12 +88,18 @@ compiled, not in interpreted byte-code."
 
        @(return) = vector;
 }"
-                                                  c-symbol-name
-                                                  file-length)
-                                         :one-liner nil
-                                         :side-effects t))
-          ,(let ((name (pathname-name file-path))
-                 (type (pathname-type file-path)))
-                (concatenate 'string "Embedded file \""
-                             name (if type "." nil) type "\"")))
-        (export ',symbol)))))
+                                                    c-symbol-name
+                                                    file-length)
+                                           :one-liner nil
+                                           :side-effects t))
+            ,(let ((name (pathname-name file-path))
+                   (type (pathname-type file-path)))
+                  (concatenate 'string "Embedded file \""
+                               name (if type "." nil) type "\"")))
+          (export ',symbol))))))
+
+(defmacro const-file-embed (list)
+  `(progn
+     ,@(loop
+         for item in list
+         collect (apply #'const-file-embed-gen item))))
diff --git a/mmsoftware/cl/server/embedded-files.lisp b/mmsoftware/cl/server/embedded-files.lisp
new file mode 100644 (file)
index 0000000..2ce64ef
--- /dev/null
@@ -0,0 +1,25 @@
+(declaim (optimize (speed 3) (safety 1) (debug 3)))
+
+(eval-when (:compile-toplevel #-:mm-ecl-standalone :load-toplevel)
+  (load "const-file"))
+
+(defpackage :embedded-files
+  (:use :cl :const-file))
+
+(in-package :embedded-files)
+
+(defparameter *rcsid*
+  "$Id: embedded-files.lisp,v 1.1 2012/09/26 09:44:42 mmondor Exp $")
+
+
+(const-file-embed ((*crow-httpd-logo-png*
+                   "image/png"
+                   "htdocs/crow-httpd-logo.png")
+
+                  (*crow-httpd-css*
+                   "text/css"
+                   "htdocs/crow-httpd.css")
+
+                  (*valid-xhtml-png*
+                   "image/png"
+                   "htdocs/valid-xhtml.png")))