From 5e28502d8077f16975b96e4c1a877a28af27d314 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Tue, 13 Nov 2018 14:42:55 +0100 Subject: [PATCH] update simple-httpd. Signed-off-by: Andreas Gerler --- .../simple-httpd-pkg.el | 1 - .../simple-httpd-autoloads.el | 16 +- .../simple-httpd-pkg.el | 2 + .../simple-httpd.el | 189 ++++++++++++++---- 4 files changed, 161 insertions(+), 47 deletions(-) delete mode 100644 elpa/simple-httpd-20150430.1755/simple-httpd-pkg.el rename elpa/{simple-httpd-20150430.1755 => simple-httpd-20180528.1603}/simple-httpd-autoloads.el (62%) create mode 100644 elpa/simple-httpd-20180528.1603/simple-httpd-pkg.el rename elpa/{simple-httpd-20150430.1755 => simple-httpd-20180528.1603}/simple-httpd.el (81%) diff --git a/elpa/simple-httpd-20150430.1755/simple-httpd-pkg.el b/elpa/simple-httpd-20150430.1755/simple-httpd-pkg.el deleted file mode 100644 index 70138c3b..00000000 --- a/elpa/simple-httpd-20150430.1755/simple-httpd-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "simple-httpd" "20150430.1755" "pure elisp HTTP server" '((cl-lib "0.3")) :url "https://github.com/skeeto/emacs-http-server") diff --git a/elpa/simple-httpd-20150430.1755/simple-httpd-autoloads.el b/elpa/simple-httpd-20180528.1603/simple-httpd-autoloads.el similarity index 62% rename from elpa/simple-httpd-20150430.1755/simple-httpd-autoloads.el rename to elpa/simple-httpd-20180528.1603/simple-httpd-autoloads.el index 1defc34f..a042623f 100644 --- a/elpa/simple-httpd-20150430.1755/simple-httpd-autoloads.el +++ b/elpa/simple-httpd-20180528.1603/simple-httpd-autoloads.el @@ -1,10 +1,12 @@ ;;; simple-httpd-autoloads.el --- automatically extracted autoloads ;; ;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + -;;;### (autoloads nil "simple-httpd" "simple-httpd.el" (21908 14190 -;;;;;; 0 0)) +;;;### (autoloads nil "simple-httpd" "simple-httpd.el" (0 0 0 0)) ;;; Generated autoloads from simple-httpd.el (autoload 'httpd-start "simple-httpd" "\ @@ -19,16 +21,24 @@ Stop the web server if it is currently running, otherwise do nothing. \(fn)" t nil) +(autoload 'httpd-running-p "simple-httpd" "\ +Return non-nil if the simple-httpd server is running. + +\(fn)" nil nil) + (autoload 'httpd-serve-directory "simple-httpd" "\ Start the web server with given `directory' as `httpd-root'. \(fn DIRECTORY)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "simple-httpd" '("httpd" "defservlet" "with-httpd-buffer"))) + ;;;*** ;; Local Variables: ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t +;; coding: utf-8 ;; End: ;;; simple-httpd-autoloads.el ends here diff --git a/elpa/simple-httpd-20180528.1603/simple-httpd-pkg.el b/elpa/simple-httpd-20180528.1603/simple-httpd-pkg.el new file mode 100644 index 00000000..88c9c1fe --- /dev/null +++ b/elpa/simple-httpd-20180528.1603/simple-httpd-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "simple-httpd" "20180528.1603" "pure elisp HTTP server" '((cl-lib "0.3")) :commit "49721d5b791bee0fc25b1fdd69696371d546093a" :authors '(("Christopher Wellons" . "wellons@nullprogram.com")) :maintainer '("Christopher Wellons" . "wellons@nullprogram.com") :url "https://github.com/skeeto/emacs-http-server") diff --git a/elpa/simple-httpd-20150430.1755/simple-httpd.el b/elpa/simple-httpd-20180528.1603/simple-httpd.el similarity index 81% rename from elpa/simple-httpd-20150430.1755/simple-httpd.el rename to elpa/simple-httpd-20180528.1603/simple-httpd.el index ffbc502c..07e18950 100644 --- a/elpa/simple-httpd-20150430.1755/simple-httpd.el +++ b/elpa/simple-httpd-20180528.1603/simple-httpd.el @@ -4,8 +4,8 @@ ;; Author: Christopher Wellons ;; URL: https://github.com/skeeto/emacs-http-server -;; Package-Version: 20150430.1755 -;; Version: 1.4.6 +;; Package-Version: 20180528.1603 +;; Version: 1.5.1 ;; Package-Requires: ((cl-lib "0.3")) ;;; Commentary: @@ -96,6 +96,12 @@ ;;; History: +;; Version 1.5.1: improvements +;; * Add `httpd-running-p' +;; * Properly handle "Connection: close" and HTTP/1.0 +;; Version 1.5.0: improvements +;; * Drastically improved performance for large requests +;; * More HTTP status codes ;; Version 1.4.6: fixes ;; * Added httpd-serve-directory ;; * Fix some encoding issues @@ -230,15 +236,69 @@ "File served by default when accessing a directory.") (defvar httpd-status-codes - '((200 . "OK") + '((100 . "Continue") + (101 . "Switching Protocols") + (102 . "Processing") + (200 . "OK") + (201 . "Created") + (202 . "Accepted") + (203 . "Non-authoritative Information") + (204 . "No Content") + (205 . "Reset Content") + (206 . "Partial Content") + (207 . "Multi-Status") + (208 . "Already Reported") + (226 . "IM Used") + (300 . "Multiple Choices") (301 . "Moved Permanently") (302 . "Found") (303 . "See Other") (304 . "Not Modified") + (305 . "Use Proxy") (307 . "Temporary Redirect") + (308 . "Permanent Redirect") + (400 . "Bad Request") + (401 . "Unauthorized") + (402 . "Payment Required") (403 . "Forbidden") (404 . "Not Found") - (500 . "Internal Server Error")) + (405 . "Method Not Allowed") + (406 . "Not Acceptable") + (407 . "Proxy Authentication Required") + (408 . "Request Timeout") + (409 . "Conflict") + (410 . "Gone") + (411 . "Length Required") + (412 . "Precondition Failed") + (413 . "Payload Too Large") + (414 . "Request-URI Too Long") + (415 . "Unsupported Media Type") + (416 . "Requested Range Not Satisfiable") + (417 . "Expectation Failed") + (418 . "I'm a teapot") + (421 . "Misdirected Request") + (422 . "Unprocessable Entity") + (423 . "Locked") + (424 . "Failed Dependency") + (426 . "Upgrade Required") + (428 . "Precondition Required") + (429 . "Too Many Requests") + (431 . "Request Header Fields Too Large") + (444 . "Connection Closed Without Response") + (451 . "Unavailable For Legal Reasons") + (499 . "Client Closed Request") + (500 . "Internal Server Error") + (501 . "Not Implemented") + (502 . "Bad Gateway") + (503 . "Service Unavailable") + (504 . "Gateway Timeout") + (505 . "HTTP Version Not Supported") + (506 . "Variant Also Negotiates") + (507 . "Insufficient Storage") + (508 . "Loop Detected") + (510 . "Not Extended") + (511 . "Network Authentication Required") + (599 . "Network Connect Timeout Error")) "HTTP status codes.") (defvar httpd-html @@ -286,7 +346,7 @@ instance per Emacs instance." :family httpd-ip-family :filter 'httpd--filter :filter-multibyte nil - :coding 'utf-8-unix ; *should* be ISO-8859-1 but that doesn't work + :coding 'binary :log 'httpd--log) (run-hooks 'httpd-start-hook)) @@ -299,6 +359,11 @@ instance per Emacs instance." (httpd-log `(stop ,(current-time-string))) (run-hooks 'httpd-stop-hook))) +;;;###autoload +(defun httpd-running-p () + "Return non-nil if the simple-httpd server is running." + (not (null (process-status "httpd")))) + ;;;###autoload (defun httpd-serve-directory (directory) "Start the web server with given `directory' as `httpd-root'." @@ -341,35 +406,63 @@ emacs -Q -batch -l simple-httpd.elc -f httpd-batch-start" ;; Networking code -(defun httpd--filter (proc string) +(defun httpd--connection-close-p (request) + "Return non-nil if the client requested \"connection: close\"." + (or (equal '("close") (cdr (assoc "Connection" request))) + (equal '("HTTP/1.0") (cddr (assoc "GET" request))))) + +(defun httpd--filter (proc chunk) "Runs each time client makes a request." - (setf string (concat (process-get proc :previous-string) string)) - (let* ((request (httpd-parse string)) - (content-length (cadr (assoc "Content-Length" request))) - (uri (cl-cadar request)) - (content (cadr (assoc "Content" request))) - (parsed-uri (httpd-parse-uri (concat uri))) - (uri-path (nth 0 parsed-uri)) - (uri-query (append (nth 1 parsed-uri) (httpd-parse-args content))) - (servlet (httpd-get-servlet uri-path))) - (if (and content-length - (< (string-bytes content) (string-to-number content-length))) - (process-put proc :previous-string string) - (process-put proc :previous-string nil) - (httpd-log `(request (date ,(httpd-date-string)) - (address ,(car (process-contact proc))) - (get ,uri-path) - ,(cons 'headers request))) - (if (null servlet) - (httpd--error-safe proc 404) - (condition-case error-case - (funcall servlet proc uri-path uri-query request) - (error (httpd--error-safe proc 500 error-case))))))) + (with-current-buffer (process-get proc :request-buffer) + (setf (point) (point-max)) + (insert chunk) + (let ((request (process-get proc :request))) + (unless request + (when (setf request (httpd-parse)) + (delete-region (point-min) (point)) + (process-put proc :request request))) + (when request + (let ((content-length (cadr (assoc "Content-Length" request)))) + (when (or (null content-length) + (= (buffer-size) (string-to-number content-length))) + (let* ((content (buffer-string)) + (uri (cl-cadar request)) + (parsed-uri (httpd-parse-uri (concat uri))) + (uri-path (nth 0 parsed-uri)) + (uri-query (append (nth 1 parsed-uri) + (httpd-parse-args content))) + (servlet (httpd-get-servlet uri-path))) + (erase-buffer) + (process-put proc :request nil) + (setf request (nreverse (cons (list "Content" content) + (nreverse request)))) + (httpd-log `(request (date ,(httpd-date-string)) + (address ,(car (process-contact proc))) + (get ,uri-path) + ,(cons 'headers request))) + (if (null servlet) + (httpd--error-safe proc 404) + (condition-case error-case + (funcall servlet proc uri-path uri-query request) + (error (httpd--error-safe proc 500 error-case)))) + (when (httpd--connection-close-p request) + (process-send-eof proc))))))))) (defun httpd--log (server proc message) "Runs each time a new client connects." + (with-current-buffer (generate-new-buffer " *httpd-client*") + (set-buffer-multibyte nil) + (process-put proc :request-buffer (current-buffer))) + (set-process-sentinel proc #'httpd--sentinel) (httpd-log (list 'connection (car (process-contact proc))))) +(defun httpd--sentinel (proc message) + "Runs when a client closes the connection." + (unless (string-match-p "^open " message) + (let ((buffer (process-get proc :request-buffer))) + (when buffer + (kill-buffer buffer))))) + ;; Logging (defun httpd-log (item) @@ -556,17 +649,26 @@ actually serve up files." "Destructively capitalize the components of HEADER." (mapconcat #'capitalize (split-string header "-") "-")) -(defun httpd-parse (string) - "Parse client http header into alist." - (let* ((lines (split-string string "[\n\r]+")) - (req (list (split-string (car lines)))) - (post (cadr (split-string string "\r\n\r\n")))) - (dolist (line (butlast (cdr lines))) - (push (list (httpd--normalize-header (car (split-string line ": "))) - (mapconcat #'identity - (cdr (split-string line ": ")) ": ")) req)) - (push (list "Content" post) req) - (reverse req))) +(defun httpd-parse () + "Parse HTTP header in current buffer into association list. +Leaves the point at the start of the request content. Returns nil +if it failed to parse a complete HTTP header." + (setf (point) (point-min)) + (when (looking-at "\\([^ ]+\\) +\\([^ ]+\\) +\\([^\r]+\\)\r\n") + (let ((method (match-string 1)) + (path (decode-coding-string (match-string 2) 'iso-8859-1)) + (version (match-string 3)) + (headers ())) + (setf (point) (match-end 0)) + (while (looking-at "\\([-!#-'*+.0-9A-Z^_`a-z|~]+\\): *\\([^\r]+\\)\r\n") + (setf (point) (match-end 0)) + (let ((name (match-string 1)) + (value (match-string 2))) + (push (list (httpd--normalize-header name) + (decode-coding-string value 'iso-8859-1)) headers))) + (when (looking-at "\r\n") + (setf (point) (match-end 0)) + (cons (list method path version) (nreverse headers)))))) (defun httpd-unhex (str) "Fully decode the URL encoding in STR (including +'s)." @@ -582,15 +684,16 @@ actually serve up files." (split-string argstr "&")))) (defun httpd-parse-uri (uri) - "Split a URI into it's components. In the return, the first -element is the script path, the second is an alist of -variable/value pairs, and the third is the fragment." + "Split a URI into its components. +The first element of the return value is the script path, the +second element is an alist of variable/value pairs, and the third +element is the fragment." (let ((p1 (string-match (regexp-quote "?") uri)) (p2 (string-match (regexp-quote "#") uri)) retval) (push (if p2 (httpd-unhex (substring uri (1+ p2)))) retval) (push (if p1 (httpd-parse-args (substring uri (1+ p1) p2))) retval) - (push (httpd-unhex (substring uri 0 (or p1 p2))) retval))) + (push (substring uri 0 (or p1 p2)) retval))) ;; Path handling -- 2.47.3