diff --git a/examples/cl-repl/app.asd b/examples/cl-repl/app.asd index 3d09f44..a5de27b 100644 --- a/examples/cl-repl/app.asd +++ b/examples/cl-repl/app.asd @@ -1,6 +1,8 @@ (defsystem :app :serial t - :depends-on (:cl-ppcre) + :depends-on (#-:depends-loaded :cl-ppcre + #-:depends-loaded :s-http-server + #-:depends-loaded :zip) :components ((:file "lisp/package") (:file "lisp/ui-vars") (:file "lisp/qt") @@ -17,6 +19,7 @@ (:file "lisp/curl") (:file "lisp/dialogs") (:file "lisp/editor") + (:file "lisp/upload-download") (:file "lisp/ini") (:file "lisp/main"))) diff --git a/examples/cl-repl/lisp/editor.lisp b/examples/cl-repl/lisp/editor.lisp index 1f893d9..f67cdd9 100644 --- a/examples/cl-repl/lisp/editor.lisp +++ b/examples/cl-repl/lisp/editor.lisp @@ -679,6 +679,10 @@ "(progn (qml:q! |clear| ui:*output-model*) (values))") ((cmd "*") (format nil "(progn~% (editor::set-clipboard-text (prin1-to-string *))~% *)")) + ((cmd ":w") + "(s-http-server:start)") + ((cmd ":ws") + "(s-http-server:stop)") ((x:starts-with ":? " text*) (format nil "(editor:find-text ~S)" (subseq text* #.(length ":? "))))))) (setf *ex-cmd* cmd) diff --git a/examples/cl-repl/lisp/upload-download.lisp b/examples/cl-repl/lisp/upload-download.lisp new file mode 100644 index 0000000..9166f1b --- /dev/null +++ b/examples/cl-repl/lisp/upload-download.lisp @@ -0,0 +1,116 @@ +;;; web server handler + +(in-package :s-http-server) + +(defvar *web-server* nil) + +(defconstant +buffer-length+ 8192) + +(defvar *empty-line* #.(map 'vector 'char-code (list #\Return #\Linefeed + #\Return #\Linefeed))) + +(defun form-data-filename (data start end) + "Searches for 'filename=' in current form data field header." + (let ((p1 (search #.(x:string-to-bytes "filename=\"") + data :start2 start :end2 end))) + (when p1 + (incf p1 #.(length "filename=\"")) + (x:bytes-to-string + (subseq data p1 (position #.(char-code #\") data :start p1)))))) + +(defun save-file (stream content-length boundary) + "Saves uploaded file(s) under 'uploads/'. Requires 'multipart/form-data'." + ;; read all data into a buffer first + (let* ((content (make-array 0 :element-type '(unsigned-byte 8) :adjustable t)) + (boundary-length (length boundary)) + (start (+ boundary-length 2))) + (loop :with buffer = (make-array +buffer-length+ :element-type '(unsigned-byte 8)) + :for index = 0 :then (+ index pos) + ;; don't read past end, would block http connection + :for pos = (read-sequence buffer stream :end (min +buffer-length+ + (- content-length index))) + do (adjust-array content (+ index pos)) + (replace content buffer :start1 index :end2 pos) + :while (< index content-length)) + ;; loop through all form-data and save file(s) + (x:while-it (search boundary content :start2 start) + (let ((filename (form-data-filename content (+ start 2) (- x:it 2)))) + (unless (x:empty-string filename) + (let ((pathname (merge-pathnames (x:cc "uploads/" filename)))) + (ensure-directories-exist pathname) + (with-open-file (out pathname :direction :output :if-exists :supersede + :element-type '(unsigned-byte 8)) + (write-sequence (subseq content + (+ 4 (search *empty-line* content :start2 start)) + (- x:it 4)) + out))))) + (setf start (incf x:it boundary-length))))) + +(defun ensure-multipart/form-data (headers) + "Searches headers for 'multipart/form-data' and returns its boundary string." + (let ((content-type (cdr (assoc :content-type headers)))) + (when (search "multipart/form-data" content-type) + (x:string-to-bytes + (subseq content-type (+ (search "boundary=" content-type) + #.(length "boundary="))))))) + +(defun static-resource/upload-handler (s-http-server handler http-request stream) + "Hosts static resources from a document root. If the http request is POST, +it saves uploaded files on the server." + ;; slightely extended version of 's-http-server:static-resource-handler' + ;; (see 'upload' below) + (destructuring-bind (context document-root &rest options) + handler + (let* ((path (get-path http-request)) + (resource-pathname (compute-real-resource-pathname document-root path context + (or (getf options :pathname-builder) + #'make-real-resource-pathname))) + (expires-max-age (or (getf options :expires-max-age) (* 60 60)))) + (if (probe-file resource-pathname) + (progn + ;; upload + (when (eql :post (get-method http-request)) + (let* ((headers (get-headers http-request)) + (boundary (ensure-multipart/form-data headers))) + (when boundary + (save-file (get-stream (get-http-connection http-request)) + (parse-integer (cdr (assoc :content-length headers))) + boundary)))) + (logm s-http-server :debug "Serving ~s" resource-pathname) + (host-static-resource http-request stream resource-pathname :expires-max-age expires-max-age)) + (progn + (logm s-http-server :error "Failed to find ~s" resource-pathname) + (values t 404 (standard-http-html-error-response http-request stream 404 "Resource Not Found" path))))))) + +(defun start () + (let ((ini (null *web-server*))) + (when ini + (setf *web-server* (make-s-http-server))) + (start-server *web-server*) + (when ini + (register-context-handler *web-server* "/" 'static-resource/upload-handler + :arguments (list #+mobile *default-pathname-defaults* + #-mobile (merge-pathnames "www/")))))) + +(defun stop () + (stop-server *web-server*)) + +(export (list 'start 'stop)) + +;;; zip/unzip + +(in-package :qml) + +(defun zip (zip-file directory) + "Creates a *.zip file of passed directory, _not_ including the directory name." + (zip:zip (merge-pathnames zip-file) + (probe-file directory) + :if-exists :supersede)) + +(defun unzip (zip-file &optional directory) + "Extracts (previously uploaded) *.zip file." + (zip:unzip (merge-pathnames zip-file) + (probe-file (or directory ".")) + :if-exists :supersede)) + +(export (list 'zip 'unzip)) diff --git a/examples/cl-repl/make.lisp b/examples/cl-repl/make.lisp index 425f68d..5d9774f 100644 --- a/examples/cl-repl/make.lisp +++ b/examples/cl-repl/make.lisp @@ -35,6 +35,7 @@ (shell (cc "cp -r ../../../slime/src/* " to)))) (let ((lib (cc (ext:getenv #+android "ECL_ANDROID" #+ios "ECL_IOS") "/lib/ecl-*/"))) + (shell (cc "cp ../www/index.html " *assets*)) (unless (probe-file (cc *assets* "encodings")) (shell (cc "cp " lib "*.doc " *assets*)) (shell (cc "cp -r " lib "encodings " *assets*))) diff --git a/examples/cl-repl/patch/readme.md b/examples/cl-repl/patch/readme.md new file mode 100644 index 0000000..a8484e2 --- /dev/null +++ b/examples/cl-repl/patch/readme.md @@ -0,0 +1,17 @@ + +Info +---- + +This is a small patch to make `:zip` from Quicklisp work with ECL (or any CL +implementation, for that matter). + +It uses a trivial approach by simply applying a stat of `644` for files, and +`775` for directories (that is, files with a `pathname-type` of `NIL`). + + + +HowTo +----- + +Copy project `:zip` from Quicklisp to `~/quicklisp/local-projects/` and patch +file `zip.lisp` according to `zip.diff`. diff --git a/examples/cl-repl/patch/zip.diff b/examples/cl-repl/patch/zip.diff new file mode 100644 index 0000000..e3f4b7a --- /dev/null +++ b/examples/cl-repl/patch/zip.diff @@ -0,0 +1,18 @@ +diff --git a/zip.lisp.orig b/zip.lisp +index a2f3768..cb1d76a 100644 +--- a/zip.lisp.orig ++++ b/zip.lisp +@@ -15,8 +15,12 @@ + #o640 + #-(or windows mswindows) + (progn +- #-(or sbcl allegro ccl) ++ #-(or ecl sbcl allegro ccl) + (error "ZIP::FILE-MODE not ported") ++ #+ecl ++ (if (pathname-type pathname) ++ #o644 ++ #o775) + #+ccl + (multiple-value-bind (win mode size mtime inode uid blocksize rmtime gid dev) + (ccl::%stat (ccl:native-translated-namestring pathname)) diff --git a/examples/cl-repl/qml/ext/Help.qml b/examples/cl-repl/qml/ext/Help.qml index f1d4c86..19f0623 100644 --- a/examples/cl-repl/qml/ext/Help.qml +++ b/examples/cl-repl/qml/ext/Help.qml @@ -45,6 +45,12 @@ Rectangle { :kkill eval thread (long running task) + + :wstart local web-server for file upload/download, see http://192.168.1.x:1701/ + + + :wsstop local web-server + double SPCauto completion, e.g. m-v-b diff --git a/examples/cl-repl/readme.md b/examples/cl-repl/readme.md index c25780a..7d20616 100644 --- a/examples/cl-repl/readme.md +++ b/examples/cl-repl/readme.md @@ -11,6 +11,10 @@ $ ./copy.sh cl-repl See also [../../slime/src/readme-sources](../../slime/src/readme-sources.md) for installing the Slime sources where this example can find them. +**Important**: you need to patch library `:zip` from Quicklisp, so copy it in +your `~/quicklisp/local-projects/` directory, and apply this +[patch/zip.diff](patch/zip.diff). + Info @@ -77,6 +81,46 @@ if they are in the same WiFi and point to the same desktop IP. +File exchange over WiFi (mobile only) +------------------------------------- + +A simple web-server is integrated here for both downloading saved files to a +desktop computer, or uploading them to the mobile device. + +To start the web-server, enter `:w` in the command line. It will point to the +`[Home]` directory (`[Home]/Documents/` on iOS). + +### Upload + +Enter the IP of your mobile device in the desktop browser, using `1701` as +port (mind the trailing `/`): +``` +http://192.168.1.x:1701/ +``` +Now you can upload either a whole directory, or a single file. The files will +be stored in `[Home]/uploads/` (`[Home]/Documents/uploads/` on iOS). + +You may also upload a zip file, which can then be unzipped using: +``` +(unzip "uploads/all.zip" "examples/") +``` + +### Download + +First create a `*.zip` file like so: +``` +(zip "all.zip" "examples/") +``` +Note that the zip file will not contain the passed directory name (this is how +the zip library from Quicklisp is implemented). + +Now you just need to enter the path in your desktop browser, something like: +``` +http://192.168.1.x:1701/all.zip +``` + + + Important notes for mobile -------------------------- diff --git a/examples/cl-repl/run.lisp b/examples/cl-repl/run.lisp index b1b5210..aeca859 100644 --- a/examples/cl-repl/run.lisp +++ b/examples/cl-repl/run.lisp @@ -4,9 +4,15 @@ (require :asdf) +(asdf:load-system :cl-ppcre) +(asdf:load-system :s-http-server) +(asdf:load-system :zip) + (push (merge-pathnames "./") asdf:*central-registry*) +(push :depends-loaded *features*) + (asdf:operate 'asdf:load-source-op :app) (qset *quick-view* diff --git a/examples/cl-repl/www/index.html b/examples/cl-repl/www/index.html new file mode 100644 index 0000000..1d7d703 --- /dev/null +++ b/examples/cl-repl/www/index.html @@ -0,0 +1,31 @@ + + + + + + + + +

Upload files to CL REPL app

+
+

+ Whole Directory +
+ +

+

+ Single File +
+ +

+

+ +

+
+ Files are saved in [Home]/uploads/. + +