diff options
Diffstat (limited to 'elpa/simple-httpd-20191103.1446')
-rw-r--r-- | elpa/simple-httpd-20191103.1446/simple-httpd-autoloads.el | 38 | ||||
-rw-r--r-- | elpa/simple-httpd-20191103.1446/simple-httpd-pkg.el | 2 | ||||
-rw-r--r-- | elpa/simple-httpd-20191103.1446/simple-httpd.el | 904 | ||||
-rw-r--r-- | elpa/simple-httpd-20191103.1446/simple-httpd.elc | bin | 25989 -> 0 bytes |
4 files changed, 0 insertions, 944 deletions
diff --git a/elpa/simple-httpd-20191103.1446/simple-httpd-autoloads.el b/elpa/simple-httpd-20191103.1446/simple-httpd-autoloads.el deleted file mode 100644 index e545936..0000000 --- a/elpa/simple-httpd-20191103.1446/simple-httpd-autoloads.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; simple-httpd-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "simple-httpd" "simple-httpd.el" (0 0 0 0)) -;;; Generated autoloads from simple-httpd.el - -(autoload 'httpd-start "simple-httpd" "\ -Start the web server process. If the server is already -running, this will restart the server. There is only one server -instance per Emacs instance." t nil) - -(autoload 'httpd-stop "simple-httpd" "\ -Stop the web server if it is currently running, otherwise do nothing." t nil) - -(autoload 'httpd-running-p "simple-httpd" "\ -Return non-nil if the simple-httpd server is running." nil nil) - -(autoload 'httpd-serve-directory "simple-httpd" "\ -Start the web server with given `directory' as `httpd-root'. - -\(fn DIRECTORY)" t nil) - -(register-definition-prefixes "simple-httpd" '("defservlet" "httpd" "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-20191103.1446/simple-httpd-pkg.el b/elpa/simple-httpd-20191103.1446/simple-httpd-pkg.el deleted file mode 100644 index ed8ad78..0000000 --- a/elpa/simple-httpd-20191103.1446/simple-httpd-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from simple-httpd.el -*- no-byte-compile: t -*- -(define-package "simple-httpd" "20191103.1446" "pure elisp HTTP server" '((cl-lib "0.3")) :commit "22ce66ea43e0eadb9ec1d691a35d9695fc29cee6" :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-20191103.1446/simple-httpd.el b/elpa/simple-httpd-20191103.1446/simple-httpd.el deleted file mode 100644 index fcdc33f..0000000 --- a/elpa/simple-httpd-20191103.1446/simple-httpd.el +++ /dev/null @@ -1,904 +0,0 @@ -;;; simple-httpd.el --- pure elisp HTTP server - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons <wellons@nullprogram.com> -;; URL: https://github.com/skeeto/emacs-http-server -;; Package-Version: 20191103.1446 -;; Package-Commit: 22ce66ea43e0eadb9ec1d691a35d9695fc29cee6 -;; Version: 1.5.1 -;; Package-Requires: ((cl-lib "0.3")) - -;;; Commentary: - -;; Use `httpd-start' to start the web server. Files are served from -;; `httpd-root' on port `httpd-port' using `httpd-ip-family' at host -;; `httpd-host'. While the root can be changed at any time, the server -;; needs to be restarted in order for a port change to take effect. - -;; Everything is performed by servlets, including serving -;; files. Servlets are enabled by setting `httpd-servlets' to true -;; (default). Servlets are four-parameter functions that begin with -;; "httpd/" where the trailing component specifies the initial path on -;; the server. For example, the function `httpd/hello-world' will be -;; called for the request "/hello-world" and "/hello-world/foo". - -;; The default servlet `httpd/' is the one that serves files from -;; `httpd-root' and can be turned off through redefinition or setting -;; `httpd-serve-files' to nil. It is used even when `httpd-servlets' -;; is nil. - -;; The four parameters for a servlet are process, URI path, GET/POST -;; arguments (alist), and the full request object (header -;; alist). These are ordered by general importance so that some can be -;; ignored. Two macros are provided to help with writing servlets. - -;; * `with-httpd-buffer' -- Creates a temporary buffer that is -;; automatically served to the client at the end of the body. -;; Additionally, `standard-output' is set to this output -;; buffer. For example, this servlet says hello, - -;; (defun httpd/hello-world (proc path &rest args) -;; (with-httpd-buffer proc "text/plain" -;; (insert "hello, " (file-name-nondirectory path)))) - -;; This servlet be viewed at http://localhost:8080/hello-world/Emacs - -;; * `defservlet' -- Similar to the above macro but totally hides the -;; process object from the servlet itself. The above servlet can be -;; re-written identically like so, - -;; (defservlet hello-world text/plain (path) -;; (insert "hello, " (file-name-nondirectory path))) - -;; Note that `defservlet' automatically sets `httpd-current-proc'. See -;; below. - -;; The "function parameters" part can be left empty or contain up to -;; three parameters corresponding to the final three servlet -;; parameters. For example, a servlet that shows *scratch* and doesn't -;; need parameters, - -;; (defservlet scratch text/plain () -;; (insert-buffer-substring (get-buffer-create "*scratch*"))) - -;; A higher level macro `defservlet*' wraps this lower-level -;; `defservlet' macro, automatically binding variables to components -;; of the request. For example, this binds parts of the request path -;; and one query parameter. Request components not provided by the -;; client are bound to nil. - -;; (defservlet* packages/:package/:version text/plain (verbose) -;; (insert (format "%s\n%s\n" package version)) -;; (princ (get-description package version)) -;; (when verbose -;; (insert (format "%S" (get-dependencies package version))))) - -;; It would be accessed like so, - -;; http://example.com/packages/foobar/1.0?verbose=1 - -;; Some support functions are available for servlets for more -;; customized responses. - -;; * `httpd-send-file' -- serve a file with proper caching -;; * `httpd-redirect' -- redirect the browser to another url -;; * `httpd-send-header' -- send custom headers -;; * `httpd-error' -- report an error to the client -;; * `httpd-log' -- log an object to *httpd* - -;; Some of these functions require a process object, which isn't -;; passed to `defservlet' servlets. Use t in place of the process -;; argument to use `httpd-current-proc' (like `standard-output'). - -;; If you just need to serve static from some location under some -;; route on the server, use `httpd-def-file-servlet'. It expands into -;; a `defservlet' that serves files. - -;;; 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 -;; Version 1.4.5: fixes -;; * Update to cl-lib from cl -;; Version 1.4.4: features -;; * Common Lisp &key-like defservlet* argument support -;; * Fix up some defservlet* usage warnings. -;; Version 1.4.3: features -;; * Add `httpd-discard-buffer' -;; * Add `httpd-def-file-servlet' -;; * Be more careful about not sending extra headers -;; Version 1.4.2: features, fixes -;; * `defservlet*' macro -;; Version 1.4.1: small bug fixes, one feature -;; * All mime-type parameters now accept string designators -;; * Documentation update -;; Version 1.4.0: features, API change, and fixes -;; * Removed httpd-send-buffer; httpd-send-header now does this implicitly -;; * httpd-send-header now accepts keywords instead -;; * Fix httpd-clean-path in Windows -;; * Fix a content-length bug -;; * defservlet fontification -;; Version 1.3.1: features and fixes -;; * Set `standard-output' in `with-httpd-buffer' -;; Version 1.3.0: security fix -;; * Fix path expansion security issue -;; * Fix coding system (don't default) -;; Version 1.2.4: fixes -;; * Handle large POSTs -;; * Fix date strings - -;;; Code: - -(require 'cl-lib) -(require 'pp) -(require 'url-util) - -(defgroup simple-httpd nil - "A simple web server." - :group 'comm) - -(defcustom httpd-ip-family 'ipv4 - "Web server IP family used by `make-network-process'." - :group 'simple-httpd - :type 'symbol) - -(defcustom httpd-host nil - "Web server host name used by `make-network-process'." - :group 'simple-httpd - :type '(choice (const nil) (const local) string)) - -(defcustom httpd-port 8080 - "Web server port." - :group 'simple-httpd - :type 'integer) - -(defcustom httpd-root "~/public_html" - "Web server file root." - :group 'simple-httpd - :type 'directory) - -(defcustom httpd-serve-files t - "Enable serving files from `httpd-root'." - :group 'simple-httpd - :type 'boolean) - -(defcustom httpd-listings t - "If true, serve directory listings." - :group 'simple-httpd - :type 'boolean) - -(defcustom httpd-servlets t - "Enable servlets." - :group 'simple-httpd - :type 'boolean) - -(defcustom httpd-show-backtrace-when-error nil - "If true, show backtrace on error page." - :group 'simple-httpd - :type 'boolean) - -(defcustom httpd-start-hook nil - "Hook to run when the server has started." - :group 'simple-httpd - :type 'hook) - -(defcustom httpd-stop-hook nil - "Hook to run when the server has stopped." - :group 'simple-httpd - :type 'hook) - -(defvar httpd-server-name (format "simple-httpd (Emacs %s)" emacs-version) - "String to use in the Server header.") - -(defvar httpd-mime-types - '(("png" . "image/png") - ("gif" . "image/gif") - ("jpg" . "image/jpeg") - ("jpeg" . "image/jpeg") - ("tif" . "image/tif") - ("tiff" . "image/tiff") - ("ico" . "image/x-icon") - ("svg" . "image/svg+xml") - ("css" . "text/css; charset=utf-8") - ("htm" . "text/html; charset=utf-8") - ("html" . "text/html; charset=utf-8") - ("xml" . "text/xml; charset=utf-8") - ("rss" . "text/xml; charset=utf-8") - ("atom" . "text/xml; charset=utf-8") - ("txt" . "text/plain; charset=utf-8") - ("el" . "text/plain; charset=utf-8") - ("js" . "text/javascript; charset=utf-8") - ("md" . "text/x-markdown; charset=utf-8") - ("gz" . "application/octet-stream") - ("ps" . "application/postscript") - ("eps" . "application/postscript") - ("pdf" . "application/pdf") - ("tar" . "application/x-tar") - ("zip" . "application/zip") - ("mp3" . "audio/mpeg") - ("wav" . "audio/x-wav") - ("flac" . "audio/flac") - ("spx" . "audio/ogg") - ("oga" . "audio/ogg") - ("ogg" . "audio/ogg") - ("ogv" . "video/ogg") - ("mp4" . "video/mp4") - ("mkv" . "video/x-matroska") - ("webm" . "video/webm")) - "MIME types for headers.") - -(defvar httpd-indexes - '("index.html" - "index.htm" - "index.xml") - "File served by default when accessing a directory.") - -(defvar httpd-status-codes - '((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") - (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 - '((403 . "<!DOCTYPE html> -<html><head> -<title>403 Forbidden</title> -</head><body> -<h1>Forbidden</h1> -<p>The requested URL is forbidden.</p> -<pre>%s</pre> -</body></html>") - (404 . "<!DOCTYPE html> -<html><head> -<title>404 Not Found</title> -</head><body> -<h1>Not Found</h1> -<p>The requested URL was not found on this server.</p> -<pre>%s</pre> -</body></html>") - (500 . "<!DOCTYPE html> -<html><head> -<title>500 Internal Error</title> -</head><body> -<h1>500 Internal Error</h1> -<p>Internal error when handling this request.</p> -<pre>%s</pre> -</body></html>")) - "HTML for various errors.") - -;; User interface - -;;;###autoload -(defun httpd-start () - "Start the web server process. If the server is already -running, this will restart the server. There is only one server -instance per Emacs instance." - (interactive) - (httpd-stop) - (httpd-log `(start ,(current-time-string))) - (make-network-process - :name "httpd" - :service httpd-port - :server t - :host httpd-host - :family httpd-ip-family - :filter 'httpd--filter - :coding 'binary - :log 'httpd--log) - (run-hooks 'httpd-start-hook)) - -;;;###autoload -(defun httpd-stop () - "Stop the web server if it is currently running, otherwise do nothing." - (interactive) - (when (process-status "httpd") - (delete-process "httpd") - (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'." - (interactive "DServe directory: \n") - (setf httpd-root directory) - (httpd-start) - (message "Started simple-httpd on %s:%d, serving: %s" - (cl-case httpd-host - ((nil) "0.0.0.0") - ((local) "localhost") - (otherwise httpd-host)) httpd-port directory)) - -(defun httpd-batch-start () - "Never returns, holding the server open indefinitely for batch mode. -Logs are redirected to stdout. To use, invoke Emacs like this: -emacs -Q -batch -l simple-httpd.elc -f httpd-batch-start" - (if (not noninteractive) - (error "Only use `httpd-batch-start' in batch mode!") - (httpd-start) - (defalias 'httpd-log 'pp) - (while t (sleep-for 60)))) - -;; Utility - -(defun httpd-date-string (&optional date) - "Return an HTTP date string (RFC 1123)." - (format-time-string "%a, %e %b %Y %T GMT" date t)) - -(defun httpd-etag (file) - "Compute the ETag for FILE." - (concat "\"" (substring (sha1 (prin1-to-string (file-attributes file))) -16) - "\"")) - -(defun httpd--stringify (designator) - "Turn a string designator into a string." - (let ((string (format "%s" designator))) - (if (keywordp designator) - (substring string 1) - string))) - -;; Networking code - -(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." - (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 (httpd-unhex (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*") - (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) - "Pretty print a lisp object to the log." - (with-current-buffer (get-buffer-create "*httpd*") - (setf buffer-read-only nil) - (let ((follow (= (point) (point-max)))) - (save-excursion - (goto-char (point-max)) - (pp item (current-buffer))) - (if follow (goto-char (point-max)))) - (setf truncate-lines t - buffer-read-only t) - (set-buffer-modified-p nil))) - -;; Servlets - -(defvar httpd-current-proc nil - "The process object currently in use.") - -(defvar httpd--header-sent nil - "Buffer-local variable indicating if the header has been sent.") -(make-variable-buffer-local 'httpd--header-sent) - -(defun httpd-resolve-proc (proc) - "Return the correct process to use. This handles `httpd-current-proc'." - (if (eq t proc) httpd-current-proc proc)) - -(defmacro with-httpd-buffer (proc mime &rest body) - "Create a temporary buffer, set it as the current buffer, and, -at the end of body, automatically serve it to an HTTP client with -an HTTP header indicating the specified MIME type. Additionally, -`standard-output' is set to this output buffer and -`httpd-current-proc' is set to PROC." - (declare (indent defun)) - (let ((proc-sym (make-symbol "--proc--"))) - `(let ((,proc-sym ,proc)) - (with-temp-buffer - (setf major-mode 'httpd-buffer) - (let ((standard-output (current-buffer)) - (httpd-current-proc ,proc-sym)) - ,@body) - (unless httpd--header-sent - (httpd-send-header ,proc-sym ,mime 200)))))) - -(defun httpd-discard-buffer () - "Don't respond using current server buffer (`with-httpd-buffer'). -Returns a process for future response." - (when (eq major-mode 'httpd-buffer) (setf httpd--header-sent t)) - httpd-current-proc) - -(defmacro defservlet (name mime path-query-request &rest body) - "Defines a simple httpd servelet. The servlet runs in a -temporary buffer which is automatically served to the client -along with a header. - -A servlet that serves the contents of *scratch*, - - (defservlet scratch text/plain () - (insert-buffer-substring (get-buffer-create \"*scratch*\"))) - -A servlet that says hello, - - (defservlet hello-world text/plain (path) - (insert \"hello, \" (file-name-nondirectory path))))" - (declare (indent defun)) - (let ((proc-sym (make-symbol "proc")) - (fname (intern (concat "httpd/" (symbol-name name))))) - `(defun ,fname (,proc-sym ,@path-query-request &rest ,(cl-gensym)) - (with-httpd-buffer ,proc-sym ,(httpd--stringify mime) - ,@body)))) - -(defun httpd-parse-endpoint (symbol) - "Parse an endpoint definition template for use with `defservlet*'." - (cl-loop for item in (split-string (symbol-name symbol) "/") - for n upfrom 0 - when (and (> (length item) 0) (eql (aref item 0) ?:)) - collect (cons (intern (substring item 1)) n) into vars - else collect item into path - finally - (cl-return - (cl-values (intern (mapconcat #'identity path "/")) vars)))) - -(defvar httpd-path nil - "Anaphoric variable for `defservlet*'.") - -(defvar httpd-query nil - "Anaphoric variable for `defservlet*'.") - -(defvar httpd-request nil - "Anaphoric variable for `defservlet*'.") - -(defvar httpd-split-path nil - "Anaphoric variable for `defservlet*'.") - -(defmacro defservlet* (endpoint mime args &rest body) - "Like `defservlet', but automatically bind variables/arguments -to the request. Trailing components of the ENDPOINT can be bound -by prefixing these components with a colon, acting like a template. - - (defservlet* packages/:package/:version text/plain (verbose) - (insert (format \"%s\\n%s\\n\" package version)) - (princ (get-description package version)) - (when verbose - (insert (format \"%S\" (get-dependencies package version))))) - -When accessed from this URL, - - http://example.com/packages/foobar/1.0?verbose=1 - -the variables package, version, and verbose will be bound to the -associated components of the URL. Components not provided are -bound to nil. The query arguments can use the Common Lisp &key -form (variable default provided-p). - - (defservlet* greeting/:name text/plain ((greeting \"hi\" greeting-p)) - (princ (format \"%s, %s (provided: %s)\" greeting name greeting-p))) - -The original path, query, and request can be accessed by the -anaphoric special variables `httpd-path', `httpd-query', and -`httpd-request'." - (declare (indent defun)) - (let ((path-lexical (cl-gensym)) - (query-lexical (cl-gensym)) - (request-lexical (cl-gensym))) - (cl-multiple-value-bind (path vars) (httpd-parse-endpoint endpoint) - `(defservlet ,path ,mime (,path-lexical ,query-lexical ,request-lexical) - (let ((httpd-path ,path-lexical) - (httpd-query ,query-lexical) - (httpd-request ,request-lexical) - (httpd-split-path (split-string - (substring ,path-lexical 1) "/"))) - (let ,(cl-loop for (var . pos) in vars - for extract = - `(httpd-unhex (nth ,pos httpd-split-path)) - collect (list var extract)) - (let ,(cl-loop for arg in args - for has-default = (listp arg) - for has-default-p = (and has-default - (= 3 (length arg))) - for arg-name = (symbol-name - (if has-default (cl-first arg) arg)) - when has-default collect - (list (cl-first arg) - `(let ((value (assoc ,arg-name httpd-query))) - (if value - (cl-second value) - ,(cl-second arg)))) - else collect - (list arg `(cl-second - (assoc ,arg-name httpd-query))) - when has-default-p collect - (list (cl-third arg) - `(not (null (assoc ,arg-name httpd-query))))) - ,@body))))))) - -(font-lock-add-keywords - 'emacs-lisp-mode - '(("(\\<\\(defservlet\\*?\\)\\> +\\([^ ()]+\\) +\\([^ ()]+\\)" - (1 'font-lock-keyword-face) - (2 'font-lock-function-name-face) - (3 'font-lock-type-face)))) - -(defmacro httpd-def-file-servlet (name root) - "Defines a servlet that serves files from ROOT under the route NAME. - - (httpd-def-file-servlet my/www \"/var/www/\") - -Automatically handles redirects and uses `httpd-serve-root' to -actually serve up files." - (let* ((short-root (directory-file-name (symbol-name name))) - (path-root (concat short-root "/")) - (chop (length path-root))) - `(defservlet ,name nil (uri-path query request) - (setf httpd--header-sent t) ; Don't actually use this temp buffer - (if (= (length uri-path) ,chop) - (httpd-redirect t ,path-root) - (let ((path (substring uri-path ,chop))) - (httpd-serve-root t ,root path request)))))) - -;; Request parsing - -(defun httpd--normalize-header (header) - "Destructively capitalize the components of HEADER." - (mapconcat #'capitalize (split-string header "-") "-")) - -(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)." - (when str - (let ((nonplussed (replace-regexp-in-string (regexp-quote "+") " " str))) - (decode-coding-string (url-unhex-string nonplussed t) 'utf-8)))) - -(defun httpd-parse-args (argstr) - "Parse a string containing URL encoded arguments." - (unless (zerop (length argstr)) - (mapcar (lambda (str) - (mapcar 'httpd-unhex (split-string str "="))) - (split-string argstr "&")))) - -(defun httpd-parse-uri (uri) - "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 (substring uri 0 (or p1 p2)) retval))) - -(defun httpd-escape-html-buffer () - "Escape current buffer contents to be safe for inserting into HTML." - (setf (point) (point-min)) - (while (search-forward-regexp "[<>&]" nil t) - (replace-match - (cl-case (aref (match-string 0) 0) - (?< "<") - (?> ">") - (?& "&"))))) - -(defun httpd-escape-html (string) - "Escape STRING so that it's safe to insert into an HTML document." - (with-temp-buffer - (insert string) - (httpd-escape-html-buffer) - (buffer-string))) - -;; Path handling - -(defun httpd-status (path) - "Determine status code for PATH." - (cond - ((not (file-exists-p path)) 404) - ((not (file-readable-p path)) 403) - ((and (file-directory-p path) (not httpd-listings)) 403) - (200))) - -(defun httpd-clean-path (path) - "Clean dangerous .. from PATH and remove the leading slash." - (let* ((sep (if (member system-type '(windows-nt ms-dos)) "[/\\]" "/")) - (split (delete ".." (split-string path sep))) - (unsplit (mapconcat 'identity (delete "" split) "/"))) - (concat "./" unsplit))) - -(defun httpd-gen-path (path &optional root) - "Translate GET to secure path in ROOT (`httpd-root')." - (let ((clean (expand-file-name (httpd-clean-path path) (or root httpd-root)))) - (if (file-directory-p clean) - (let* ((dir (file-name-as-directory clean)) - (indexes (cl-mapcar (apply-partially 'concat dir) httpd-indexes)) - (existing (cl-remove-if-not 'file-exists-p indexes))) - (or (car existing) dir)) - clean))) - -(defun httpd-get-servlet (uri-path) - "Determine the servlet to be executed for URI-PATH." - (if (not httpd-servlets) - 'httpd/ - (cl-labels ((cat (x) - (concat "httpd/" (mapconcat 'identity (reverse x) "/")))) - (let ((parts (cdr (split-string (directory-file-name uri-path) "/")))) - (or - (cl-find-if 'fboundp (mapcar 'intern-soft - (cl-maplist #'cat (reverse parts)))) - 'httpd/))))) - -(defun httpd-serve-root (proc root uri-path &optional request) - "Securely serve a file from ROOT from under PATH." - (let* ((path (httpd-gen-path uri-path root)) - (status (httpd-status path))) - (cond - ((not (= status 200)) (httpd-error proc status)) - ((file-directory-p path) (httpd-send-directory proc path uri-path)) - (t (httpd-send-file proc path request))))) - -(defun httpd/ (proc uri-path query request) - "Default root servlet which serves files when httpd-serve-files is T." - (if (and httpd-serve-files httpd-root) - (httpd-serve-root proc httpd-root uri-path request) - (httpd-error proc 403))) - -(defun httpd-get-mime (ext) - "Fetch MIME type given the file extention." - (or (and ext (cdr (assoc (downcase ext) httpd-mime-types))) - "application/octet-stream")) - -;; Data sending functions - -(defun httpd-send-header (proc mime status &rest header-keys) - "Send an HTTP header with given MIME type and STATUS, followed -by the current buffer. If PROC is T use the `httpd-current-proc' -as the process. - -Extra headers can be sent by supplying them like keywords, i.e. - - (httpd-send-header t \"text/plain\" 200 :X-Powered-By \"simple-httpd\")" - (let ((status-str (cdr (assq status httpd-status-codes))) - (headers `(("Server" . ,httpd-server-name) - ("Date" . ,(httpd-date-string)) - ("Connection" . "keep-alive") - ("Content-Type" . ,(httpd--stringify mime)) - ("Content-Length" . ,(httpd--buffer-size))))) - (unless httpd--header-sent - (setf httpd--header-sent t) - (with-temp-buffer - (insert (format "HTTP/1.1 %d %s\r\n" status status-str)) - (cl-loop for (header value) on header-keys by #'cddr - for header-name = (substring (symbol-name header) 1) - for value-name = (format "%s" value) - collect (cons header-name value-name) into extras - finally (setf headers (nconc headers extras))) - (dolist (header headers) - (insert (format "%s: %s\r\n" (car header) (cdr header)))) - (insert "\r\n") - (process-send-region (httpd-resolve-proc proc) - (point-min) (point-max))) - (process-send-region (httpd-resolve-proc proc) - (point-min) (point-max))))) - -(defun httpd-redirect (proc path &optional code) - "Redirect the client to PATH (default 301). If PROC is T use -the `httpd-current-proc' as the process." - (httpd-log (list 'redirect path)) - (httpd-discard-buffer) - (with-temp-buffer - (httpd-send-header proc "text/plain" (or code 301) :Location path))) - -(defun httpd-send-file (proc path &optional req) - "Serve file to the given client. If PROC is T use the -`httpd-current-proc' as the process." - (httpd-discard-buffer) - (let ((req-etag (cadr (assoc "If-None-Match" req))) - (etag (httpd-etag path)) - (mtime (httpd-date-string (nth 4 (file-attributes path))))) - (if (equal req-etag etag) - (with-temp-buffer - (httpd-log `(file ,path not-modified)) - (httpd-send-header proc "text/plain" 304)) - (httpd-log `(file ,path)) - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-file-contents-literally path) - (httpd-send-header proc (httpd-get-mime (file-name-extension path)) - 200 :Last-Modified mtime :ETag etag))))) - -(defun httpd-send-directory (proc path uri-path) - "Serve a file listing to the client. If PROC is T use the -`httpd-current-proc' as the process." - (httpd-discard-buffer) - (let ((title (concat "Directory listing for " - (url-insert-entities-in-string uri-path)))) - (if (equal "/" (substring uri-path -1)) - (with-temp-buffer - (httpd-log `(directory ,path)) - (insert "<!DOCTYPE html>\n") - (insert "<html>\n<head><title>" title "</title></head>\n") - (insert "<body>\n<h2>" title "</h2>\n<hr/>\n<ul>") - (dolist (file (directory-files path)) - (unless (eq ?. (aref file 0)) - (let* ((full (expand-file-name file path)) - (tail (if (file-directory-p full) "/" "")) - (f (url-insert-entities-in-string file)) - (l (url-hexify-string file))) - (insert (format "<li><a href=\"%s%s\">%s%s</a></li>\n" - l tail f tail))))) - (insert "</ul>\n<hr/>\n</body>\n</html>") - (httpd-send-header proc "text/html; charset=utf-8" 200)) - (httpd-redirect proc (concat uri-path "/"))))) - -(defun httpd--buffer-size (&optional buffer) - "Get the buffer size in bytes." - (let ((orig enable-multibyte-characters) - (size 0)) - (with-current-buffer (or buffer (current-buffer)) - (set-buffer-multibyte nil) - (setf size (buffer-size)) - (if orig (set-buffer-multibyte orig))) - size)) - -(defun httpd-error (proc status &optional info) - "Send an error page appropriate for STATUS to the client, -optionally inserting object INFO into page. If PROC is T use the -`httpd-current-proc' as the process." - (httpd-discard-buffer) - (httpd-log `(error ,status ,info)) - (with-temp-buffer - (let ((html (or (cdr (assq status httpd-html)) "")) - (contents - (if (not info) - "" - (with-temp-buffer - (let ((standard-output (current-buffer))) - (insert "error: ") - (princ info) - (insert "\n") - (when httpd-show-backtrace-when-error - (insert "backtrace: ") - (princ (backtrace)) - (insert "\n")) - (httpd-escape-html-buffer) - (buffer-string)))))) - (insert (format html contents))) - (httpd-send-header proc "text/html" status))) - -(defun httpd--error-safe (&rest args) - "Call httpd-error and report failures to *httpd*." - (condition-case error-case - (apply #'httpd-error args) - (error (httpd-log `(hard-error ,error-case))))) - -(provide 'simple-httpd) - -;;; simple-httpd.el ends here diff --git a/elpa/simple-httpd-20191103.1446/simple-httpd.elc b/elpa/simple-httpd-20191103.1446/simple-httpd.elc Binary files differdeleted file mode 100644 index 94c7e04..0000000 --- a/elpa/simple-httpd-20191103.1446/simple-httpd.elc +++ /dev/null |