[closure-cvs] CVS closure/src/net

[dlichteblau]

Update of /project/closure/cvsroot/closure/src/net
In directory clnet:/tmp/cvs-serv13003/src/net

Modified Files:
	http.lisp 
Log Message:

Use the ZIP library instead of run-shell-command for the zip:// protocol.


--- /project/closure/cvsroot/closure/src/net/http.lisp	2007/01/02 13:13:03	1.11
+++ /project/closure/cvsroot/closure/src/net/http.lisp	2007/01/02 14:30:11	1.12
@@ -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