From 88bacfe51c4aeda97a0a2aea8d52f95893c87ca8 Mon Sep 17 00:00:00 2001
From: dlichteblau <dlichteblau>
Date: Tue, 2 Jan 2007 14:30:11 +0000
Subject: [PATCH] Use the ZIP library instead of run-shell-command for the
 zip:// protocol.

---
 INSTALL           |  7 +++++--
 closure.asd       |  4 +++-
 src/net/http.lisp | 46 ++++++++++++++++++++--------------------------
 3 files changed, 28 insertions(+), 29 deletions(-)

diff --git a/INSTALL b/INSTALL
index 5ffb89d..a68219e 100644
--- a/INSTALL
+++ b/INSTALL
@@ -17,11 +17,14 @@ Provide yourself with:
 
     [Debian package gif2png]
 
- 4. McCLIM, Closure XML, Bordeaux Threads, and their dependencies
+ 4. McCLIM, Closure XML, Bordeaux Threads, Flexi-Streams, ZIP
+    and their dependencies
 
     [ http://common-lisp.net/project/mcclim/
       http://common-lisp.net/project/cxml/
-      http://common-lisp.net/project/bordeaux-threads/ ]
+      http://common-lisp.net/project/bordeaux-threads/ 
+      http://common-lisp.net/project/zip/ 
+      http://weitz.de/flexi-streams/ ]
 
 
 Compile closure using ASDF: Register closure.asd in your central
diff --git a/closure.asd b/closure.asd
index 5eb7b59..0868176 100644
--- a/closure.asd
+++ b/closure.asd
@@ -87,7 +87,9 @@
                  :clim-clx
                  :glisp
 		 :bordeaux-threads
-		 :trivial-sockets)
+		 :trivial-sockets
+		 :zip
+		 :flexi-streams)
     :default-component-class closure-source-file
     :components
     ((:module src
diff --git a/src/net/http.lisp b/src/net/http.lisp
index 965adb5..cd7d6e4 100644
--- a/src/net/http.lisp
+++ b/src/net/http.lisp
@@ -959,39 +959,33 @@
 ;; </FUTURE>
 
 ;; Back to what is actually implemented. To read a document from within a zip
-;; archive, we simply pass the request to the `unzip' command. So you must
-;; have installed this for a working zip protocol.
+;; archive, we simply use the ZIP library.  So you must have it installed
+;; for a working zip protocol.
 
 ;; TODO
 ;;  - detect non-existing archives and non-existing archive documents.
 ;;  - when no archive file name is given, attempt to format the zip file
 ;;    directory as HTML, to be able to inspect the zip file.
-;;  - detect the non-existence of the `unzip' command and give a reasonable 
-;;    error message.
 
 (defun open-zip-document (url)
-  (multiple-value-bind (zip-archive-pathname archive-component-file-name) (split-zip-url url)
-    (cond ((null zip-archive-pathname)
-           (error "Bad zip url: ~S" url))
-          (t
-           (with-temporary-file (temp-filename)
-             (let ((res (run-unix-shell-command (format nil "unzip -p ~A ~A >~A"
-                                                        (namestring zip-archive-pathname)
-                                                        archive-component-file-name
-                                                        temp-filename))))
-               (cond ((zerop res)
-                      (values
-                       (cl-byte-stream->gstream (open temp-filename
-                                                      :direction :input
-                                                      :element-type '(unsigned-byte 8)))
-                       (list (cons "Content-Type" 
-                                   (let ((mt (find-mime-type-from-extension
-                                              (url-extension url))))
-                                     (if mt
-                                         (mime-type-name mt)
-                                       "text/plain"))))))
-                     (t
-                      (error "unzip failed on ~S" url)) )))))))
+  (multiple-value-bind (zip-archive-pathname archive-component-file-name)
+      (split-zip-url url)
+    (cond
+      ((null zip-archive-pathname)
+	(error "Bad zip url: ~S" url))
+      (t
+	(values
+	 (cl-byte-stream->gstream
+	  (flexi-streams:make-in-memory-input-stream
+	   (zip:with-zipfile (zip zip-archive-pathname)
+	     (zip:zipfile-entry-contents
+	      (zip:get-zipfile-entry archive-component-file-name zip))))) 
+	 (list (cons "Content-Type" 
+		     (let ((mt (find-mime-type-from-extension
+				(url-extension url))))
+		       (if mt
+			   (mime-type-name mt)
+			   "text/plain")))))))))
 
 (defun split-zip-url (url)
   ;; -> zip-archive-pathname ; archive-component-file-name
-- 
2.11.4.GIT