Just to show that Elnode will serve anything, here's a png:
16 |
17 |
18 |
19 |
20 |
21 |
--------------------------------------------------------------------------------
/elpakit-run.el:
--------------------------------------------------------------------------------
1 | ;;; elpakit-run.el --- run elpakit from the command line
2 |
3 | ;; run with:
4 | ;;
5 | ;; emacs -batch -l elpakit-run.el
6 |
7 | (when (member
8 | "elpakit-run.el"
9 | (mapcar 'file-name-nondirectory command-line-args))
10 | (let ((elpakit-command (car-safe (reverse command-line-args)))
11 | (package-user-dir (make-temp-name "/tmp/elpakit-run")))
12 | (package-initialize)
13 | (add-to-list
14 | 'package-archives
15 | '("marmalade" . "http://marmalade-repo.org/packages/"))
16 | (package-refresh-contents)
17 | (package-install 'elpakit)
18 | (elpakit-make-multi ".")))
19 |
20 | ;;; elpakit-run.el ends here
21 |
--------------------------------------------------------------------------------
/emacs-db/todo.org:
--------------------------------------------------------------------------------
1 | * postgresql driver
2 | ** use the marsden library
3 | ** [[~/work/emacs-postgres/pg.el]]
4 | ** async plan
5 | *** writes
6 | **** have a hashtable db but then send writes async to pg
7 | **** when they come back you can mark the original row as stored in pg
8 | **** if it doesn't ever write it's because the db is down
9 | ***** and you can start really really alerting
10 | *** reads are the problem
11 | **** because of course stuff can change in the db but not the local db
12 | ** how does it work
13 | *** we need lazy connection establishment
14 | **** connection tied to a db
15 | **** possibly a connection pool
16 | *** db-get
17 | **** find or make a connection
18 | ****
19 |
--------------------------------------------------------------------------------
/examples/scratch.el:
--------------------------------------------------------------------------------
1 | ;;; scratch working of various elpakits
2 |
3 | (elpakit
4 | "/tmp/elpatest1"
5 | '("~/work/emacs-db"
6 | "~/work/emacs-db-pg"
7 | "~/work/pg"
8 | "~/work/emacs-kv"))
9 |
10 | (elpakit-test
11 | '("~/work/emacs-db"
12 | "~/work/emacs-db-pg"
13 | "~/work/pg"
14 | "~/work/emacs-kv")
15 | 'db-pg-tests
16 | 'db)
17 |
18 | (elpakit-test
19 | '("~/work/elnode-auth"
20 | "~/work/emacs-db"
21 | "~/work/emacs-kv")
22 | 'elnode-tests
23 | 'elnode)
24 |
25 | (elpakit-test
26 | '("~/work/emacs-web")
27 | 'web-test
28 | 'web)
29 |
30 | (elpakit-test
31 | '("~/work/mongo-el")
32 | 'mongo-tests
33 | 'bson)
34 |
35 |
36 | ;;; end of scratch.el
37 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-js-tests.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-js-tests.el --- tests for elnode-js -*- lexical-binding: t -*-
2 |
3 | (require 'fakir)
4 | (require 'elnode)
5 |
6 | (ert-deftest elnode-js/browserify-bin ()
7 | (should
8 | (equal
9 | (let ((default-directory (expand-file-name "node-test-dir/src")))
10 | (elnode-js/browserify-bin "."))
11 | (expand-file-name "node-test-dir/node_modules/.bin/browserify"))))
12 |
13 | (with-elnode-mock-httpcon :httpcon
14 | (:elnode-http-method "GET")
15 | (elnode-js/browserify-send-func
16 | :httpcon
17 | (expand-file-name "src/example.js" "node-test-dir"))
18 | (with-current-buffer (fakir-get-output-buffer)
19 | (buffer-string)))
20 |
21 | (provide 'elnode-js-tests)
22 |
23 | ;;; elnode-js-tests.el ends here
24 |
--------------------------------------------------------------------------------
/elnode-auth/recipes/elnode:
--------------------------------------------------------------------------------
1 | (elnode
2 | :version "0.9.9.8.7"
3 | :doc "The Emacs webserver."
4 | :requires
5 | ((web "0.4.3") ;; for proxy
6 | (dash "1.1.0")
7 | (noflet "0.0.7")
8 | (s "1.5.0")
9 | (creole "0.8.14") ;; for wiki
10 | (fakir "0.1.6") ;; we provide the test-call with fakir
11 | (db "0.0.5")
12 | (kv "0.0.17"))
13 | :files
14 | ("elnode.el"
15 | "elnode-compat.el"
16 | "elnode-lists.el"
17 | "elnode-js.el"
18 | "elnode-tools.el"
19 | "elnode-wiki.el"
20 | "elnode-proxy.el"
21 | "elnode-log-mode.el"
22 | "elnode-testsupport.el"
23 | "default-wiki-index.creole"
24 | "default-webserver-test.html"
25 | "default-webserver-image.png"
26 | "README.creole"
27 | "COPYING")
28 | :test
29 | (:files
30 | ("elnode-tests.el")))
31 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-log-mode.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-log-mode.el - view elnode log files nicely
2 |
3 | ;;;###autoload
4 | (define-generic-mode 'elnode-log-mode
5 | nil ; comments
6 | nil; keywords
7 | `(("^\\([0-9:-]+\\) .*" 1 '(face '(italic (:foreground "blue"))))
8 | ("^[0-9:-]+ \\([32][0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "green")))
9 | ("^[0-9:-]+ \\(4[0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "yellow")))
10 | ("^[0-9:-]+ \\(5[0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "red")))
11 | ("^.* \\(GET\\|POST\\|HEAD\\|DELETE\\|TRACE\\)" 1 '(face '(bold (:foreground "purple"))))) ; font-lock list
12 | nil
13 | '((lambda ()
14 | ;;(use-local-map elnode-log-mode-map)
15 | (setq buffer-read-only 't)
16 | (set-buffer-modified-p nil)
17 | ))
18 | "Elnode log viewing mode.
19 |
20 | For viewing access log files from Elnode.")
21 |
22 | ;;; elnode-log-mode.el ends here
23 |
--------------------------------------------------------------------------------
/elnode-auth/FAQ.creole:
--------------------------------------------------------------------------------
1 | = FAQ =
2 |
3 | == is Elnode fast enough? ==
4 |
5 | Speed just isn't a concern of Elnode. Elnode is focussed on making it
6 | easy to write asynchronous webapps with EmacsLisp. The focus is on
7 | scalability, not speed.
8 |
9 |
10 | == is Elnode scalable enough? ==
11 |
12 | No. But this is mostly a function of Emacs' IO which uses {{{select}}}
13 | for non-blocking calls and not other, more scalable non-blocking IO
14 | librarys.
15 |
16 | I hope at some point to contribute a better IO library to Emacs.
17 |
18 |
19 | == Why does Elnode always use chunked encoding? ==
20 |
21 | Because it's simpler. {{{elnode-http-start}}} can send the header
22 | without knowing what sort of data you'll be sending.
23 |
24 | I may provide a single start and return call in the future that can
25 | send a buffer or a single string. Pre-buffered, one shot computed
26 | stuff isn't really the point of async programming though.
27 |
--------------------------------------------------------------------------------
/fake-package-with-elisp/fake-package.el:
--------------------------------------------------------------------------------
1 | ;;; fake-package.el --- just a fake package for elpakit testing -*- lexical-binding: t; -*-
2 |
3 | ;; Copyright (C) 2014 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords: lisp
7 |
8 | ;; This program is free software; you can redistribute it and/or modify
9 | ;; it under the terms of the GNU General Public License as published by
10 | ;; the Free Software Foundation, either version 3 of the License, or
11 | ;; (at your option) any later version.
12 |
13 | ;; This program is distributed in the hope that it will be useful,
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | ;; GNU General Public License for more details.
17 |
18 | ;; You should have received a copy of the GNU General Public License
19 | ;; along with this program. If not, see .
20 |
21 | ;;; Commentary:
22 |
23 | ;; This is just a fake package, not useful at all.
24 |
25 |
26 | ;;; Code:
27 |
28 |
29 |
30 | (provide 'fake-package)
31 | ;;; fake-package.el ends here
32 |
--------------------------------------------------------------------------------
/demo-multifile/demo-multifile.el:
--------------------------------------------------------------------------------
1 | ;;; demo-multifile.el --- a demonstration multifile package -*- lexical-binding: t; -*-
2 |
3 | ;; Copyright (C) 2014 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords: lisp
7 | ;; Version: 0.0.1
8 |
9 | ;; This program is free software; you can redistribute it and/or modify
10 | ;; it under the terms of the GNU General Public License as published by
11 | ;; the Free Software Foundation, either version 3 of the License, or
12 | ;; (at your option) any later version.
13 |
14 | ;; This program is distributed in the hope that it will be useful,
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 | ;; GNU General Public License for more details.
18 |
19 | ;; You should have received a copy of the GNU General Public License
20 | ;; along with this program. If not, see .
21 |
22 | ;;; Commentary:
23 |
24 | ;; This doesn't do anything. It's just a demo of how to build a
25 | ;; multi-file package.
26 |
27 | ;;; Code:
28 |
29 | (require 'thingatpt)
30 |
31 |
32 | (provide 'demo-multifile)
33 |
34 | ;;; demo-multifile.el ends here
35 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-compat.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-compat.el --- compatability stuff
2 |
3 | ;; Copyright (C) 2014 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords:
7 |
8 | ;; This program is free software; you can redistribute it and/or modify
9 | ;; it under the terms of the GNU General Public License as published by
10 | ;; the Free Software Foundation, either version 3 of the License, or
11 | ;; (at your option) any later version.
12 |
13 | ;; This program is distributed in the hope that it will be useful,
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | ;; GNU General Public License for more details.
17 |
18 | ;; You should have received a copy of the GNU General Public License
19 | ;; along with this program. If not, see .
20 |
21 | ;;; Commentary:
22 |
23 | ;;
24 |
25 | ;;; Code:
26 |
27 | (require 'elnode)
28 |
29 | (defalias 'elnode-remote-ipaddr 'elnode-get-remote-ipaddr)
30 | (defalias 'elnode-rfc1123-date 'elnode--rfc1123-date)
31 | (defalias 'elnode-file-modified-time 'elnode--file-modified-time)
32 |
33 | (provide 'elnode-compat)
34 |
35 | ;;; elnode-compat.el ends here
36 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-proxy-test.el:
--------------------------------------------------------------------------------
1 | ;;; example proxy stuff -*- lexical-binding: t -*-
2 |
3 | (defun elnode-proxy-example (httpcon)
4 | "A function that will be proxied if it's on the wrong port."
5 | (elnode-send-json httpcon '(:data)))
6 |
7 |
8 | ;;; marmalade example
9 |
10 | (elnode-start
11 | (lambda (httpcon)
12 | (elnode/router httpcon
13 | `(("^[^/]*//-/\\(.*\\)$" ,marmalade/webserver)
14 | ("^[^/]*//packages/new$" marmalade/upload-page)
15 |
16 | ("^[^/]*//packages/archive-contents$"
17 | marmalade-archive-contents-handler :service archive)
18 | ("^[^/]*//packages/archive-contents/\\([0-9]+\\)"
19 | ,marmalade-archive-cache-webserver :service archive)
20 | ("^[^/]*//packages/archive-contents/update$"
21 | marmalade-archive-update :service archive)
22 |
23 | ;; We don't really want to send 404's for these if we have them
24 | ("^[^/]+//packages/.*-readme.txt" elnode-send-404)
25 | ("^[^/]+//packages/\\(.*\\.\\(el\\|tar\\)\\)" marmalade/package-handler)
26 | ("^[^/]+//packages/\\([^/]+\\)" marmalade/package-blurb)
27 | ;; we have GET /packages/ and / be the same right now - probably not right
28 | ("^[^/]+//packages/$" marmalade/packages-index)
29 |
30 | ("^[^/]+//$" marmalade/packages-index))))
31 | :port 9000
32 | :service-mappings '((archive . 9001)))
33 |
34 | ;; Starts two servers, one on 9000 and one on 9001.
35 |
36 | ;;; elnode-proxy-test.el ends here
37 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-tools.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-tools.el --- dev tools for elnode -*- lexical-binding: t -*-
2 |
3 | ;; Copyright (C) 2014 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords: lisp
7 |
8 | ;; This program is free software; you can redistribute it and/or modify
9 | ;; it under the terms of the GNU General Public License as published by
10 | ;; the Free Software Foundation, either version 3 of the License, or
11 | ;; (at your option) any later version.
12 |
13 | ;; This program is distributed in the hope that it will be useful,
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | ;; GNU General Public License for more details.
17 |
18 | ;; You should have received a copy of the GNU General Public License
19 | ;; along with this program. If not, see .
20 |
21 | ;;; Commentary:
22 |
23 | ;; Just some tools to help debug and improve elnode
24 |
25 | ;;; Code:
26 |
27 | (require 'elp)
28 | (require 'elnode)
29 | (require 'dash)
30 | (require 'profiler)
31 | (require 'cl-macs)
32 |
33 | (defun process-sentinel-set (proc func)
34 | (set-process-sentinel proc func)
35 | proc)
36 |
37 | (defvar elnode-elp-do-profiler nil)
38 |
39 | (defun elnode-elp-handler (httpcon)
40 | (let ((elnode-webserver-visit-file t))
41 | (elnode-docroot-for "~/sources/emacs/etc/"
42 | :with file
43 | :on httpcon
44 | :do (elnode-send-file httpcon file))))
45 |
46 | (defun elnode-elp (&optional port)
47 | (interactive
48 | (list
49 | (when current-prefix-arg
50 | (string-to-number
51 | (read-from-minibuffer "port to hit: ")))))
52 | (let ((sock (or port 8001))
53 | (elnode--do-error-logging :status))
54 | (unless (kva sock elnode-server-socket)
55 | (elnode-start 'elnode-elp-handler :port 8001))
56 | (let ((elnode--do-error-logging :warning))
57 | (when elnode-elp-do-profiler
58 | (profiler-stop)
59 | (profiler-start 'cpu))
60 | (elp-reset-all)
61 | (elp-instrument-package "elnode")
62 | (elp-instrument-package "kv")
63 | (elp-instrument-package "process")
64 | (elp-instrument-package "set-process")
65 | (let (fin)
66 | (switch-to-buffer
67 | (process-buffer
68 | (process-sentinel-set
69 | (start-process-shell-command
70 | "elnode-ab" "elnode-ab"
71 | (format
72 | (concat
73 | "ab -r -n 4000 -c 200 -s 20 "
74 | "http://127.0.0.1:%s/COPYING "
75 | " > /tmp/elnode-elp-101.txt") sock))
76 | (lambda (proc status) (setq fin t)))))
77 | (while (not fin) (sleep-for 20))
78 | (when elnode-elp-do-profiler
79 | (profiler-report)
80 | (profiler-stop))
81 | (when (get-buffer "elnode-elp-101.txt")
82 | (with-current-buffer (get-buffer "elnode-elp-101.txt")
83 | (set-buffer-modified-p nil)))
84 | (find-file "/tmp/elnode-elp-101.txt")
85 | (elp-results)
86 | (elp-reset-all)))))
87 |
88 | (defun elnode-check-request-buffers ()
89 | (interactive)
90 | (noflet ((request-buffers ()
91 | (->> (buffer-list)
92 | (-filter
93 | (lambda (b) (string-match " \\*elnode.*" (buffer-name b)))))))
94 | (let ((before (request-buffers)))
95 | (-each (request-buffers) (lambda (b) (kill-buffer b)))
96 | (message "request buffers: %d > %d"
97 | (length before)
98 | (length (request-buffers))))))
99 |
100 |
101 | (provide 'elnode-tools)
102 |
103 | ;;; elnode-tools.el ends here
104 |
--------------------------------------------------------------------------------
/elnode-auth/default-wiki-index.creole:
--------------------------------------------------------------------------------
1 | = Elnode Wiki =
2 |
3 | This is Elnode's Wiki. It is based on the {{{creole}}} wiki language
4 | and is written completely in EmacsLisp.
5 |
6 | {{default-wiki-logo.gif|GNUs sitting on clouds}}
7 |
8 | == What does it do? ==
9 |
10 | It does syntax coloring:
11 |
12 | {{{
13 | ##! emacs-lisp
14 | (defun elnode-wiki-handler (httpcon wikiroot)
15 | "A low level handler for Wiki operations.
16 |
17 | Send the Wiki page requested, which must be a file existing under
18 | the WIKIROOT, back to the HTTPCON.
19 |
20 | Update operations are protected by authentication."
21 | (elnode-method httpcon
22 | (GET
23 | (elnode-docroot-for wikiroot
24 | with target-path
25 | on httpcon
26 | do
27 | (if (equal target-path (expand-file-name (concat wikiroot "/")))
28 | (elnode-wiki-page httpcon (concat wikiroot "/index.creole"))
29 | (elnode-wiki-page httpcon target-path))))
30 | (POST
31 | (elnode-with-auth httpcon 'elnode-wiki-auth
32 | (let* ((path (elnode-http-pathinfo httpcon))
33 | (text (elnode-wiki--text-param httpcon)))
34 | (if (not (elnode-http-param httpcon "preview"))
35 | ;; A save request in which case save the new text and then
36 | ;; send the wiki text.
37 | (elnode-wiki--save-request httpcon wikiroot path text)
38 | ;; Might be a preview request in which case send back the WIKI
39 | ;; text that's been sent.
40 | (with-temp-file "/tmp/preview"
41 | (insert text))
42 | (elnode-wiki-send httpcon "/tmp/preview" path)))))))
43 | }}}
44 |
45 | It does links, for example to
46 | [[http://github.com/nicferrier/elwikicreole|Emacs Creole]] which is
47 | the Wiki render engine used to display pages.
48 |
49 | It does all the normal Wiki things like headings and lists.
50 |
51 | You can also do some special Emacs things, like org-mode tables:
52 |
53 | | Date | Amount | Description |
54 | |------------+--------+---------------------|
55 | | 2011-11-15 | 100.15 | Expensive lunch out |
56 | | 2011-11-18 | 7.30 | Dry cleaning |
57 | | 2011-11-21 | 22.50 | Takeaway curry |
58 | |------------+--------+---------------------|
59 | | | 129.95 | |
60 | #+TBLFM: @5$2=vsum(@I..@II)
61 |
62 | and lisp callouts:
63 |
64 | <<(
65 | (mapconcat
66 | (lambda (s)
67 | (format "* %s" s))
68 | '("which" "eval" "lisp" "and" "render" "the" "results")
69 | "\n")
70 | )>>
71 |
72 |
73 | == Authentication ==
74 |
75 | By default, the Wiki uses an authentication database in the Emacs
76 | instance running Elnode and the Wiki server.
77 |
78 | If you want to add a user to the Wiki so you can edit pages you can do this in Emacs:
79 |
80 | {{{
81 | M-x elnode-auth-user-add
82 | }}}
83 |
84 | and it will ask you for a username and a password. The user will be
85 | stored in a persistent database.
86 |
87 |
88 | == Where the Wiki pages are ==
89 |
90 | By default the Elnode Wiki stores files in your {{{~/.emacs.d}}}
91 | directory which is actually defined by the variable
92 | {{{user-emacs-directory}}} in Emacs.
93 |
94 | There is normally a directory {{{elnode}}} in that directory which
95 | contains directories for the Web server document root and the Wiki.
96 |
97 | The location of the Wiki files can be configured though, try:
98 |
99 | {{{
100 | M-x customize-variable [RET] elnode-wikiserver-wikiroot
101 | }}}
102 |
103 | == More customization ==
104 |
105 | There are many other things in Elnode's Wiki that can be customized,
106 | including the header and footer. Use:
107 |
108 | {{{
109 | M-x customize-group [RET] elnode-wikiserver [RET]
110 | }}}
111 |
112 | There is more to do with the Elnode Wiki server because there is so
113 | much that Emacs can do.
114 |
--------------------------------------------------------------------------------
/emacs-kv/README.creole:
--------------------------------------------------------------------------------
1 | A collection of tools for dealing with key/value data structures such
2 | as plists, alists and hash-tables.
3 |
4 | === kvalist->filter-keys alist &rest keys ===
5 |
6 | Return the //alist// filtered to the //keys// list.
7 |
8 | Only pairs where the car is a [[member]] of //keys// will be returned.
9 |
10 |
11 | === kvalist->hash alist &rest hash-table-args ===
12 |
13 | Convert //alist// to a HASH.
14 |
15 | //hash-table-args// are passed to the hash-table creation.
16 |
17 |
18 | === kvalist->keys alist ===
19 |
20 | Get just the keys from the alist.
21 |
22 |
23 | === kvalist->plist alist ===
24 |
25 | Convert an alist to a plist.
26 |
27 |
28 | === kvalist->values alist ===
29 |
30 | Get just the values from the alist.
31 |
32 |
33 | === kvalist-keys->* alist fn ===
34 |
35 | Convert the keys of //alist// through //fn//.
36 |
37 |
38 | === kvalist-keys->symbols alist ===
39 |
40 | Convert the keys of //alist// into symbols.
41 |
42 |
43 | === kvalist-sort alist pred ===
44 |
45 | Sort //alist// (by key) with //pred//.
46 |
47 |
48 | === kvalist-sort-by-value alist pred ===
49 |
50 | Sort //alist// by value with //pred//.
51 |
52 |
53 | === kvalist2->alist alist2 car-key cdr-key &optional proper ===
54 |
55 | Reduce the //alist2// (a list of alists) to a single alist.
56 |
57 | //car-key// is the key of each alist to use as the resulting key and
58 | //cdr-key// is the key of each alist to user as the resulting cdr.
59 |
60 | If //proper// is [[t]] then the alist is a list of proper lists, not
61 | cons cells.
62 |
63 |
64 | === kvalist2->filter-keys alist2 &rest keys ===
65 |
66 | Return the //alist2// (a list of alists) filtered to the //keys//.
67 |
68 |
69 | === kvalist2->plist alist2 ===
70 |
71 | Convert a list of alists too a list of plists.
72 |
73 |
74 | === kvcmp a b ===
75 |
76 | Do a comparison of the two values using printable syntax.
77 |
78 | Use this as the function to pass to [[sort]].
79 |
80 |
81 | === kvdotassoc expr table ===
82 |
83 | Dotted expression handling with [[assoc]].
84 |
85 |
86 | === kvdotassoc-fn expr table func ===
87 |
88 | Use the dotted //expr// to access deeply nested data in //table//.
89 |
90 | //expr// is a dot separated expression, either a symbol or a string.
91 | For example:
92 |
93 | {{{
94 | "a.b.c"
95 | }}}
96 |
97 | or:
98 |
99 | {{{
100 | 'a.b.c
101 | }}}
102 |
103 | If the //expr// is a symbol then the keys of the alist are also
104 | expected to be symbols.
105 |
106 | //table// is expected to be an alist currently.
107 |
108 | //func// is some sort of [[assoc]] like function.
109 |
110 |
111 | === kvdotassq expr table ===
112 |
113 | Dotted expression handling with [[assq]].
114 |
115 |
116 | === kvhash->alist hash ===
117 |
118 | Convert //hash// to an ALIST.
119 |
120 |
121 | === kvmap-bind args sexp seq ===
122 |
123 | A hybrid of [[destructuring-bind]] and [[mapcar]]
124 | //args// shall be of the form used with [[destructuring-bind]]
125 |
126 | Unlike most other mapping forms this is a macro intended to be
127 | used for structural transformations, so the expected usage will
128 | be that //args// describes the structure of the items in //seq//, and
129 | //sexp// will describe the structure desired.
130 |
131 |
132 | === kvplist->alist plist ===
133 |
134 | Convert //plist// to an alist.
135 |
136 | The keys are expected to be :prefixed and the colons are removed.
137 | The keys in the resulting alist are symbols.
138 |
139 |
140 | === kvplist->filter-keys plist &rest keys ===
141 |
142 | Filter the plist to just those matching //keys//.
143 |
144 | //keys// must actually be :-less symbols.
145 |
146 | [[kvalist->filter-keys]] is actually used to do this work.
147 |
148 | === kvplist->merge &rest plists ===
149 |
150 | Merge the 2nd and subsequent plists into the first, clobbering values set
151 | by lists to the left.
152 |
153 | === kvplist2->filter-keys plist2 &rest keys ===
154 |
155 | Return the //plist2// (a list of plists) filtered to the //keys//.
156 |
--------------------------------------------------------------------------------
/emacs-db/README.creole:
--------------------------------------------------------------------------------
1 | = Emacs Db - Key/Values stores for Emacs =
2 |
3 | An EmacsLisp interface to key/value stores (Mongo, Postgresql Hstore,
4 | etc..) with a simple default implementation based on EmacsLisp Hashtables.
5 |
6 | == The interface ==
7 |
8 | The idea behind this is to make an interface for interacting with
9 | simple key/value database stores that is portable across all such
10 | stores. So you can make code once but swap out the database with
11 | relative ease.
12 |
13 | The interface includes the following functions:
14 |
15 | === db-make reference ===
16 |
17 | Make a DB based on the //reference//.
18 |
19 | === db-get key db ===
20 |
21 | Get the value from the //db// with the //key//.
22 |
23 | === db-put key value db ===
24 |
25 | Put a new //value// into the //db// with the specified //key//.
26 |
27 | Return the //value// as it has been put into the //db//.
28 |
29 | === db-map func db &optional query filter ===
30 |
31 | Call //func// for every record in //db// optionally //query// filter.
32 |
33 | //query//, if specified, should be a list of query terms.
34 |
35 | //func// should take 2 arguments:
36 |
37 | {{{
38 | key db-value
39 | }}}
40 |
41 | where the DB-VALUE is whatever the //db// has attached to the
42 | specified KEY.
43 |
44 | This returns an alist of the KEY and the value the function
45 | returned. If //filter// is [[t]] then only pairs with a value are
46 | returned.
47 |
48 | === db-query db query ===
49 |
50 | Do //query// on //db// and return the result.
51 |
52 | This is [[db-map]] with an identity function.
53 |
54 |
55 | == Query language ==
56 |
57 | {{{db}}} uses the query language provided by the {{{kv}}} library,
58 | which is implemented as a mapping function test on ever value by the
59 | persistent hashtable implementation.
60 |
61 | The language should be translatable to just about any database query
62 | language (Mongo, SQL, etc...).
63 |
64 | There are only 3 constructs currently, {{{|}}}, {{{&}}} and {{{=}}}.
65 |
66 | An expression could be:
67 |
68 | {{{
69 | (= field-name value)
70 | }}}
71 |
72 | To select any record where {{{field-name}}} has the {{{value}}}
73 |
74 | {{{
75 | (|(= field-name value)(= other-field other-value))
76 | }}}
77 |
78 | To select any record where {{{field-name}}} has the {{{value}}}
79 | or {{{other-field}}} has the value {{{other-value}}}
80 |
81 | {{{
82 | (&(= field-name value)(= other-field other-value))
83 | }}}
84 |
85 | To select any record where {{{field-name}}} has the {{{value}}}
86 | and {{{other-field}}} has the value {{{other-value}}}.
87 |
88 | Logical combinations of {{{|}}} and {{{&}}} are also possible.
89 |
90 |
91 | == Hashtable implementation ==
92 |
93 | {{{db}}} comes with a simple implementation which can store any
94 | EmacsLisp object (though alists would most usually be preferred).
95 |
96 | To make a {{{db}}} with the hash implementation:
97 |
98 | {{{
99 | (db-make
100 | `(db-hash
101 | :filename ,(format "/var/cache/some-file")))
102 | }}}
103 |
104 | Obviously, most often you will assign the db to a global variable.
105 |
106 | {{{
107 | (defvar my-db
108 | (db-make
109 | `(db-hash
110 | :filename ,(format "/var/cache/some-file"))))
111 |
112 | (db-put "001" '(("a" . 10)("b" . 20)) my-db)
113 | (db-put "002" '(("a" . 17)("b" . "hello")("xyz" . "well!")) my-db)
114 | (db-get "002" my-db)
115 | }}}
116 |
117 | results in:
118 |
119 | {{{
120 | (("a" . 17)("b" . "hello")("xyz" . "well!"))
121 | }}}
122 |
123 | === Testing ===
124 |
125 | Hash Db's are tied to filenames so to test them you often have to
126 | manage that persistence:
127 |
128 | {{{
129 | (unwind-protect
130 | (let ((mydb (db-make `(db-hash :filename "/tmp/mydb")))
131 | (json
132 | (with-temp-buffer
133 | (insert-file-contents "~/work/elmarmalade/users-mongo.json")
134 | (goto-char (point-min))
135 | (json-read))))
136 | (--each json (db-put (car it) (cdr it) mydb))
137 | (list (db-get 'triss mydb)
138 | (db-get 'nicferrier mydb)))
139 | (delete-file "/tmp/mydb.elc"))
140 | }}}
141 |
142 | Note the deleting of the {{{elc}}} file. That's how the hash db is
143 | stored.
144 |
145 | Alternately one could use {{{fakir-file}}} (see the fakir package) to
146 | mock the file system. But that's harder than just creating and
147 | throwing away the file.
148 |
--------------------------------------------------------------------------------
/emacs-db/db-tests.el:
--------------------------------------------------------------------------------
1 | ;;; tests for the emacs db.
2 |
3 | (require 'cl)
4 | (require 'ert)
5 | (require 'db)
6 | (require 'kv)
7 |
8 | (ert-deftest db-get ()
9 | "Test the database interface and the hash implementation."
10 | ;; Make a hash-db with no filename
11 | (let ((db (db-make '(db-hash))))
12 | (should-not (db-get "test-key" db))
13 | (db-put "test-key" 321 db)
14 | (should
15 | (equal
16 | 321
17 | (db-get "test-key" db)))))
18 |
19 | (ert-deftest db-put ()
20 | "Test the put interface."
21 | (let ((db (db-make '(db-hash))))
22 | (should-not (db-get "test-key" db))
23 | (should
24 | (equal
25 | '("1" "2" "3")
26 | (db-put "test-key" '("1" "2" "3") db)))))
27 |
28 | (ert-deftest db-query ()
29 | "Test the query interfce."
30 | (let ((db (db-make '(db-hash))))
31 | (db-put "test001"
32 | '(("username" . "test001")
33 | ("title" . "Miss")
34 | ("surname" . "Test")) db)
35 | (db-put "test002"
36 | '(("username" . "test002")
37 | ("title" . "Mr")
38 | ("surname" . "Test")) db)
39 | (should
40 | (equal
41 | '(("test001"
42 | ("username" . "test001")
43 | ("title" . "Miss")
44 | ("surname" . "Test")))
45 | (db-query db '(= "username" "test001"))))))
46 |
47 | (ert-deftest db-map ()
48 | "Test the mapping."
49 | (let (collected
50 | (db (db-make '(db-hash :query-equal kvdotassoc=)))
51 | (data '(("test001"
52 | ("username" . "test001")
53 | ("title" . "Miss")
54 | ("surname" . "Test"))
55 | ("test002"
56 | ("username" . "test002")
57 | ("title" . "Mr")
58 | ("surname" . "Test")))))
59 | (loop for (key . value) in data
60 | do (db-put key value db))
61 | (db-map (lambda (key value)
62 | (setq
63 | collected
64 | (acons key value collected))) db)
65 | (should
66 | (equal
67 | (kvalist-sort collected 'kvcmp)
68 | (kvalist-sort data 'kvcmp)))))
69 |
70 | (ert-deftest db-query-deep ()
71 | "Test the query interface with a dotted query."
72 | (let ((db (db-make '(db-hash :query-equal kvdotassoc=))))
73 | (db-put "test001"
74 | '(("username" . "test001")
75 | ("details" . (("title" . "Miss")
76 | ("surname" . "Test")))) db)
77 | (db-put "test002"
78 | '(("username" . "test002")
79 | ("details" .(("title" . "Mr")
80 | ("surname" . "Tester")))) db)
81 | (should
82 | (equal
83 | '(("test001"
84 | ("username" . "test001")
85 | ("details" . (("title" . "Miss")
86 | ("surname" . "Test")))))
87 | (db-query db '(= "details.surname" "Test"))))))
88 |
89 |
90 | (ert-deftest db-hash/save ()
91 | "Test the saving of a hash db."
92 | (unwind-protect
93 | (progn
94 | (let ((db (db-make
95 | ;; You shouldn't use an extension but let db deal
96 | ;; with it.
97 | '(db-hash :filename "/tmp/test-db"))))
98 | ;; Override the save so it does nothing from put
99 | (flet ((db-hash/save (db)
100 | t))
101 | (db-put 'test1 "value1" db)
102 | (db-put 'test2 "value2" db))
103 | ;; And now save
104 | (db-hash/save db))
105 | ;; And now load in a different scope
106 | (let ((db (db-make
107 | '(db-hash :filename "/tmp/test-db"))))
108 | (should
109 | (equal "value1"
110 | (db-get 'test1 db)))))
111 | (delete-file "/tmp/test-db.elc")))
112 |
113 | (ert-deftest db-filter ()
114 | "Test the filtering."
115 | (let ((db (db-make
116 | '(db-hash :filename "/tmp/test-db"))))
117 | (db-put
118 | "test001"
119 | '(("uid" . "test001")
120 | ("fullname" . "test user 1"))
121 | db)
122 | (db-put
123 | "test002"
124 | '(("uid" . "test002")
125 | ("fullname" . "test user 2"))
126 | db)
127 | (db-put
128 | "test003"
129 | '(("uid" . "test001")
130 | ("fullname" . "test user 1"))
131 | db)
132 | (flet ((filt (key value)
133 | (cdr (assoc "fullname" value))))
134 | (let ((filtered
135 | (db-make
136 | `(db-filter
137 | :source ,db
138 | :filter filt))))
139 | (plist-get filtered :source)
140 | (should
141 | (equal (db-get "test002" filtered) "test user 2"))))))
142 |
143 | (provide 'db-tests)
144 |
145 | ;;; db-tests.el ends here
146 |
--------------------------------------------------------------------------------
/elnode-auth/elnode_tutorial.org:
--------------------------------------------------------------------------------
1 |
2 | * suggestions
3 | ** How about going from "hello world" on?
4 | *** Start with that,
5 | *** and then, move on to publishing a static file,
6 | *** then a buffer,
7 | **** with calling functions to manipulate the buffer and re-present it?
8 | ** That'd save me a fair bit of tinkering :)
9 |
10 | * installing
11 | ** use elpa/marmalade
12 | * what elnode gives you by default
13 | ** require elnode
14 | *** elnode-init
15 | **** starts a server
16 | ***** on port 8000
17 |
18 |
19 | * hello world
20 | ** install elnode with marmalade
21 | ** open a new emacs buffer C-x C-f my-elnode-hello-world.el
22 | ** make a handler
23 | (defun my-elnode-hello-world-handler (httpcon)
24 | (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
25 | (elnode-http-return
26 | httpcon
27 | "
Hello World
"))
28 | (elnode-start my-elnode-hello-world-handler 8028 "localhost")
29 | ** now evaluate that with M-x eval-buffer
30 | ** now open localhost:8028 in your browser
31 |
32 | * publish some files
33 | ** elnode provides a webserver, more accurately a fileserver
34 | ** the webserver is turned on by default
35 | ** open localhost:8000 and you should see ~/public_html
36 | *** if you don't have ~/public_html then make one?
37 | *** or configure elnode-webserver-docroot
38 | ** make a new webserver
39 | *** make a new docroot
40 | **** mkdir ~/myspecialdocroot
41 | *** put an html file in there
42 | cat < ~/myspecialdocroot/saybum.html
43 |
44 |
BUM!
45 |
46 | *** open a new emacs buffer
47 | *** put the following lisp in
48 | (defvar my-elnode-webserver-handler
49 | (elnode-webserver-handler-maker "~/myspecialdocroot"))
50 | (elnode-start my-elnode-webserver-handler 8001 "localhost")
51 | *** now evaluate that with M-x eval-buffer
52 | *** now open localhost:8001/saybum.html
53 | *** now open localhost:8001
54 | **** you should see an automatic index
55 |
56 | * stopping a server
57 | ** stop 8028
58 | ** stop 8001
59 |
60 | * add a binding to the standard server
61 | ** we can add bindings to the standard elnode server
62 | ** go back to hello world - C-x b my-elnode-hello-world.el
63 | ** remove the server-start and add this:
64 | (add-to-list 'elnode-hostpath-default-table '("/helloworld/" . my-elnode-hello-world-handler))
65 | ** so now it should be:
66 | (defun my-elnode-hello-world-handler (httpcon)
67 | (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
68 | (elnode-http-return
69 | httpcon
70 | "
Hello World
"))
71 | (add-to-list 'elnode-hostpath-default-table '("/helloworld/" . my-elnode-hello-world-handler))
72 | ** now eval the buffer with M-x eval-buffer
73 | ** now open localhost:8000/helloworld/ in your browser
74 | ** just to prove the webserver is still there, open localhost:8000/
75 | *** check it's still the directory ~/public_html
76 | ** check the variable elnode-hostpath-default-table with C-h v elnode-hostpath-default-table
77 | Its value is (("/helloworld/" . my-elnode-hello-world-handler)
78 | ("[^/]+/.*" . elnode-webserver))
79 | ** elnode-hostpath-default-table can also be customized
80 | *** but any handler will have to be loaded so you probably need to package and load your elnode module
81 |
82 | * publishing something else?
83 | ** let's try and make an online editor
84 | ** make a new file my-elnode-editor.el
85 | (defvar my-elnode-editor-buffer (get-buffer-create "*my-elnode-editor-buffer*"))
86 |
87 | (defun my-elnode-editor-handler (httpcon)
88 | (elnode-http-start httpcon 200 '("Content-Type" . "text/plain"))
89 | (elnode-http-return
90 | httpcon
91 | (with-current-buffer my-elnode-editor-buffer
92 | (buffer-substring-no-properties (point-min) (point-max)))))
93 | ** eval that
94 | ** go type some data in *my-elnode-editor-buffer*
95 | ** then M-x elnode-start my-elnode-editor-handler 8002 localhost
96 | ** try and hit localhost:8002
97 | ** go update the buffer
98 | ** refresh the webpage
99 | ** but what about someone else updating the buffer?
100 | ** make another handler to handle updates
101 | (defun my-elnode-editor-update-handler (httpcon)
102 | (let ((change-text (elnode-http-param httpcon "change")))
103 | (with-current-buffer my-elnode-editor-buffer
104 | (goto-char (point-max))
105 | (insert (if (stringp change-text)
106 | change-text
107 | ""))))
108 | (elnode-http-start httpcon 302 '("Location" . "/"))
109 | (elnode-http-return httpcon))
110 | ** now we need to map these two handlers
111 | *** one to / and the other to /update/
112 | ** make a new variable
113 | (defvar my-elnode-editor-urls
114 | `(
115 | ("$" . my-elnode-editor-handler)
116 | ("update/.*$" . my-elnode-editor-update-handler)))
117 | ** and make a dispatcher handler for the urls
118 | (defun my-elnode-editor-dispatcher-handler (httpcon)
119 | (elnode-dispatcher httpcon my-elnode-editor-urls))
120 | *** a dispatcher handler is a handler that accepts requests and dispatches them to further handlers.
121 | *** moar about dispatcher handlers.
122 | ** now stop the old server
123 | ** M-x elnode-stop 8002
124 | ** Now start the new server with the dispatcher handler
125 | ** then M-x elnode-start my-elnode-editor-dispatcher-handler 8002 localhost
126 | ** now visit localhost:8002 and see the buffer
127 | ** now visit localhost:8002/update/?change=lah+dee+dah%0d and see the updated buffer
128 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-js.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-js.el --- elnode js integration tools -*- lexical-binding: t -*-
2 |
3 | ;; Copyright (C) 2014 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords: processes, hypermedia
7 |
8 | ;; This program is free software; you can redistribute it and/or modify
9 | ;; it under the terms of the GNU General Public License as published by
10 | ;; the Free Software Foundation, either version 3 of the License, or
11 | ;; (at your option) any later version.
12 |
13 | ;; This program is distributed in the hope that it will be useful,
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | ;; GNU General Public License for more details.
17 |
18 | ;; You should have received a copy of the GNU General Public License
19 | ;; along with this program. If not, see .
20 |
21 | ;;; Commentary:
22 |
23 | ;; Often we make websites with Javascript. Elnode has built in tools
24 | ;; to help.
25 |
26 | ;; elnode-js/browserify -- let's elnode take advantage of browserify
27 | ;; to simplify your javascript (by using node's require which
28 | ;; browserify translates into the correct browser code).
29 |
30 | ;;; Code:
31 |
32 | (require 'elnode)
33 | (require 'noflet)
34 |
35 | (defun elnode-js/node-bin ()
36 | "Where is the NodeJS binary?
37 |
38 | We look in a place provided by `nodejs-repl' package or in
39 | \"~/nodejs\", \"/usr/local/bin\" or in \"/usr/bin\" in that
40 | order."
41 | (noflet ((file-exists (filename)
42 | (and (file-exists-p (expand-file-name filename)) filename)))
43 | (or (and (featurep 'nodejs-repl)
44 | (symbol-value 'nodejs-repl-command))
45 | (or (file-exists "~/nodejs/bin/nodejs")
46 | (file-exists "/usr/local/bin/nodejs")
47 | (file-exists "/usr/bin/nodejs")))))
48 |
49 | (defun elnode-js/browserify-bin (&optional directory)
50 | "Where is browserify?
51 |
52 | We search DIRECTORY, if it's supplied, and then the project root,
53 | if there is one (and if `find-file-in-project' is installed) and
54 | then the `default-directory'."
55 | (let ((browserify "node_modules/.bin/browserify"))
56 | (noflet ((file-exists (filename)
57 | (and (file-exists-p (expand-file-name filename)) filename)))
58 | (or
59 | (and directory (file-exists (expand-file-name browserify directory)))
60 | (and (let ((default-directory (expand-file-name directory)))
61 | (file-exists
62 | (expand-file-name
63 | browserify
64 | (locate-dominating-file default-directory "node_modules")))))
65 | (file-exists "node_modules/.bin/browserify")))))
66 |
67 | (defun elnode-js/browserify (httpcon docroot path)
68 | "Run browserify from DOCROOT for the PATH.
69 |
70 | Browserify is a nodejs tool that turns nodejs based Javascript
71 | into Javascript that works inside the browser.
72 |
73 | nodejs code can use nodejs's `require' form to import modules,
74 | which is simpler than many client side solutions. So browserify
75 | solves the module problem across node.js and the browser."
76 | (let ((browserify (elnode-js/browserify-bin docroot))
77 | (nodejs (elnode-js/node-bin)))
78 | (when (and nodejs browserify)
79 | (let ((process-environment
80 | (cons (format "PATH=%s:%s" nodejs (getenv "PATH"))
81 | process-environment)))
82 | (let ((default-directory docroot))
83 | (elnode-http-start httpcon 200 '(Content-type . "application/javascript")))
84 | (elnode-child-process httpcon browserify (concat docroot path))))))
85 |
86 | (defun elnode-js/browserify-send-func (httpcon targetfile)
87 | "An `elnode-send-file-assoc' function for node.js' browserify.
88 |
89 | Associate js with this function in the `elnode-send-file-assoc'
90 | alist to get automatic browserify packaging of JavaScript files
91 | served by `elnode-send-file'. This includes anything sent by the
92 | elnode webserver.
93 |
94 | An easy way of getting this effect is to use
95 | `elnode-make-js-server'."
96 | (elnode-js/browserify
97 | httpcon
98 | (file-name-directory targetfile)
99 | (file-name-nondirectory targetfile)))
100 |
101 | (defvar elnode-make-js-server/docroot-history nil
102 | "The history for the docroot in `elnode-make-js-server'.")
103 |
104 | (defvar elnode-make-js-server/port-history nil
105 | "The history for the port in `elnode-make-js-server'.")
106 |
107 | (defvar elnode-make-js-server/host-history nil
108 | "The history for the host in `elnode-make-js-server'.")
109 |
110 | ;;;###autoload
111 | (defun elnode-make-js-server (docroot port &optional host)
112 | "Make a webserver with additional js browserify support.
113 |
114 | See `elnode-make-webserver' for basic webserver details."
115 | (interactive
116 | (list
117 | (if (or (member "package.json" (directory-files default-directory))
118 | (member "node_modules" (directory-files default-directory)))
119 | default-directory
120 | (read-from-minibuffer
121 | "JS docroot: " default-directory nil nil
122 | 'elnode-make-js-server/docroot-history
123 | default-directory))
124 | (read-from-minibuffer
125 | "Port: " nil nil nil
126 | 'elnode-make-js-server/port-history)
127 | (if current-prefix-arg
128 | (read-from-minibuffer
129 | "Host: " nil nil nil
130 | 'elnode-make-js-server/host-history)
131 | elnode-init-host)))
132 | (let ((handler
133 | (lambda (httpcon)
134 | (let ((elnode-send-file-assoc
135 | '(("\\.js$" . elnode-js/browserify-send-func))))
136 | (elnode--webserver-handler-proc
137 | httpcon docroot elnode-webserver-extra-mimetypes)))))
138 | (add-to-list
139 | 'elnode--make-webserver-store
140 | (cons docroot handler))
141 | (elnode-start handler
142 | :port (string-to-number (format "%s" port))
143 | :host host)))
144 |
145 | (provide 'elnode-js)
146 |
147 | ;;; elnode-js.el ends here
148 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-lists.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-lists.el - management tools for elnode
2 |
3 | (require 'elnode)
4 | (require 'tabulated-list)
5 | (require 'noflet)
6 | (require 'dash)
7 |
8 |
9 | ;;; Deferred queue list
10 |
11 | ;;;###autoload
12 | (defun elnode-deferred-queue (arg)
13 | "Message the length of the deferred queue."
14 | (interactive "P")
15 | (if (not arg)
16 | (message
17 | "elnode deferred queue: %d %s"
18 | (length elnode--deferred)
19 | elnode--defer-timer)
20 | (setq elnode--deferred (list))
21 | (message "elnode deferred queue reset!")))
22 |
23 | (defun elnode--list-deferreds ()
24 | "List the deferred servers."
25 | ;; TODO have the defer stuff put a better reference to the actual
26 | ;; handler onto the process?
27 | ;;
28 | ;; we could have the mapper add the mapped function to the process as well?
29 | ;;
30 | ;; into a list of mapped functions on this process?
31 | (loop for (proc . deferred-closure) in elnode--deferred
32 | collect
33 | (list
34 | proc
35 | (let ((pl (process-plist proc)))
36 | (vector (apply 'format "%s:%S" (process-contact proc))
37 | (apply
38 | 'format "%s.%s.%s.%s.:%s"
39 | (mapcar 'identity (process-contact proc :local)))
40 | (symbol-name (plist-get pl :elnode-http-handler))
41 | (plist-get pl :elnode-http-resource))))))
42 |
43 | (define-derived-mode
44 | elnode-deferred-list-mode tabulated-list-mode "Elnode defered queue list"
45 | "Major mode for listing the currently deferred Elnode handlers."
46 | (setq tabulated-list-entries 'elnode--list-deferreds)
47 | (setq tabulated-list-format
48 | [("Address" 15 nil)
49 | ("Local server" 15 nil)
50 | ("Handler function" 20 nil)
51 | ("Resource" 30 nil)])
52 | (tabulated-list-init-header))
53 |
54 | ;;;###autoload
55 | (defun elnode-deferred-list (&optional prefix)
56 | "List the currently deferred Elnode handlers."
57 | (interactive "P")
58 | (with-current-buffer (get-buffer-create "*elnode deferreds*")
59 | (elnode-deferred-list-mode)
60 | (tabulated-list-print)
61 | (if prefix
62 | (switch-to-buffer-other-window (current-buffer))
63 | (switch-to-buffer (current-buffer)))))
64 |
65 | ;;;###autoload
66 | (defalias 'list-elnode-deferreds 'elnode-deferred-list)
67 |
68 | ;;; Server list
69 |
70 | (defun elnode--list-servers ()
71 | "List the current Elnode servers for `elnode-list-mode'."
72 | (noflet ((closurep (v)
73 | (and (functionp v) (listp v) (eq (car v) 'closure))))
74 | (-keep
75 | (lambda (pair)
76 | (let ((port (car pair)) (socket-proc (cdr pair)))
77 | (if (process-live-p socket-proc)
78 | (list
79 | port
80 | (let* ((fn (elnode/con-lookup socket-proc :elnode-http-handler))
81 | (doc (when (functionp fn)
82 | (documentation fn))))
83 | (vector
84 | (format "%s" port)
85 | (if (rassoc fn elnode--make-webserver-store)
86 | "elnode webserver"
87 | ;; Else it's not in the webserver list
88 | (cond
89 | ((closurep fn) (format "%S" fn))
90 | ((byte-code-function-p fn) (format "byte-code"))
91 | ((and (listp fn)(eq (car fn) 'lambda)) (format "lambda"))
92 | (t (symbol-name fn))))
93 | (or (if (and doc (string-match "^\\([^\n]+\\)" doc))
94 | (match-string 1 doc)
95 | (if (rassoc fn elnode--make-webserver-store)
96 | (car (rassoc fn elnode--make-webserver-store))
97 | "no documentation."))))))
98 | ;; If the socket isn't live then take it out
99 | (setq elnode-server-socket (delete pair elnode-server-socket))
100 | nil)))
101 | elnode-server-socket)))
102 |
103 | (defun elnode-lists-server-find-handler ()
104 | "Find the handler mentioned in the handler list."
105 | (interactive)
106 | (let ((line
107 | (buffer-substring-no-properties
108 | (line-beginning-position)
109 | (line-end-position))))
110 | (when (string-match "^[0-9]+ +\\([^ ]+\\) .*" line)
111 | (let ((handler-name (intern (match-string 1 line))))
112 | (with-current-buffer
113 | (find-file
114 | (or (symbol-file handler-name)
115 | (error "no such file")))
116 | (find-function handler-name))))))
117 |
118 | (defun elnode-lists-kill-server ()
119 | (interactive)
120 | (goto-char (line-beginning-position))
121 | (re-search-forward "^\\([^ ]+\\)" (line-end-position) t)
122 | (let ((port (cond
123 | ((> (string-to-int (match-string 1)) 0)
124 | (string-to-int (match-string 1)))
125 | ((file-exists-p (concat "/tmp/" (match-string 1)))
126 | (match-string 1)))))
127 | (when port
128 | (elnode-stop port)
129 | (let ((buffer-read-only nil))
130 | (erase-buffer)
131 | (tabulated-list-print)))))
132 |
133 | (define-derived-mode
134 | elnode-list-mode tabulated-list-mode "Elnode server list"
135 | "Major mode for listing Elnode servers currently running."
136 | (setq tabulated-list-entries 'elnode--list-servers)
137 | (define-key elnode-list-mode-map (kbd "\r")
138 | 'elnode-lists-server-find-handler)
139 | (define-key elnode-list-mode-map (kbd "k")
140 | 'elnode-lists-kill-server)
141 | (setq tabulated-list-format
142 | [("Port" 10 nil)
143 | ("Handler function" 20 nil)
144 | ("Documentation" 80 nil)])
145 | (tabulated-list-init-header))
146 |
147 | ;;;###autoload
148 | (defun elnode-server-list (&optional prefix)
149 | "List the currently running Elnode servers."
150 | (interactive "P")
151 | (with-current-buffer (get-buffer-create "*elnode servers*")
152 | (elnode-list-mode)
153 | (tabulated-list-print)
154 | (if prefix
155 | (switch-to-buffer-other-window (current-buffer))
156 | (switch-to-buffer (current-buffer)))))
157 |
158 | ;;;###autoload
159 | (defalias 'list-elnode-servers 'elnode-server-list)
160 |
161 | (provide 'elnode-list)
162 |
163 | ;;; enlode-list.el ends here
164 |
--------------------------------------------------------------------------------
/emacs-kv/kv-tests.el:
--------------------------------------------------------------------------------
1 | (require 'kv)
2 | (require 'ert)
3 |
4 | (ert-deftest kvhash->alist ()
5 | "Test making alists from hashes."
6 | (should
7 | (equal
8 | (sort
9 | (kvhash->alist
10 | (kvalist->hash '((name1 . value1)
11 | (name2 . value2))))
12 | (lambda (a b)
13 | (string-lessp (symbol-name (car a))
14 | (symbol-name (car b)))))
15 | '((name1 . value1)
16 | (name2 . value2))))
17 | (should
18 | (equal
19 | (sort '((a . 1)
20 | (c . 3)) 'kvcmp)
21 | (sort (kvhash->alist
22 | (kvalist->hash '((a . 1)(b . 2)(c . 3)))
23 | (lambda (k v) (and (memq k '(a c)) v))) 'kvcmp))))
24 |
25 | (ert-deftest kvalist-sort ()
26 | (should
27 | (equal
28 | (kvalist-sort
29 | (list '("z" . 20)
30 | '("a" . 20)
31 | '("b" . 17))
32 | 'string-lessp)
33 | '(("a" . 20)
34 | ("b" . 17)
35 | ("z" . 20)))))
36 |
37 | (ert-deftest kvalist-sort-by-value ()
38 | (should
39 | (equal
40 | (kvalist-sort-by-value
41 | (list '("z" . 20)
42 | '("a" . 20)
43 | '("b" . 17))
44 | '<)
45 | '(("b" . 17)
46 | ("z" . 20)
47 | ("a" . 20)))))
48 |
49 | (ert-deftest kvcmp ()
50 | "Test the general cmp function."
51 | (should
52 | (equal
53 | '((a . 10)(b . 20)(c . 5))
54 | (sort '((a . 10)(b . 20)(c . 5)) 'kvcmp)))
55 | (should
56 | (equal
57 | '((a . 10)(b . 20)(c . 5))
58 | (sort '((b . 20)(c . 5)(a . 10)) 'kvcmp))))
59 |
60 | (ert-deftest kvalist-keys->symbols ()
61 | "Test the key transformation."
62 | (should
63 | (equal
64 | '((a . 10)(\10 . 20)(\(a\ b\ c\) . 30))
65 | (kvalist-keys->symbols
66 | '(("a" . 10)(10 . 20)((a b c) . 30)))))
67 | (should
68 | (equal
69 | '((a . 10)(\10 . 20)(\(a\ b\ c\) . 30))
70 | (kvalist-keys->symbols
71 | '(("A" . 10)(10 . 20)((a b c) . 30))
72 | :first-fn 'downcase))))
73 |
74 | (ert-deftest kvfa ()
75 | "Destructuring kva through functions."
76 | (should
77 | (equal '("b")
78 | (kvfa "a" '((:a :b)("a" "b"))
79 | (lambda (key &rest result) result))))
80 | (should
81 | (equal "b"
82 | (kvfa "a" '((:a :b)("a" "b"))
83 | (lambda (k v &rest any) v))))
84 | (should
85 | (equal "b"
86 | (kvfa "a" '((:a . :b)("a" . "b"))
87 | (cl-function
88 | (lambda (k v &rest any) v)))))
89 | (should
90 | (equal 1
91 | (kvfa "a" '((:a :b :c 1)("a" "b" :a 1))
92 | (cl-function
93 | (lambda (k v &key a) a))))))
94 |
95 | (ert-deftest kva ()
96 | "Test the simple assoc."
97 | (should (equal :b (kva :a '((:a . :b)("a" . "b")))))
98 | (should (equal "b" (kva "a" '((:a . :b)("a" . "b")))))
99 | (should-not (kva "b" '((:a . :b)("a" . "b")))))
100 |
101 | (ert-deftest kvaq ()
102 | "Test the simple assq."
103 | (should (equal :b (kvaq :a '((:a . :b)("a" . "b")))))
104 | (should (equal 2 (kvaq 1 '((1 . 2)("a" . "b")))))
105 | (should-not (equal "b" (kvaq "a" '((:a . :b)("a" . "b")))))
106 | (should-not (kvaq "b" '((:a . :b)("a" . "b")))))
107 |
108 | (ert-deftest kvaq ()
109 | "Test the simple assq."
110 | (should (equal :b (kvaq :a '((:a . :b)("a" . "b")))))
111 | (should (equal 2 (kvaq 1 '((1 . 2)("a" . "b")))))
112 | (should-not (equal "b" (kvaq "a" '((:a . :b)("a" . "b")))))
113 | (should-not (kvaq "b" '((:a . :b)("a" . "b")))))
114 |
115 | (ert-deftest kvaqc ()
116 | "Test the simple assq."
117 | (should (equal :b (kvaqc :a '((:a . :b)("a" . "b")))))
118 | (should (equal 2 (kvaqc 1 '((1 . 2)("a" . "b")))))
119 | (should (equal "b" (kvaqc "a" '((:a . :b)("a" . "b")))))
120 | (should-not (kvaqc "b" '((:a . :b)("a" . "b")))))
121 |
122 | (ert-deftest kvassoc= ()
123 | (should
124 | (equal
125 | '("testkey" . "testvalue")
126 | (kvassoc= "testkey" "testvalue" '(("testkey" . "testvalue"))))))
127 |
128 | (ert-deftest kvassoq= ()
129 | (should
130 | (equal
131 | '(testkey . "testvalue")
132 | (kvassoq= 'testkey "testvalue" '((testkey . "testvalue")))))
133 | (should
134 | (equal
135 | '("testkey" . "testvalue")
136 | (kvassoq= "testkey" "testvalue" '(("testkey" . "testvalue")))))
137 | ;; Not sure about this - should we really find strings with symbols?
138 | (should
139 | (equal
140 | '("testkey" . "testvalue")
141 | (kvassoq= 'testkey "testvalue" '(("testkey" . "testvalue")))))
142 | ;; The nil case, the key isn't present
143 | (should
144 | (equal
145 | nil
146 | (kvassoq= 'blah "testvalue" '(("testkey" . "testvalue"))))))
147 |
148 | (ert-deftest kvalist2-filter ()
149 | (should
150 | (equal
151 | '(((a . 1)(b . 2)))
152 | (kvalist2-filter
153 | '(((a . 1)(b . 2))((c . 1)(d . 2)))
154 | (lambda (alist)
155 | (or
156 | (memq 'a (kvalist->keys alist))
157 | (memq 'b (kvalist->keys alist))))))))
158 |
159 | (ert-deftest kvquery->func ()
160 | "Test the query language."
161 | (should
162 | (equal
163 | '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
164 | (kvalist2-filter
165 | '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
166 | (kvquery->func '(|(= "a" 1)(= "d" 2))))))
167 | (should
168 | (equal
169 | '((("a" . 1)("b" . 2)))
170 | (kvalist2-filter
171 | '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
172 | (kvquery->func '(= "a" 1)))))
173 | (should
174 | (equal
175 | '()
176 | (kvalist2-filter
177 | '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
178 | (kvquery->func '(&(= "a" 1)(= "c" 1))))))
179 | (should
180 | (equal
181 | '((("a" . 1)("b" . 2)))
182 | (kvalist2-filter
183 | '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
184 | (kvquery->func '(&(= "a" 1)(= "b" 2)))))))
185 |
186 | (ert-deftest kvdotassoc ()
187 | (should
188 | (equal
189 | (dotassoc "a.b.c" '(("a" . (("b" . (("c" . 10)))))))
190 | 10)))
191 |
192 | (ert-deftest kvdotassq ()
193 | (should
194 | (equal
195 | (dotassq 'a.b.c '((a . ((b . ((c . 10)))))))
196 | 10)))
197 |
198 | (ert-deftest keyword->symbol ()
199 | "Convert keyword into a symbol without the leading `:'"
200 | (should
201 | (eq
202 | 'key
203 | (keyword->symbol :key)))
204 | (should
205 | (eq
206 | 'key
207 | (keyword->symbol 'key)))
208 | (let ((sym (gensym)))
209 | (should
210 | (eq
211 | sym
212 | (keyword->symbol sym)))))
213 |
214 |
215 | (ert-deftest kvthing->keyword ()
216 | (should (equal :one (kvthing->keyword "one")))
217 | (should (equal :one (kvthing->keyword ":one"))))
218 |
219 | (ert-deftest kvalist->plist ()
220 | "Make alists into plists."
221 | (should
222 | (equal
223 | '(:a1 value1 :a2 value2)
224 | (kvalist->plist '((a1 . value1) (a2 . value2))))))
225 |
226 | (ert-deftest kvplist->alist ()
227 | "Make plists into alists."
228 | (should
229 | (equal
230 | '((a1 . value1) (a2 . value2))
231 | (kvplist->alist '(:a1 value1 :a2 value2)))))
232 |
233 | (ert-deftest kvplist->filter-keys ()
234 | (should
235 | (equal
236 | (list :key1 "value1" :key4 10)
237 | (kvplist->filter-keys
238 | (list :key1 "value1" :key2 t :key3 '(big list of symbols) :key4 10)
239 | 'key1 'key4))))
240 |
241 | (ert-deftest kvplist-merge ()
242 | (should
243 | (equal
244 | '(:key1 "value1" :key2 "new value" :key3 "entirely new")
245 | (kvplist-merge '(:key1 "value1" :key2 "old value")
246 | '(:key2 "new value" :key3 "entirely new")))))
247 |
248 | (ert-deftest kvplist-merge-multiple ()
249 | (should
250 | (equal
251 | '(:key1 "value1" :key2 "new value" :key3 "overwritten new one" :key4 "second entirely new")
252 | (kvplist-merge '(:key1 "value1" :key2 "old value")
253 | '(:key2 "new value" :key3 "entirely new")
254 | '(:key3 "overwritten new one" :key4 "second entirely new")))))
255 |
256 | ;;; kv-tests.el ends here
257 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-wiki.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-wiki.el --- a wiki with Elnode -*- lexical-binding: t -*-
2 |
3 | ;; Copyright (C) 2010, 2011, 2012 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Maintainer: Nic Ferrier
7 | ;; Created: 5th October 2010
8 | ;; Keywords: lisp, http, hypermedia
9 |
10 | ;; This file is NOT part of GNU Emacs.
11 |
12 | ;; This program is free software; you can redistribute it and/or modify
13 | ;; it under the terms of the GNU General Public License as published by
14 | ;; the Free Software Foundation, either version 3 of the License, or
15 | ;; (at your option) any later version.
16 |
17 | ;; This program is distributed in the hope that it will be useful,
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 | ;; GNU General Public License for more details.
21 |
22 | ;; You should have received a copy of the GNU General Public License
23 | ;; along with this program. If not, see .
24 |
25 | ;;; Commentary:
26 | ;;
27 | ;; This is a Wiki Engine completely written in EmacsLisp, using Elnode
28 | ;; as a server.
29 | ;;
30 | ;;; Source code
31 | ;;
32 | ;; elnode's code can be found here:
33 | ;; http://github.com/nicferrier/elnode
34 |
35 | ;;; Style note
36 | ;;
37 | ;; This codes uses the Emacs style of:
38 | ;;
39 | ;; elnode-wiki--private-function
40 | ;;
41 | ;; for private functions.
42 |
43 |
44 | ;;; Code:
45 |
46 | (require 'elnode)
47 | (require 'db)
48 | (eval-when-compile 'fakir)
49 | (require 'creole nil 't)
50 | ;;(require 'vc)
51 |
52 | (defgroup elnode-wikiserver nil
53 | "A Wiki server written with Elnode."
54 | :group 'elnode)
55 |
56 | ;;;###autoload
57 | (defconst elnode-wikiserver-wikiroot-default
58 | (expand-file-name (concat elnode-config-directory "wiki/"))
59 | "The default location of the wiki root.
60 |
61 | This is used to detect whether elnode needs to create this
62 | directory or not.")
63 |
64 | ;;;###autoload
65 | (defcustom elnode-wikiserver-wikiroot
66 | elnode-wikiserver-wikiroot-default
67 | "The root for the Elnode wiki files.
68 |
69 | This is where elnode-wikiserver serves wiki files from."
70 | :type '(directory)
71 | :group 'elnode-wikiserver)
72 |
73 | (defcustom elnode-wikiserver-body-header
74 | ""
75 | "HTML BODY preamable of a rendered Wiki page."
76 | :type '(string)
77 | :group 'elnode-wikiserver)
78 |
79 | (defcustom elnode-wikiserver-body-footer
80 | ""
93 | "HTML BODY footter for a rendered Wiki page."
94 | :type '(string)
95 | :group 'elnode-wikiserver)
96 |
97 | (defcustom elnode-wikiserver-body-footer-not-loggedin
98 | ""
101 | "HTML BODY footter for a rendered Wiki page."
102 | :type '(string)
103 | :group 'elnode-wikiserver)
104 |
105 | (defun elnode-wiki--setup ()
106 | "Setup the wiki."
107 | (elnode--dir-setup elnode-wikiserver-wikiroot
108 | elnode-wikiserver-wikiroot-default
109 | "default-wiki-index.creole"
110 | "index.creole"
111 | "default-wiki-logo.gif"))
112 |
113 | ;; Internal wiki stuff
114 |
115 | (defvar elnode-wiki-db
116 | (db-make
117 | `(db-hash
118 | :filename
119 | ,(expand-file-name
120 | (concat elnode-config-directory "elnode-wiki-auth")))))
121 |
122 | ;; Define the authentication scheme for the wiki
123 | (elnode-defauth 'elnode-wiki-auth
124 | :auth-db elnode-wiki-db
125 | :redirect "/wiki/login/")
126 |
127 | (defun elnode-wiki-page (httpcon wikipage &optional pageinfo)
128 | "Creole render a WIKIPAGE back to the HTTPCON."
129 | ;; Otherwise just do it
130 | (elnode-http-start httpcon 200 `("Content-type" . "text/html"))
131 | (with-stdout-to-elnode httpcon
132 | (let ((page-info (or pageinfo (elnode-http-pathinfo httpcon)))
133 | (header elnode-wikiserver-body-header)
134 | (footer (if-elnode-auth httpcon 'elnode-wiki-auth
135 | elnode-wikiserver-body-footer
136 | elnode-wikiserver-body-footer-not-loggedin)))
137 | (creole-wiki
138 | wikipage
139 | :destination t
140 | :variables (list (cons 'page page-info))
141 | :body-header header
142 | :body-footer footer))))
143 |
144 | (defun elnode-wiki--text-param (httpcon)
145 | "Get the text param from HTTPCON and convert it."
146 | (replace-regexp-in-string
147 | "\r" "" ; browsers send text in DOS line ending format
148 | (elnode-http-param httpcon "wikitext")))
149 |
150 | (defun elnode-wiki--save-request (httpcon wikiroot path text)
151 | "Process an update request."
152 | (let* ((page (if path
153 | (save-match-data
154 | (string-match "/wiki/\\(.*\\)$" path)
155 | (match-string 1 path))))
156 | (comment (elnode-http-param httpcon "comment"))
157 | (file-name (if (equal page "")
158 | (concat wikiroot "index.creole")
159 | (concat (file-name-as-directory wikiroot) page)))
160 | (buffer (find-file-noselect file-name)))
161 | (with-current-buffer buffer
162 | (erase-buffer)
163 | (insert text)
164 | (save-buffer)
165 | (let ((git-buf
166 | (get-buffer-create
167 | (generate-new-buffer-name
168 | "* elnode wiki commit buf *"))))
169 | (shell-command
170 | (format "git commit -m '%s' %s" comment file-name)
171 | git-buf)
172 | (kill-buffer git-buf))
173 | (elnode-wiki-page httpcon file-name))))
174 |
175 | (defun elnode-wiki-handler (httpcon wikiroot)
176 | "A low level handler for Wiki operations.
177 |
178 | Send the Wiki page requested, which must be a file existing under
179 | the WIKIROOT, back to the HTTPCON.
180 |
181 | Update operations are protected by authentication."
182 | (elnode-method httpcon
183 | (GET
184 | (elnode-docroot-for wikiroot
185 | with target-path
186 | on httpcon
187 | do
188 | ;; Do we need to serve an index?
189 | (if (equal target-path (expand-file-name (concat wikiroot "/")))
190 | (elnode-wiki-page httpcon (concat wikiroot "/index.creole"))
191 | ;; Else it's a wiki page or some collateral
192 | (if (string-match "\\.creole$" target-path)
193 | ;; Serve a creole page
194 | (elnode-wiki-page httpcon target-path)
195 | ;; Else serve just content
196 | (elnode-send-file httpcon target-path)))))
197 | (POST
198 | (with-elnode-auth httpcon 'elnode-wiki-auth
199 | (let* ((path (elnode-http-pathinfo httpcon))
200 | (text (elnode-wiki--text-param httpcon)))
201 | (if (not (elnode-http-param httpcon "preview"))
202 | ;; A save request in which case save the new text and then
203 | ;; send the wiki text.
204 | (elnode-wiki--save-request httpcon wikiroot path text)
205 | ;; Might be a preview request in which case send back the WIKI
206 | ;; text that's been sent.
207 | (with-temp-file "/tmp/preview"
208 | (insert text))
209 | (elnode-wiki-page httpcon "/tmp/preview" path)))))))
210 |
211 | ;;;###autoload
212 | (defun elnode-wikiserver-test ()
213 | "Test whether we should serve Wiki or not."
214 | (featurep 'creole))
215 |
216 | ;;;###autoload
217 | (defun elnode-wikiserver (httpcon)
218 | "Serve Wiki pages from `elnode-wikiserver-wikiroot'.
219 |
220 | HTTPCON is the request.
221 |
222 | The Wiki server is only available if the `creole' package is
223 | provided. Otherwise it will just error."
224 | (if (not (elnode-wikiserver-test))
225 | (elnode-send-500 httpcon "The Emacs feature 'creole is required.")
226 | (elnode-auth-dispatcher httpcon 'elnode-wiki-auth
227 | (elnode-wiki--setup)
228 | (elnode-wiki-handler httpcon elnode-wikiserver-wikiroot))))
229 |
230 | (provide 'elnode-wiki)
231 |
232 | ;;; elnode-wiki.el ends here
233 |
--------------------------------------------------------------------------------
/elnode-auth/elnode.org:
--------------------------------------------------------------------------------
1 |
2 | * process logging
3 | ** log to a process
4 | ** code like this
5 | (defun nic-make-log-process (filename)
6 | (let ((log-name (format "*log-%s*" filename))
7 | (buf-name (concat " " log-name)))
8 | (start-process-shell-command
9 | log-name (get-buffer-create buf-name)
10 | (format
11 | "while read line ; do echo $line >> %s ; done"
12 | filename))))
13 | (setq nic-logger (nic-make-log-process))
14 | (process-send-string nic-logger "hello!\n")
15 | (process-send-string nic-logger "goodbye!\n")
16 | (process-send-eof nic-logger)
17 | ** elnode-log-buffer-log does logging
18 | *** it takes text, buffer-or-name
19 | *** buffer-or-name could be a process?
20 |
21 | * planned FAQ
22 | ** FAQ for installation
23 | *** why does it not start?
24 | **** have you got something running on port 8000?
25 | **** how to change the port and restart
26 |
27 | ** programming
28 | *** what's a hello world handler look like?
29 | **** the simplest elnode handler is
30 | (defun hello-world (httpcon)
31 | (elnode-send-html httpcon "Hello World"))
32 |
33 | *** how do I start a handler?
34 | **** using M-x elnode-start [RET] handler-name
35 | ***** the handler-name is any function
36 | ***** it will complete in the normal minibuffer way
37 | *** how can I make a handler serve some static files?
38 | **** so easy, like this:
39 | (setq my-webserver-handler (elnode-webserver-handler-maker "~/directory"))
40 | *** what if I want to do something a bit unusual to the file before it's served? like tempalting
41 | **** you need to write a proper handler for that
42 | **** let's say you want to replace {{{name}}} with a single word
43 | (defun my-files-handler (httpcon)
44 | (elnode-docroot-for DIRECTORY
45 | with target-filename
46 | on httpcon
47 | do
48 | (with-current-buffer (find-file-noselect target-filename)
49 | (elnode-http-start httpcon 200 '("Content-type" . "text/html"))
50 | (elnode-http-return
51 | httpcon
52 | (replace-regexp-in-string "{{{\\(.*\\)}}}" "bleh"
53 | (buffer-substring (point-min) (point-max)))))))
54 | *** the logging is crazy, can I turn if off?
55 | **** yep.
56 | M-x customize-variable [RET] elnode-log-files-directory
57 | **** and
58 | M-x customize-variable [RET] elnode-error-log-to-messages
59 | **** are 2 interesting ones
60 |
61 | ** Other questions
62 | *** What if my friends laugh at me for running a web browser in my editor?
63 | **** Get better friends? #emacs is a good source of fun people
64 | **** Alternately start a new business that uses elnode and pisses on the competition
65 | ***** because it is faster and more reliable.
66 | ***** then buy new friends.
67 | **** Or go back to using Ruby because Ruby is, ya know, really cool. Like your friends say.
68 |
69 |
70 | * auth stuff
71 | ** things auth requires
72 | *** test
73 | **** are you currently authenticated?
74 | **** most often this is testing a cookie
75 | **** on success do whatever you were going to do
76 | *** failure action
77 | **** redirect to a login page
78 | **** serve a login page
79 |
80 | ** login pages
81 | *** test
82 | **** are the credentials correct?
83 | *** success
84 | **** set a token to remember the request somehow
85 | ***** store something in the server?
86 | ****** so you can validatethe auth
87 | ******* login makes token
88 | ******* store token against username
89 | ******* put token:username:server-secretkey on cookie
90 | *******
91 | **** redirect to some page
92 | ***** maybe identified by a parameter or the referrer
93 | *** failure
94 | **** redirect to a login failed page
95 | **** return the same page with errors
96 | *** links
97 | **** registration page
98 |
99 |
100 | (with-elnode-auth
101 | (:test cookie
102 | :cookie-name my-auth
103 | :failure-type redirect
104 | :redirect "/mylogin")
105 | ...)
106 |
107 | :redirect could be:
108 |
109 | a string - which would point to a relative or absolute url which must
110 | be mapped indepentently
111 |
112 | a (dispatcher . handler) pair - a cons of a dispatcher and a handler,
113 | the dispatcher is automatically wrapped with a detector for a url
114 | that serves the handler
115 |
116 | a (dispatcher handler string) list - as for the
117 | dispatcher/handler cons but with the addition of the string to name
118 | the url to login
119 |
120 | ** idea about data/handlers
121 | *** for login, the processing of the authentication request (the username and password check) is the bit we can specify as part of the auth system
122 | **** it goes
123 | ***** get a username/password
124 | ****** and possibly other things like "cookie approval"
125 | ***** check against database
126 | ****** plus any other rules, like "cookie approval is yes"
127 | ***** make cookie
128 | ***** redirect to wherever we were supposed to be redirecting
129 | ****** this could have been specified
130 | ******* as a parameter
131 | ******* or it could be fixed
132 | ******* or looked up in the server side environment
133 | *** the bit we can't specify
134 | **** the look of the login page
135 | **** or even the url of the login page
136 | **** or how the login page works
137 | ***** we need to be able to support AJAX login
138 | ***** so you can login from the main page and from non-contextual flows
139 | *** it's frustrating because the only thing we care about on the login page is
140 | **** the login form, which is very specifiable
141 | **** particularly the url which the form POSTs to
142 | ***** which must have our auth handler on the end of it
143 | *** so we need a high level abstraction for dealing with this
144 | *** if we could specify interactive elements, like FORMs as
145 | **** a description of the data
146 | **** possibly a template
147 | ***** it should be possible to have a default template
148 | ***** client side template?
149 | **** the handler code to handle the call
150 | *** and then have those wrap in the same way as the (dispatcher . handler) form above
151 | *** reasons this would be good
152 | **** the separate description of the data means it could be used for ajax and context pages
153 | **** the template is optional
154 | ***** maybe we could have contextual templates as well
155 | ****** a template for ajax
156 | ****** a template for page
157 | **** the authentication processor is probably fixed
158 | **** this could be the tip of a larger abstraction to do better website building
159 |
160 | how about we make a function to return a wrap spec?
161 |
162 | like this:
163 |
164 | (with-elnode-auth
165 | (:test cookie
166 | :cookie-name my-auth
167 | :failure-type redirect
168 | :redirect (elnode-make-auth-wrap 'my-app form-template))
169 | ...)
170 |
171 | where (elnode-make-auth-wrap to-wrap template &optional path)
172 | => '(my-app (lambda (httpcon) (do-something-with template)) path)
173 |
174 | ** templates for auth - capturing some thoughts
175 | *** the current vogue is for mustache like templates
176 | *** these are dumb text replacers
177 | *** I prefer sed/xslt like templates
178 | **** not dumb, but more introspectively transformative
179 | *** can we make a simpler, less generic, transform language than xslt?
180 | *** it needs to transform data, such as json into HTML or XML
181 | *** things it might be
182 | **** a sequence of rules
183 | ***** for this bit of data, do this
184 | ****** { "password": "" } ->
185 | ***** questions about this
186 | ****** what's the pattern matching language???
187 | ****** how do we link the "things" together?
188 | ******* eg: BR tags?
189 | ******* wrapping individually in DIVs?
190 | **** a bunch of associated rules
191 | ***** wrap everything we produce in some tag
192 | ****** eg: FORM tags
193 |
194 |
195 | * v0.9.9 todo
196 | ** new async stuff with RLE
197 | ** default wiki page and webserver root
198 |
199 | * screencasts
200 | ** introducing elnode
201 | *** start with plain emacs24
202 | *** install marmalade
203 | *** install elnode
204 | *** what does elnode do out of the box?
205 | **** webserver
206 | **** wiki
207 | **** auth database
208 | **** logging
209 | ** programming with elnode
210 | *** start with some files
211 | *** make a webserver with elnode-webserver-handler-maker
212 | *** org-mode
213 | ** chat
214 | *** what do you need?
215 | **** a list to store chat
216 | ***** a list of triples? (username date text)
217 | **** a handler to receive the chats
218 | ***** a POST or something
219 | **** a handler for people to call to wait and receive chats
220 | ***** should use elnode-defer-or-do to check for new chats
221 | * v1.00 todo
222 | ** stuff
223 | *** vagrant image
224 | *** heroku update
225 | **** vulcan helps build the version of unix you need to host the build pack
226 | ***** http://quickleft.com/blog/hacking-heroku-with-custom-build-packs
227 | **** the buildpack
228 | ***** https://github.com/technomancy/heroku-buildpack-emacs/tree/master/bin
229 | *** ami?
230 | ** code
231 | *** defer bugs?
232 | *** logging to processes
233 | *** client server stuff
234 | *** htmlize bugs?
235 | **** these seem to be fixed by new creole
236 |
--------------------------------------------------------------------------------
/emacs-db/db.el:
--------------------------------------------------------------------------------
1 | ;;; db.el --- A database for EmacsLisp -*- lexical-binding: t -*-
2 |
3 | ;; Copyright (C) 2012 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Maintainer: Nic Ferrier
7 | ;; Keywords: data, lisp
8 | ;; Created: 23rd September 2012
9 | ;; Package-Requires: ((kv "0.0.11"))
10 | ;; Version: 0.0.6
11 |
12 | ;; This program is free software; you can redistribute it and/or modify
13 | ;; it under the terms of the GNU General Public License as published by
14 | ;; the Free Software Foundation, either version 3 of the License, or
15 | ;; (at your option) any later version.
16 |
17 | ;; This program is distributed in the hope that it will be useful,
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 | ;; GNU General Public License for more details.
21 |
22 | ;; You should have received a copy of the GNU General Public License
23 | ;; along with this program. If not, see .
24 |
25 | ;;; Commentary:
26 |
27 | ;; This is a simple database interface and implementation.
28 | ;;
29 | ;; It should be possible to specify any kind of key/value database
30 | ;; with this interface.
31 | ;;
32 | ;; The supplied implementation is an Emacs hash-table implementation
33 | ;; backed with serializing objects. It is NOT intended for anything
34 | ;; other than very simple use cases and will not scale very well at
35 | ;; all.
36 |
37 | ;; However, other implementations (mongodb, redis or PostgreSQL
38 | ;; hstore) would be easy to implement and fit in here.
39 |
40 |
41 | ;;; Code:
42 |
43 | (eval-when-compile
44 | (require 'cl))
45 | (require 'kv)
46 |
47 | (defun db/make-type-store ()
48 | "Make the type store."
49 | (make-hash-table :test 'eq))
50 |
51 | (defvar db/types (db/make-type-store)
52 | "Hash of database type ids against funcs?")
53 |
54 | (defun* db-make (reference)
55 | "Make a DB based on the REFERENCE."
56 | (if (and (listp reference)
57 | (eq 'db-hash (car reference)))
58 | ;; this should be part of what we find when we look it up?
59 | (db-hash reference)
60 | ;; Otherwise look it up...
61 | (let ((db-func (gethash (car reference) db/types)))
62 | (if (functionp db-func)
63 | (funcall db-func reference)
64 | ;; there should be a specific db error
65 | (error "no such database implementation")))))
66 |
67 | (defun db-get (key db)
68 | "Get the value from the DB with the KEY."
69 | (funcall (plist-get db :get) key db))
70 |
71 | (defun db-put (key value db)
72 | "Put a new VALUE into the DB with the specified KEY.
73 |
74 | Return the VALUE as it has been put into the DB."
75 | (funcall (plist-get db :put) key value db))
76 |
77 | (defun db-map (func db &optional query filter)
78 | "Call FUNC for every record in DB optionally QUERY filter.
79 |
80 | QUERY, if specified, should be a list of query terms as specified
81 | by `kvquery->func'.
82 |
83 | FUNC should take 2 arguments:
84 |
85 | KEY DB-VALUE
86 |
87 | where the DB-VALUE is whatever the DB has attached to the
88 | specified KEY.
89 |
90 | This returns an alist of the KEY and the value the function
91 | returned. If FILTER is `t' then only pairs with a value are
92 | returned."
93 | (let (retlist)
94 | (funcall (plist-get db :map)
95 | (lambda (key value)
96 | (when key
97 | (setq
98 | retlist
99 | (cons
100 | (funcall func key value)
101 | retlist))))
102 | db query)
103 | (if filter
104 | (loop for p in retlist
105 | if (cdr p)
106 | collect p)
107 | retlist)))
108 |
109 | (defun db-query (db query)
110 | "Do QUERY on DB and return the result.
111 |
112 | The query is as specified by `kvquery->func'.
113 |
114 | This is `db-map' with an identity function."
115 | (db-map 'kvidentity db query))
116 |
117 |
118 | ;;; Generic utility functions
119 |
120 | (defun db-copy (src-db dest-db)
121 | "Copy the data from SRC-DB into DEST-DB."
122 | (db-map (lambda (key value)
123 | ;;(unless (db-get key dest-db)
124 | (progn
125 | (db-put key value dest-db))) src-db))
126 |
127 |
128 | ;;; Hash implementation
129 |
130 | (defun db-hash (reference)
131 | "Make a db-hash database.
132 |
133 | REFERENCE comes from the call to `db-make' and should
134 | include a `:filename' key arg to point to a file:
135 |
136 | '(db-hash :filename \"/var/local/db/auth-db\")
137 |
138 | If the filename exists then it is loaded into the database.
139 |
140 | :from-filename let's you specify the source location the db will
141 | be read from. The first version of the hash db tied databases to
142 | specific filenames so you could not easily load a db from one
143 | file location into another. This has been fixed but if you need
144 | to work with a previous version's database you can use
145 | the :from-filename to specify where the db file was located."
146 | (let* ((db-plist (cdr reference))
147 | (filename (plist-get db-plist :filename))
148 | (from-filename (plist-get db-plist :from-filename))
149 | (db (list
150 | :db (make-hash-table :test 'equal)
151 | :get 'db-hash-get
152 | :put 'db-hash-put
153 | :map 'db-hash-map
154 | :query-equal (or
155 | (plist-get db-plist :query-equal)
156 | 'kvassoq=)
157 | :filename filename
158 | :from-filename from-filename)))
159 | (when (and filename
160 | (file-exists-p (concat filename ".elc")))
161 | (db-hash/read db))
162 | ;; Return the database
163 | db))
164 |
165 | (defun db-hash/read (db)
166 | "Loads the DB."
167 | (let* ((filename (plist-get db :filename))
168 | (source-filename ; this is needed for the crappy old way of
169 | ; saving with a unique filename based symbol
170 | (or
171 | (plist-get db :from-filename)
172 | filename)))
173 | (when filename
174 | (plist-put
175 | db :db
176 | (catch 'return
177 | (progn
178 | ;; The new saving mechanism causes that throw
179 | (load-file (concat filename ".elc"))
180 | ;; the old way used unique symbols
181 | (symbol-value (intern source-filename))))))))
182 |
183 | (defvar db-hash-do-not-save nil
184 | "If `t' then do not save the database.
185 |
186 | This is very useful for testing.")
187 |
188 | (defun db-hash/save (db)
189 | "Saves the DB."
190 | (unless db-hash-do-not-save
191 | (let ((filename (plist-get db :filename)))
192 | (when filename
193 | ;; Make the parent directory for the db if it doesn't exist
194 | (let ((dir (file-name-directory filename)))
195 | (unless (file-exists-p dir)
196 | (make-directory dir t)))
197 | ;; Now store the data
198 | (with-temp-file (concat filename ".el")
199 | (erase-buffer)
200 | (let ((fmt-obj (format
201 | "(throw 'return %S)"
202 | (plist-get db :db))))
203 | (insert fmt-obj)))
204 | ;; And compile it and delete the original
205 | (byte-compile-file (concat filename ".el"))
206 | (delete-file (concat filename ".el"))))))
207 |
208 |
209 | (defun db-hash-get (key db)
210 | (let ((v (gethash key (plist-get db :db))))
211 | v))
212 |
213 | (defun db-hash-map (func db &optional query)
214 | "Run FUNC for every value in DB.
215 |
216 | The QUERY is ignored. We never filter."
217 | (let* ((equal-fn (plist-get db :query-equal))
218 | (filterfn (if query
219 | (kvquery->func query :equal-func equal-fn)
220 | 'identity)))
221 | (maphash
222 | (lambda (key value)
223 | (when (funcall filterfn value)
224 | (funcall func key value)))
225 | (plist-get db :db))))
226 |
227 | (defun db-hash-put (key value db)
228 | (let ((v (puthash key value (plist-get db :db))))
229 | ;; Instead of saving every time we could simply signal an update
230 | ;; and have a timer do the actual save.
231 | (db-hash/save db)
232 | v))
233 |
234 | (defvar db/hash-clear-history nil
235 | "History variable for completing read.")
236 |
237 | (defun db-hash-clear (db)
238 | "Clear the specified DB (a hash-db)."
239 | (interactive
240 | (list (symbol-value
241 | (intern
242 | (completing-read
243 | "Database: "
244 | obarray
245 | nil
246 | 't
247 | nil
248 | 'db/hash-clear-history)))))
249 | (clrhash (plist-get db :db))
250 | (if (file-exists-p (plist-get db :filename))
251 | (delete-file (plist-get db :filename))))
252 |
253 |
254 | ;; Filter db - let's you filter another db
255 |
256 | (defun db-filter-get (key db)
257 | (let* ((filter-func (plist-get db :filter))
258 | (origin (plist-get db :source))
259 | (value (db-get key origin)))
260 | (funcall filter-func key value)))
261 |
262 | (defun db-filter-put (key value db)
263 | (let* ((filter-func (plist-get db :filter))
264 | (origin (plist-get db :source))
265 | (ret (db-put key value origin)))
266 | (funcall filter-func key ret)))
267 |
268 | (defun db-filter-map (key db &optional query)
269 | (let* ((filter-func (plist-get db :filter))
270 | (origin (plist-get db :source)))
271 | (mapcar
272 | filter-func
273 | (db-map key origin query))))
274 |
275 | (defun db-filter (reference)
276 | "Make a database object that is a filter around another.
277 |
278 | The reference should look something like:
279 |
280 | '(db-filter
281 | :source (db-hash :filename ....)
282 | :filter (lambda (value) ...)
283 |
284 | The `:filter' function takes 2 arguments: KEY and VALUE with
285 | VALUE being the returned value from the `:source' database."
286 | (let* ((ref-plist (cdr reference))
287 | (db (list
288 | :get 'db-filter-get
289 | :put 'db-filter-put
290 | :map 'db-filter-map
291 | :filter (plist-get ref-plist :filter)
292 | :source (plist-get ref-plist :source))))
293 | db))
294 |
295 | (puthash 'db-filter 'db-filter db/types)
296 |
297 | (defun db-change-timestamp ()
298 | "Place a timestamp in the kill-ring for a db change log."
299 | (interactive)
300 | (kill-new (format-time-string "\"%Y%M%d%H%M%S%N\""(current-time))))
301 |
302 | (defmacro db-change (change-db timestamp &rest change)
303 | "Do CHANGE and make a record in the CHANGE-DB with TIMESTAMP."
304 | (declare (indent 2))
305 | (let ((cdbv (make-symbol "cdbv"))
306 | (tsv (make-symbol "tsv")))
307 | `(let ((,cdbv ,change-db)
308 | (,tsv ,timestamp))
309 | (unless (db-get ,tsv ,cdbv)
310 | (progn
311 | (progn ,@change)
312 | (db-put ,tsv (list (cons "timestamp" ,tsv)) ,cdbv))))))
313 |
314 | (provide 'db)
315 |
316 | ;;; db.el ends here
317 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-proxy.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-proxy.el -- proxying with elnode -*- lexical-binding: t -*-
2 |
3 | ;;; Commentary:
4 |
5 | ;; This is stuff to let you make proxy servers with Elnode.
6 |
7 |
8 | ;;; Code:
9 |
10 | (require 's)
11 | (require 'dash)
12 | (require 'web)
13 | (require 'elnode)
14 | (require 'kv)
15 | (require 'cl) ; for destructuring-bind and defun*
16 |
17 | (defun elnode-proxy/web-hdr-hash->alist (web-hdr)
18 | (-filter
19 | (lambda (hdr-pair)
20 | (unless (member
21 | (downcase (symbol-name (car hdr-pair)))
22 | '("status-code" "status-string" "status-version"))
23 | (cons (symbol-name (car hdr-pair))
24 | (cdr hdr-pair))))
25 | (kvhash->alist web-hdr)))
26 |
27 | (defun elnode--proxy-x-forwarded-for (httpcon)
28 | "Return an X-Forwaded-For header."
29 | (let ((ipaddr (elnode-get-remote-ipaddr httpcon))
30 | (hdr (elnode-http-header httpcon "X-Forwarded-For")))
31 | (if hdr
32 | (concat hdr (format ", %s" ipaddr))
33 | ipaddr)))
34 |
35 | (defun elnode-proxy/web-client (httpc header data httpcon web-url header-filter)
36 | "The web client used for the proxying.
37 |
38 | WEB-URL is the origin URL. HEADER-FILTER is a function that will
39 | filter the alist of headers."
40 | (unless (elnode/con-get httpcon :elnode-proxy-header-sent)
41 | (let* ((headers (elnode-proxy/web-hdr-hash->alist header))
42 | (headers-x
43 | (condition-case err
44 | (funcall header-filter web-url headers)
45 | (error (prog1 headers
46 | (message
47 | "elnode-proxy/web-client: got an error %S while filtering headers %S"
48 | err headers))))))
49 | (apply 'elnode-http-start httpcon 200 headers-x))
50 | (elnode/con-put httpcon :elnode-proxy-header-sent t))
51 | (if (eq data :done)
52 | (elnode-http-return httpcon)
53 | (elnode-http-send-string httpcon data)))
54 |
55 | (defun* elnode-proxy-do (httpcon url &key header-filter)
56 | "Do proxying to URL on HTTPCON.
57 |
58 | A request is made to the specified URL. The URL may include
59 | `s-format' patterns for interpolation with any of these
60 | variables:
61 |
62 | path - the path from the HTTPCON
63 | params - the params from the HTTPCON
64 | query - the params from the HTTPCON as a query
65 |
66 | For example, \"http://myserver:8000${path}${query}\" would cause
67 | \"myserver\" on port 8000 to get the query from the user with the
68 | specified path and query.
69 |
70 | :HEADER-FILTER is an optional function which can be used to
71 | filter the headers returned from the HTTP call to the origin. The
72 | function is called with the origin URL and the headers as an
73 | a-list of symbols."
74 | (let* ((method (elnode-http-method httpcon))
75 | (path (elnode-http-pathinfo httpcon))
76 | (params (web-to-query-string
77 | (elnode-http-params httpcon)))
78 | (params-alist
79 | (list
80 | (cons "path" path)
81 | (cons "query" (if (s-blank? params) ""
82 | (concat "?" params)))
83 | (cons "params" params)))
84 | (web-url (s-format url 'aget params-alist))
85 | hdr-sent)
86 | (let ((web-con
87 | (web-http-call
88 | method
89 | (lambda (httpc hdr data)
90 | (elnode-proxy/web-client
91 | httpc hdr data httpcon web-url
92 | (if (functionp header-filter)
93 | header-filter
94 | ;; Else just pass through
95 | (lambda (url headers) headers))))
96 | :mode 'stream
97 | :url web-url
98 | :extra-headers
99 | `(("X-Forwarded-For" . ,(elnode--proxy-x-forwarded-for httpcon))
100 | ("X-Proxy-Client" . "elnode/web")))))
101 | (elnode/con-put httpcon :elnode-child-process web-con))))
102 |
103 | (defun elnode-proxy-bounce (httpcon handler host-port)
104 | "Bounce this request.
105 |
106 | If HTTPCON is not a request for port HOST-PORT then bounce to
107 | HOST-PORT, else it is a request on HOST-PORT so pass to HANDLER."
108 | (destructuring-bind (hostname this-port)
109 | (split-string (elnode-server-info httpcon) ":")
110 | (if (equal (format "%s" this-port)
111 | (format "%s" host-port))
112 | (funcall handler httpcon)
113 | (elnode-proxy-do
114 | httpcon
115 | (format "http://%s:%s${path}${query}" hostname host-port)))))
116 |
117 | (defun elnode-proxy-make-bouncer (handler host-port)
118 | "Make a proxy bouncer handler for HANDLER proc on OTHER-PORT.
119 |
120 | This is for managing proxy calls. If the resulting handler
121 | receives a call on anything than HOST-PORT then it proxies the
122 | request to the HOST-PORT. Otherwise it just handles the
123 | request."
124 | (lambda (httpcon)
125 | (elnode-proxy-bounce httpcon handler host-port)))
126 |
127 | ;;;###autoload
128 | (defun elnode-make-proxy (url)
129 | "Make a proxy handler sending requests to URL.
130 |
131 | See `elnode-proxy-do' for how URL is handled.
132 |
133 | An HTTP user-agent with a specified HTTP proxy sends the full
134 | request as the path, eg:
135 |
136 | GET http://somehost:port/path?query HTTP/1.1
137 |
138 | So `elnode-make-proxy' can make (something like) a full proxy
139 | server with:
140 |
141 | (elnode-make-proxy \"${path}${query}\")
142 |
143 | There may be many things that a full proxy does that this does
144 | not do however.
145 |
146 | Reverse proxying is a simpler and perhaps more useful.
147 |
148 | Proxying is a form of shortcut evaluation. This function returns
149 | having bound it's HTTP connection paremeter to a process which
150 | will deliver the content from the downstream HTTP connection."
151 | (lambda (httpcon)
152 | (elnode-proxy-do httpcon url)))
153 |
154 | (defvar elnode--proxy-server-port-history nil
155 | "History variable used for proxy server port reading.")
156 |
157 | (defvar elnode--proxy-server-goto-url-history nil
158 | "History variable used for proxy goto urls.")
159 |
160 | ;;;###autoload
161 | (defun elnode-make-proxy-server (port &optional url)
162 | "Make a proxy server on the specified PORT.
163 |
164 | Optionally have requests go to URL. If URL is not specified it
165 | is \"${path}${query}\".
166 |
167 | Interactively use C-u to specify the URL."
168 | (interactive
169 | (list
170 | (read-from-minibuffer
171 | "proxy server port:" nil nil nil
172 | 'elnode--proxy-server-port-history)
173 | (if current-prefix-arg
174 | (read-from-minibuffer
175 | "proxy server goto url:" "${path}${query}" nil nil
176 | 'elnode--proxy-server-goto-url-history
177 | "${path}${query}")
178 | "${path}${query}")))
179 | (let ((proxy-handler
180 | (elnode-make-proxy (or url "${path}${query}"))))
181 | (elnode-start proxy-handler :port port)))
182 |
183 |
184 | (defun elnode-send-proxy-redirect (httpcon location)
185 | "Send back a proxy redirect to LOCATION.
186 |
187 | A proxy redirect is setting \"X-Accel-Redirect\" to a location,
188 | proxies can interpret the header with some kind of internal only
189 | URL resolution mechanism and do dispatch to another backend
190 | without sending the redirect back to the origin UA."
191 | (elnode-http-header-set
192 | httpcon "X-Accel-Redirect" location)
193 | ;; This is an nginx specific hack because it seems nginx kills the
194 | ;; socket once the accel header arrives
195 | (condition-case err
196 | (elnode-send-redirect httpcon location)
197 | (error (unless (string-match
198 | "\\(SIGPIPE\\|no longer connected\\)"
199 | (format "%s" (cdr err)))
200 | (signal (car err) (cdr err))))))
201 |
202 | (defun elnode-send-proxy-location (httpcon location)
203 | "Send LOCATION with proxying techniques.
204 |
205 | If the HTTPCON comes from a proxy (detected by checking the
206 | \"X-Forwarded-For\") then an `elnode-send-proxy-redirect' to
207 | location is sent.
208 |
209 | Alternately it sets up a direct proxy call to the current server
210 | for the location. So, either way, this call causes a shortcut
211 | evaluation. Either the upstream proxy server handles the request
212 | or we return having bound the current HTTPCON to an internal
213 | proxy connection."
214 | (if (and (elnode-http-header httpcon "X-Forwarded-For")
215 | (not (equal
216 | "elnode/web"
217 | (elnode-http-header httpcon "X-Proxy-Client"))))
218 | (elnode-send-proxy-redirect httpcon location)
219 | ;; Else we're not behind a proxy, send a proxy version
220 | (let* ((server (elnode-server-info httpcon))
221 | (url (format "http://%s%s" server location)))
222 | (funcall (elnode-make-proxy url) httpcon))))
223 |
224 | (defun* elnode-proxy-post (httpcon path
225 | &key (mode 'batch)
226 | callback data extra-headers)
227 | "Make an HTTP call to localhost or the first upstream proxy."
228 | (let* ((hp-pair
229 | (if (elnode-http-header httpcon "X-Forwarded-For")
230 | (elnode-get-remote-ipaddr httpcon)
231 | (elnode-server-info httpcon)))
232 | (url (format "http://%s%s" hp-pair path)))
233 | (web-http-post
234 | (or callback
235 | (lambda (httpc hdr data)
236 | (elnode-error
237 | "%s post response %S %s"
238 | httpcon hdr data)))
239 | :url url :mode mode :data data
240 | :extra-headers extra-headers)))
241 |
242 | (defun elnode/proxy-route (httpcon service handler path)
243 | "Proxies a particular route from `elnode-route'."
244 | (let* ((server (elnode/con-get httpcon :server))
245 | (p2 path)
246 | (maps (process-get server :elnode-service-map))
247 | (port
248 | (or
249 | (kva service maps)
250 | (string-to-number
251 | (cadr
252 | (split-string
253 | (elnode-server-info httpcon) ":"))))))
254 | ;; Wrap the handler in a bouncer
255 | (elnode-proxy-bounce httpcon handler port)))
256 |
257 | (defun elnode-route (httpcon routes)
258 | "Pass HTTPCON to the handler decided by ROUTES.
259 |
260 | ROUTES is a routing table matching regexs to handlers with extra
261 | meta information. Routes may do additional things like cause a
262 | route to be proxyed to another server.
263 |
264 | Using ROUTES you can describe complex multi-process, multi-port
265 | elnode configurations.
266 |
267 | ROUTES is an alist where each element looks like:
268 |
269 | (REGEXP . FUNCTION)
270 |
271 | or:
272 |
273 | (REGEXP FUNCTION `:service' SERVICE-NAME)
274 |
275 | FUNCTION is a normal elnode handler. SERVICE-NAME is a name that
276 | may be attached to the route so that it can be mapped to a TCP
277 | port, or even another Emacs process. Mapping service names is
278 | done by `elnode-start'."
279 | (let*
280 | (services
281 | (rtable
282 | (loop for (path . resource) in table
283 | collect
284 | (if (atom resource)
285 | (list path resource)
286 | ;; Else it's a more complex resource description
287 | (let* ((handler (car resource))
288 | (service (plist-get (cdr resource) :service))
289 | ;; Make the function from the resource description
290 | (func
291 | (lambda (httpcon)
292 | (elnode/proxy-route
293 | httpcon service handler path))))
294 | (when service (push service services))
295 | (list path func))))))
296 | (elnode-hostpath-dispatcher httpcon rtable)))
297 |
298 | (provide 'elnode-proxy)
299 |
300 | ;;; elnode-proxy.el ends here
301 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-testsupport.el:
--------------------------------------------------------------------------------
1 | ;;; test support functions for elnode -*- lexical-binding: t -*-
2 |
3 | ;;; Code:
4 |
5 | (require 'noflet)
6 | (require 'ert)
7 | (require 'elnode)
8 | (require 'fakir)
9 |
10 | (defvar elnode--cookie-store nil
11 | "Cookie store for test servers.
12 |
13 | This is a special defvar for dynamic overriding by
14 | `with-elnode-mock-server'.")
15 |
16 | (defmacro with-elnode-mock-server (handler &rest body)
17 | "Execute BODY with a fake server which is bound to HANDLER.
18 |
19 | This is useful for doing end to end client testing:
20 |
21 | (ert-deftest elnode-some-page ()
22 | (with-elnode-mock-server 'elnode-hostpath-default-handler
23 | (elnode-test-call \"/something/test\")))
24 |
25 | The test call with be passed to the
26 | `elnode-hostpath-default-handler' via the normal HTTP parsing
27 | routines."
28 | (declare
29 | (indent 1)
30 | (debug t))
31 | `(let ((elnode--cookie-store (make-hash-table :test 'equal)))
32 | (noflet ((elnode/get-server-prop (proc key)
33 | (cond
34 | ((eq key :elnode-http-handler)
35 | ,handler))))
36 | ,@body)))
37 |
38 | (defmacro with-elnode-mock-httpcon (symbol elnode-plist &rest body)
39 | "Mock an HTTP connection for SYMBOL and evaluate BODY.
40 |
41 | ELNODE-PLIST is either `nil' or a list of elnode properties, such
42 | as `:elnode-http-method'."
43 | (declare
44 | (debug (sexp sexp &rest form))
45 | (indent defun))
46 | `(fakir-mock-process ,symbol ()
47 | (set-process-plist ,symbol (list (make-hash-table :test 'eq)))
48 | (elnode/con-put ,symbol ,@elnode-plist)
49 | (progn ,@body)))
50 |
51 | (defmacro elnode-mock-con (symbol bindings &rest body)
52 | "Mock an HTTP connection.
53 |
54 | This is a simple extension of `fakir-mock-process'. It does
55 | exactly what that does except it additionally sets up the elnode
56 | property hashtable on the process plist."
57 | (declare (debug (sexp sexp &rest form))
58 | (indent defun))
59 | `(fakir-mock-process ,symbol ,bindings
60 | (progn
61 | (set-process-plist ,symbol (list (make-hash-table :test 'eq)))
62 | ,@body)))
63 |
64 |
65 | (defmacro elnode-sink (httpcon &rest body)
66 | "Sink the HTTP response from BODY.
67 |
68 | Output to `elnode-http-start', `elnode-http-send-string' and
69 | `elnode-http-return' is collected and stored internallly.
70 |
71 | When `elnode-http-return' is called the form ends with a string
72 | result of whatever was sent as the response. The string is
73 | propertized with the header sent to `elnode-http-start'."
74 | (declare (indent 1)(debug (sexp &rest form)))
75 | `(let (res reshdr)
76 | (catch :elnode-sink-ret
77 | (noflet ((elnode-http-start (httpcon status &rest header)
78 | (setq reshdr
79 | (kvalist->plist header)))
80 | (elnode-http-header-set (httpcon header &optional value)
81 | (setq reshdr
82 | (plist-put (intern (concat ":" reshdr))
83 | header value)))
84 | (elnode-http-send-string (httpcon data)
85 | (setq res (apply 'propertize
86 | (concat res data) reshdr)))
87 | (elnode-http-return (httpcon &optional data)
88 | (when data
89 | (setq res (apply 'propertize
90 | (concat res data) reshdr)))
91 | (throw :elnode-sink-ret :end)))
92 | ,@body))
93 | res))
94 |
95 | (defmacro elnode-fake-params (httpcon params-list &rest body)
96 | "Fake the PARAM-BINDINGS and evaluate BODY.
97 |
98 | PARAM-BINDINGS is an ALIST with string cars for parameter names
99 | and string cdrs for values. A cdr of a list can be used to
100 | provide a string value with a property list, for example:
101 |
102 | '((\"param1\" . \"value\" )
103 | (\"param2\" \"value\" :elnode-filename \"somefile.txt\"))
104 |
105 | Note the first parameter is an improper list.
106 |
107 | PARAM-BINDINGS should be quoted."
108 | (declare (indent 2)
109 | (debug (sexp sexp &rest form)))
110 | (let ((httpconv (make-symbol "httpconv"))
111 | (paramsv (make-symbol "paramsv")))
112 | `(let ((,httpconv ,httpcon)
113 | (,paramsv ,params-list))
114 | (noflet ((elnode-http-param (httpc param-name)
115 | (if (eq httpc ,httpcon)
116 | (let ((v (kva param-name ,paramsv)))
117 | (cond
118 | ((listp v)
119 | (apply 'propertize (car v) (cdr v)))
120 | (t v)))
121 | (funcall this-fn httpcon param-name))))
122 | ,@body))))
123 |
124 |
125 | ;; Extensions to ert
126 |
127 | (defmacro should-equal (a b)
128 | "Simple shortcut for `(should (equal a b))'."
129 | `(should
130 | (equal ,a ,b)))
131 |
132 | (defmacro should-match (regex a)
133 | "Simple shortcut for a `string-match' with `should'."
134 | `(should
135 | (string-match
136 | ,regex
137 | ,a)))
138 |
139 | (defmacro* should-elnode-response (call
140 | &key
141 | status-code
142 | header-name
143 | header-value
144 | header-list
145 | header-list-match
146 | body-match)
147 | "Assert on the supplied RESPONSE.
148 |
149 | CALL should be an `elnode-test-call', something that can make a
150 | response. Assertions are done by checking the specified values
151 | of the other parameters to this function.
152 |
153 | If STATUS-CODE is not nil we assert that the RESPONSE status-code
154 | is equal to the STATUS-CODE.
155 |
156 | If HEADER-NAME is present then we assert that the RESPONSE has
157 | the header and that its value is the same as the HEADER-VALUE.
158 | If HEADER-VALUE is `nil' then we assert that the HEADER-NAME is
159 | NOT present.
160 |
161 | If HEADER-LIST is present then we assert that all those headers
162 | are present and `equal' to the value.
163 |
164 | If HEADER-LIST-MATCH is present then we assert that all those
165 | headers are present and `equal' to the value.
166 |
167 | If BODY-MATCH is present then it is a regex used to match the
168 | whole body of the RESPONSE."
169 | (let ((status-codev (make-symbol "status-codev"))
170 | (header-namev (make-symbol "header-namev"))
171 | (header-valuev (make-symbol "header-valuev"))
172 | (header-listv (make-symbol "header-listv"))
173 | (header-list-matchv (make-symbol "header-list-match"))
174 | (body-matchv (make-symbol "body-matchv"))
175 | (responsev (make-symbol "responsev")))
176 | `(let ((,responsev ,call)
177 | (,status-codev ,status-code)
178 | (,header-namev ,header-name)
179 | (,header-valuev ,header-value)
180 | (,header-listv ,header-list)
181 | (,header-list-matchv ,header-list-match)
182 | (,body-matchv ,body-match))
183 | (when ,status-codev
184 | (should
185 | (equal
186 | ,status-codev
187 | (plist-get ,responsev :status))))
188 | (when (or ,header-namev ,header-listv ,header-list-matchv)
189 | (let ((hdr (plist-get ,responsev :header)))
190 | (when ,header-namev
191 | (if ,header-valuev
192 | (should
193 | (equal
194 | ,header-valuev
195 | (assoc-default ,header-namev hdr)))
196 | ;; Else we want to ensure the header isn't there
197 | (should
198 | (eq nil (assoc-default ,header-namev hdr)))))
199 | (when ,header-listv
200 | (loop for reqd-hdr in ,header-listv
201 | do (should
202 | (equal
203 | (assoc-default (car reqd-hdr) hdr)
204 | (cdr reqd-hdr)))))
205 | (when ,header-list-matchv
206 | (loop for reqd-hdr in ,header-list-matchv
207 | do (should
208 | (>=
209 | (string-match
210 | (cdr reqd-hdr)
211 | (assoc-default (car reqd-hdr) hdr)) 0))))))
212 | (when ,body-matchv
213 | (should-match
214 | ,body-matchv
215 | (plist-get ,responsev :result-string))))))
216 |
217 |
218 | (defmacro* assert-elnode-response (call
219 | &key
220 | status-code
221 | header-name
222 | header-value
223 | header-list
224 | header-list-match
225 | body-match)
226 | "Assert on the supplied RESPONSE.
227 |
228 | CALL should be an `elnode-test-call', something that can make a
229 | response. Assertions are done by checking the specified values
230 | of the other parameters to this function.
231 |
232 | If STATUS-CODE is not nil we assert that the RESPONSE status-code
233 | is equal to the STATUS-CODE.
234 |
235 | If HEADER-NAME is present then we assert that the RESPONSE has
236 | the header and that its value is the same as the HEADER-VALUE.
237 | If HEADER-VALUE is `nil' then we assert that the HEADER-NAME is
238 | NOT present.
239 |
240 | If HEADER-LIST is present then we assert that all those headers
241 | are present and `equal' to the value.
242 |
243 | If HEADER-LIST-MATCH is present then we assert that all those
244 | headers are present and `equal' to the value.
245 |
246 | If BODY-MATCH is present then it is a regex used to match the
247 | whole body of the RESPONSE."
248 | (let ((status-codev (make-symbol "status-codev"))
249 | (header-namev (make-symbol "header-namev"))
250 | (header-valuev (make-symbol "header-valuev"))
251 | (header-listv (make-symbol "header-listv"))
252 | (header-list-matchv (make-symbol "header-list-match"))
253 | (body-matchv (make-symbol "body-matchv"))
254 | (responsev (make-symbol "responsev")))
255 | `(let ((,responsev ,call)
256 | (,status-codev ,status-code)
257 | (,header-namev ,header-name)
258 | (,header-valuev ,header-value)
259 | (,header-listv ,header-list)
260 | (,header-list-matchv ,header-list-match)
261 | (,body-matchv ,body-match))
262 | (when ,status-codev
263 | (assert
264 | (equal
265 | ,status-codev
266 | (plist-get ,responsev :status))))
267 | (when (or ,header-namev ,header-listv ,header-list-matchv)
268 | (let ((hdr (plist-get ,responsev :header)))
269 | (when ,header-namev
270 | (if ,header-valuev
271 | (assert
272 | (equal
273 | ,header-valuev
274 | (assoc-default ,header-namev hdr)))
275 | ;; Else we want to ensure the header isn't there
276 | (assert
277 | (eq nil (assoc-default ,header-namev hdr)))))
278 | (when ,header-listv
279 | (loop for reqd-hdr in ,header-listv
280 | do (assert
281 | (equal
282 | (assoc-default (car reqd-hdr) hdr)
283 | (cdr reqd-hdr)))))
284 | (when ,header-list-matchv
285 | (loop for reqd-hdr in ,header-list-matchv
286 | do (assert
287 | (>=
288 | (string-match
289 | (cdr reqd-hdr)
290 | (assoc-default (car reqd-hdr) hdr)) 0))))))
291 | (when ,body-matchv
292 | (assert
293 | (string-match ,body-matchv (plist-get ,responsev :result-string))))
294 | ,responsev)))
295 |
296 | (provide 'elnode-testsupport)
297 |
298 | ;;; elnode-testsupport.el ends here
299 |
--------------------------------------------------------------------------------
/elpakit-tests.el:
--------------------------------------------------------------------------------
1 | ;;; Tests for elpakit -*- lexical-binding: t -*-
2 |
3 | (require 'ert)
4 | (require 'shadchen)
5 | (require 'noflet)
6 |
7 | (ert-deftest elpakit/mematch ()
8 | (should
9 | (equal
10 | (list "README.md")
11 | (elpakit/mematch
12 | "README\\..*"
13 | (list "some.el" "files.txt" "README.md"))))
14 | (should-not
15 | (elpakit/mematch
16 | "README\\..*"
17 | (list "some.el" "files.txt"))))
18 |
19 | (ert-deftest elpakit/find-recipe ()
20 | "Test whether we can find a recipt file of not"
21 | (should
22 | (equal
23 | (concat
24 | (file-name-directory
25 | (or
26 | (buffer-file-name)
27 | load-file-name
28 | default-directory))
29 | "emacs-kv/recipes/kv")
30 | (elpakit/find-recipe "emacs-kv"))))
31 |
32 | (ert-deftest elpakit/infer-files ()
33 | "Test the file inferring."
34 | (should
35 | (noflet ((elpakit/git-files (package-dir) ; fake the git-files for the fake package
36 | (directory-files "emacs-db" nil "^[^.#].*[^#~]$")))
37 | (equal
38 | (match
39 | (elpakit/infer-files "emacs-db")
40 | ((plist :elisp-files elisp :test-files tests)
41 | (list elisp tests)))
42 | '(("db.el" "db-tests.el")
43 | ("db-tests.el"))))))
44 |
45 | (defmacro elpakit-test/fake-git-files (package-dir &rest body)
46 | "Used to fake `elpakit/git-files' around BODY."
47 | (declare (debug (sexp &rest form))
48 | (indent 1))
49 | `(noflet ((elpakit/git-files (package-dir)
50 | (directory-files package-dir nil "^[^.#].*[^#~]$")))
51 | ,@body))
52 |
53 | (ert-deftest elpakit/infer-recipe ()
54 | "Show what an inferred recipe will look like."
55 | ;; A single file package - easy to infer
56 | (equal
57 | (elpakit-test/fake-git-files "emacs-db"
58 | (elpakit/infer-recipe "emacs-db"))
59 | '("db" :files ("db.el") :test (:files ("db-tests.el"))))
60 | ;; A recipe we can't infer because there's no version
61 | (equal
62 | (condition-case err
63 | (elpakit-test/fake-git-files "elnode-auth"
64 | (elpakit/infer-recipe "elnode"))
65 | (error :no-infer))
66 | :no-infer)
67 | ;; A multifile package we can infer because there's a file with version header
68 | (equal
69 | (elpakit-test/fake-git-files "demo-multifile"
70 | (elpakit/infer-recipe "demo-multifile"))
71 | '("demo-multifile"
72 | :version "0.0.1"
73 | :doc "a demonstration multifile package"
74 | :files ("demo-multifile.el" "demo-2.el"))))
75 |
76 | (ert-deftest elpakit/files-to-elisp ()
77 | "What files in the package are elisp?
78 |
79 | Even when we have elisp files that should not be listed, like in
80 | \"fake-package-with-elisp\"."
81 | (equal
82 | (elpakit/files-to-elisp
83 | (elpakit/package-files
84 | (elpakit/get-recipe "fake-package-with-elisp"))
85 | "fake-package-with-elisp")
86 | (list
87 | (expand-file-name
88 | "fake-package.el"
89 | (expand-file-name "fake-package-with-elisp")))))
90 |
91 | (ert-deftest elpakit/file->package ()
92 | "Test turning a file into a package and the access API."
93 | ;; First prove we have the right native type
94 | (should
95 | (with-elpakit-new-package-api
96 | (package-desc-p (elpakit/file->package
97 | (expand-file-name
98 | "db.el" (expand-file-name "emacs-db" "."))))
99 | (vectorp (elpakit/file->package "db.el"))))
100 | ;; Then prove we've abstracted it
101 | (should
102 | (equal
103 | '("0.0.6" "db")
104 | (elpakit/file->package
105 | (expand-file-name
106 | "db.el" (expand-file-name "emacs-db" "."))
107 | :version :name))))
108 |
109 | (ert-deftest elpakit/package-files ()
110 | (should
111 | (equal
112 | (list (concat (ertx-this-package-dir) "emacs-db/db.el"))
113 | (elpakit/package-files (elpakit/get-recipe "emacs-db")))))
114 |
115 | (ert-deftest elpakit/make-pkg-lisp ()
116 | (condition-case nil
117 | (delete-directory "/tmp/elpakittest/db-0.0.6" t)
118 | (error nil))
119 | (make-directory "/tmp/elpakittest/db-0.0.6" t)
120 | (with-temp-buffer
121 | (insert-file-contents "emacs-db/db.el")
122 | (elpakit/make-pkg-lisp
123 | "/tmp/elpakittest/db-0.0.6"
124 | (save-excursion (package-buffer-info))))
125 | (should
126 | (equal
127 | (concat "(define-package \"db\" \"0.0.6\" "
128 | "\"A database for EmacsLisp\" (quote ((kv \"0.0.11\"))))\n")
129 | (with-temp-buffer
130 | (insert-file-contents "/tmp/elpakittest/db-0.0.6/db-pkg.el")
131 | (buffer-substring-no-properties (point-min) (point-max))))))
132 |
133 | (ert-deftest elpakit/build-single ()
134 | (condition-case nil
135 | (delete-directory "/tmp/elpakittest" t)
136 | (error nil))
137 | (elpakit/build-single "/tmp/elpakittest" "emacs-db/db.el")
138 | ;;; (should (file-exists-p "/tmp/elpakittest/db-0.0.1/db-pkg.el"))
139 | ;;; (should (file-exists-p "/tmp/elpakittest/db-0.0.1/db-autoloads.el"))
140 | (should (file-exists-p "/tmp/elpakittest/db-0.0.6/db.el")))
141 |
142 | (ert-deftest elpakit/do ()
143 | "Test that we can do a single file package."
144 | (condition-case nil
145 | (delete-directory "/tmp/elpakittest" t)
146 | (error nil))
147 | (should
148 | (equal
149 | (elpakit/package-info
150 | (cdr (car (elpakit/do "/tmp/elpakittest" "emacs-db")))
151 | :name :reqs :summary :version)
152 | `("db"
153 | ((kv (0 0 11)))
154 | "A database for EmacsLisp"
155 | "0.0.6")))
156 | ;; Not doing either autoloads OR pkg files for singles now
157 | ;;; (should (file-exists-p "/tmp/elpakittest/db-0.0.1/db-autoloads.el"))
158 | ;;; (should (file-exists-p "/tmp/elpakittest/db-0.0.1/db-pkg.el"))
159 | (should (file-exists-p "/tmp/elpakittest/db-0.0.6/db.el")))
160 |
161 | (ert-deftest elpakit/recipe->package-decl ()
162 | (let ((recipe
163 | '(elnode
164 | :version "0.9.9.1"
165 | :doc "The Emacs webserver."
166 | :files ("elnode.el"
167 | "elnode-tests.el"
168 | "elnode-rle.el"
169 | "elnode-wiki.el"
170 | "default-wiki-index.creole"
171 | "default-webserver-test.html"
172 | "default-webserver-image.png"
173 | "README.creole"
174 | "COPYING")
175 | :requires((web "0.1.4")
176 | (db "0.0.1")
177 | (kv "0.0.9")
178 | (fakir "0.0.14")
179 | (creole "0.8.14")))))
180 | ;; FIXME test the README stuff - elnode is a crap example because
181 | ;; it has a massive readme
182 | (should
183 | (equal
184 | '(define-package "elnode" "0.9.9.1"
185 | "The Emacs webserver."
186 | ((web "0.1.4")
187 | (db "0.0.1")
188 | (kv "0.0.9")
189 | (fakir "0.0.14")
190 | (creole "0.8.14")))
191 | (elpakit/recipe->package-decl recipe)))))
192 |
193 | (defun elpakit-test/tar-ls (tar-file)
194 | "Files in the TAR-FILE to a list."
195 | (--filter
196 | (not (equal it ""))
197 | (--map
198 | (replace-regexp-in-string ".*/\\([^/]*\\)" "\\1" it)
199 | (split-string
200 | (shell-command-to-string
201 | (concat
202 | "tar tf " tar-file))
203 | "\n"))))
204 |
205 | (ert-deftest elpakit/build-multi ()
206 | "Build a multi file package from a recipe."
207 | (condition-case nil
208 | (delete-directory "/tmp/elpakittest" t)
209 | (error nil))
210 | (should
211 | (equal
212 | '("elnode"
213 | ((web (0 4 3))
214 | (dash (1 1 0))
215 | (noflet (0 0 7))
216 | (s (1 5 0))
217 | (creole (0 8 14))
218 | (fakir (0 1 6))
219 | (db (0 0 5))
220 | (kv (0 0 17)))
221 | "The Emacs webserver."
222 | "0.9.9.8.7")
223 | ;; Return the package info WITHOUT the README
224 | (elpakit/package-info
225 | (elpakit/build-multi "/tmp/elpakittest" (elpakit/get-recipe "elnode-auth"))
226 | :name :reqs :summary :version)))
227 | ;; Test the interveening files
228 | (should (file-exists-p "/tmp/elnode-0.9.9.8.7/elnode.el"))
229 | (should (file-exists-p "/tmp/elnode-0.9.9.8.7/elnode-pkg.el"))
230 | ;; Test the tar ball
231 | (should (file-exists-p "/tmp/elpakittest/elnode-0.9.9.8.7.tar"))
232 | (should (member "elnode.el" (elpakit-test/tar-ls "/tmp/elpakittest/elnode-0.9.9.8.7.tar")))
233 | (should (member "elnode-proxy.el" (elpakit-test/tar-ls "/tmp/elpakittest/elnode-0.9.9.8.7.tar"))))
234 |
235 | (ert-deftest elpakit/build-multi-inferred ()
236 | "Build a multi file package from inference."
237 | (condition-case nil
238 | (delete-directory "/tmp/elpakittest" t)
239 | (error nil))
240 | (should
241 | (equal
242 | '("elnode"
243 | ((web (0 4 3))
244 | (dash (1 1 0))
245 | (noflet (0 0 7))
246 | (s (1 5 0))
247 | (creole (0 8 14))
248 | (fakir (0 1 6))
249 | (db (0 0 5))
250 | (kv (0 0 17)))
251 | "The Emacs webserver."
252 | "0.9.9.8.7")
253 | ;; Return the package info WITHOUT the README
254 | (elpakit/package-info
255 | (elpakit/build-multi "/tmp/elpakittest" (elpakit/get-recipe "elnode-auth"))
256 | :name :reqs :summary :version)))
257 | ;; Test the interveening files
258 | (should (file-exists-p "/tmp/elnode-0.9.9.8.7/elnode.el"))
259 | (should (file-exists-p "/tmp/elnode-0.9.9.8.7/elnode-pkg.el"))
260 | ;; Test the tar ball
261 | (should (file-exists-p "/tmp/elpakittest/elnode-0.9.9.8.7.tar"))
262 | (should (member "elnode.el" (elpakit-test/tar-ls "/tmp/elpakittest/elnode-0.9.9.8.7.tar")))
263 | (should (member "elnode-proxy.el" (elpakit-test/tar-ls "/tmp/elpakittest/elnode-0.9.9.8.7.tar"))))
264 |
265 | (ert-deftest elpakit/do-multi ()
266 | ;; Test the do for a multi-file package
267 | (should
268 | (equal
269 | '("elnode"
270 | ((web (0 4 3))
271 | (dash (1 1 0))
272 | (noflet (0 0 7))
273 | (s (1 5 0))
274 | (creole (0 8 14))
275 | (fakir (0 1 6))
276 | (db (0 0 5))
277 | (kv (0 0 17)))
278 | "The Emacs webserver."
279 | "0.9.9.8.7")
280 | ;; Return the package info WITHOUT the README
281 | (elpakit/package-info
282 | (cdar (elpakit/do "/tmp/elpakittest" "elnode-auth"))
283 | :name :reqs :summary :version))))
284 |
285 | (ert-deftest elpakit/recipe->pkg-info ()
286 | "Test turning recipe into the internal vector package type."
287 | (let ((recipe
288 | '(elnode
289 | :version "0.9.9.1"
290 | :doc "The Emacs webserver."
291 | :files ("elnode.el"
292 | "elnode-tests.el"
293 | "elnode-rle.el"
294 | "elnode-wiki.el"
295 | "default-wiki-index.creole"
296 | "default-webserver-test.html"
297 | "default-webserver-image.png"
298 | "README.creole"
299 | "COPYING")
300 | :requires ((web "0.1.4")
301 | (db "0.0.1")
302 | (kv "0.0.9")
303 | (fakir "0.0.14")
304 | (creole "0.8.14")))))
305 | (should
306 | (equal
307 | '("elnode"
308 | ((web (0 1 4))
309 | (db (0 0 1))
310 | (kv (0 0 9))
311 | (fakir (0 0 14))
312 | (creole (0 8 14)))
313 | "The Emacs webserver."
314 | "0.9.9.1")
315 | ;; We do take off the README
316 | (elpakit/package-info
317 | (elpakit/recipe->pkg-info recipe)
318 | :name :reqs :summary :version)))))
319 |
320 | (ert-deftest elpakit/pjg-info->versioned-name ()
321 | "Test turning recipe into the internal vector package type."
322 | (let ((recipe
323 | '(elnode
324 | :version "0.9.9.1"
325 | :doc "The Emacs webserver."
326 | :files ("elnode.el"
327 | "elnode-tests.el"
328 | "elnode-rle.el"
329 | "elnode-wiki.el"
330 | "default-wiki-index.creole"
331 | "default-webserver-test.html"
332 | "default-webserver-image.png"
333 | "README.creole"
334 | "COPYING")
335 | :requires ((web "0.1.4")
336 | (db "0.0.1")
337 | (kv "0.0.9")
338 | (fakir "0.0.14")
339 | (creole "0.8.14")))))
340 | (should
341 | (equal "elnode-0.9.9.1"
342 | (elpakit/pkg-info->versioned-name
343 | (elpakit/recipe->pkg-info recipe))))))
344 |
345 | ;;; elpakit-tests.el ends here
346 |
--------------------------------------------------------------------------------
/elnode-auth/elnode_tutorial.creole:
--------------------------------------------------------------------------------
1 | = Getting Started with Elnode - the webserver for Emacs =
2 |
3 | This is a tutorial that will hopefully show you how to install and get
4 | started making web services with Elnode.
5 |
6 | Elnode is a node.js like webserver tool for Emacs. It let's you make
7 | and run web servers and services from inside Emacs.
8 |
9 |
10 | == Installing Elnode ==
11 |
12 | You should install Elnode from the package available on
13 | [[http://marmalade-repo.org/packages/elnode|Marmalade]].
14 |
15 | For dealing with package repositories check out the
16 | [[http://www.emacswiki.org/emacs/ELPA|Emacs Wiki]] but the short version
17 | is to add the following to your {{{.emacs}}} or your
18 | {{{.emacs.d/init.el}}}:
19 |
20 | {{{
21 | (add-to-list
22 | 'package-archives
23 | '("marmalade" . "http://marmalade-repo.org/packages/"))
24 | }}}
25 |
26 | And then do:
27 |
28 | {{{
29 | M-x list-packages
30 | }}}
31 |
32 | find Elnode in the list and press {{{i}}} or {{{RET}}} to install it.
33 |
34 | If you don't want to use packages you can just install {{{elnode.el}}}
35 | on your {{{load-path}}} somewhere and:
36 |
37 | {{{
38 | (require 'elnode)
39 | }}}
40 |
41 | == Hello World! ==
42 |
43 | Now we've installed Elnode you'll want to start making web services
44 | with it. Let's start with a Hello World example.
45 |
46 | open a new Emacs file
47 |
48 | {{{
49 | C-x C-f my-elnode-hello-world.el
50 | }}}
51 |
52 | enter the Lisp code for the handler, for that old time feel you could type this in, or if you're under 35, maybe just cut and paste
53 |
54 | {{{
55 | (defun my-elnode-hello-world-handler (httpcon)
56 | (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
57 | (elnode-http-return
58 | httpcon
59 | "
Hello World
"))
60 | (elnode-start 'my-elnode-hello-world-handler :port 8028 :host "localhost")
61 | }}}
62 |
63 | make the Lisp code //live//
64 |
65 | {{{
66 | M-x eval-buffer
67 | }}}
68 |
69 | now open [[http://localhost:8028]] in your browser - you should see //Hello World!//
70 |
71 |
72 | == Publish some files ==
73 |
74 | Elnode provides a builtin webserver that can serve files from a
75 | directory on your computer. The Elnode webserver is turned on by
76 | default (it's all configurable though).
77 |
78 | === The default webserver ===
79 |
80 | By default the webserver delivers files from:
81 |
82 | {{{
83 | ~/public_html
84 | }}}
85 |
86 | so if you have a public_html directory in your home directory then
87 | just browse to [[http://localhost:8000]] and you should see an index
88 | of that directory.
89 |
90 | If you don't have a {{{~/public_html}}} directory then just make one
91 | and drop a file or two in it.
92 |
93 | Alternately, try configuring the webserver root directory:
94 |
95 | {{{
96 | M-x customize-variable RET elnode-webserver-docroot RET
97 | }}}
98 |
99 | to another directory. Then try hitting [[http://localhost:8000]]
100 | again.
101 |
102 |
103 | === Making another webserver ===
104 | Now let's make a new webserver service.
105 |
106 | Make a new docroot:
107 |
108 | {{{
109 | mkdir ~/myspecialdocroot
110 | }}}
111 |
112 | Put an html file in there:
113 |
114 | {{{
115 | cat < ~/myspecialdocroot/saybum.html
116 |
117 |
BUM!
118 |
119 | }}}
120 |
121 | Now we have something to serve we can use Elnode to make the web service.
122 |
123 | Open a new Emacs file:
124 |
125 | {{{
126 | C-x C-f my-elnode-webserver.el
127 | }}}
128 |
129 | Add this Lisp:
130 |
131 | {{{
132 | (defconst my-elnode-webserver-handler
133 | (elnode-webserver-handler-maker "~/myspecialdocroot"))
134 | (elnode-start my-elnode-webserver-handler :port 8001 :host "localhost")
135 | }}}
136 |
137 | Now evaluate that with: {{{M-x eval-buffer}}}
138 |
139 | Now open [[http://localhost:8001/saybum.html]]
140 |
141 | Now open [[http://localhost:8001]] - you should see an automated index
142 | of {{{~/myspecialdocroot}}}.
143 |
144 | == Stopping a server ==
145 |
146 | We've started a couple of servers now. Let's stop the two servers that
147 | we've started:
148 |
149 | {{{
150 | M-x elnode-stop RET 8028 RET
151 | M-x elnode-stop RET 8001 RET
152 | }}}
153 |
154 | Those servers are now stopped and you won't be able to hit them.
155 |
156 | == Add a binding to the builtin server ==
157 |
158 | Instead of starting new servers all the time we can add bindings to
159 | the standard Elnode server. Why would we do this? I think using a
160 | separate server for developing something initially is a good idea, but
161 | then you either have something you want to package up as it's own
162 | server (a wiki engine you've developed and want to give to other
163 | people, for example) or you have something you want to make available
164 | in your own default server. Of course, it's always a judgement, the
165 | way URLs work mean that you can pretty much always make any service
166 | available on it's own server or under a URL on another one.
167 |
168 | Let's make our Hello World example available again by binding it to
169 | the default server (which is still listening on port 8000 if you
170 | haven't changed anything).
171 |
172 | Go back to hello world:
173 |
174 | {{{
175 | C-x b my-elnode-hello-world.el
176 | }}}
177 |
178 | Remove the {{{elnode-start}}} line and add this:
179 |
180 | {{{
181 | (add-to-list 'elnode-hostpath-default-table '("/helloworld/" . my-elnode-hello-world-handler))
182 | }}}
183 |
184 | So now it should look like this:
185 |
186 | {{{
187 | (defun my-elnode-hello-world-handler (httpcon)
188 | (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
189 | (elnode-http-return
190 | httpcon
191 | "
Hello World
"))
192 | (add-to-list 'elnode-hostpath-default-table '("/helloworld/" . my-elnode-hello-world-handler))
193 | }}}
194 |
195 | Now eval the buffer with {{{M-x eval-buffer}}}
196 |
197 | Now open [[http://localhost:8000/helloworld/]] in your browser.
198 |
199 | Just to prove the webserver is still there, open
200 | [[http://localhost:8000/]]. This should still show your
201 | {{{~/public_html}}} directory (or whatever you configured
202 | {{{elnode-webserver-docroot}}} to).
203 |
204 | Check the variable {{{elnode-hostpath-default-table}}} with {{{C-h v elnode-hostpath-default-table}}}
205 |
206 | The value should be something like:
207 |
208 | {{{
209 | (("/helloworld/" . my-elnode-hello-world-handler)
210 | ("[^/]+/.*" . elnode-webserver))
211 | }}}
212 |
213 | {{{elnode-hostpath-default-table}}} can also be customized to add more
214 | services. But any handler mapped in there will have to be loaded in at
215 | Emacs startup so you either need to package and load your Elnode code
216 | or put it in your {{{load-path}}} and {{{require}}} it from Emacs
217 | init.
218 |
219 | == A more advanced example - publishing a buffer ==
220 |
221 | So far, all the examples have been quite trivial. Though I hope you
222 | think it's interesting that you can do all these things quite easily
223 | from inside Emacs.
224 |
225 | But now let's try something harder - let's make an web based editor.
226 |
227 | This is an exercise that will grow with the tutorial. I hope you'll be
228 | interested in the first draft, even though it's going to be relatively
229 | simple.
230 |
231 | Make a new file {{{C-x C-f my-elnode-editor.el}}}.
232 |
233 | Add the following Lisp code:
234 |
235 | {{{
236 | (defvar my-elnode-editor-buffer (get-buffer-create "*my-elnode-editor-buffer*"))
237 |
238 | (defun my-elnode-editor-handler (httpcon)
239 | (elnode-http-start httpcon 200 '("Content-Type" . "text/plain"))
240 | (elnode-http-return
241 | httpcon
242 | (with-current-buffer my-elnode-editor-buffer
243 | (buffer-substring-no-properties (point-min) (point-max)))))
244 | }}}
245 |
246 | Eval that with {{{M-x eval-buffer}}}.
247 |
248 | Now go and type some text in ~*my-elnode-editor-buffer~*. This will be
249 | served by the editor service.
250 |
251 | Now let's start the service:
252 |
253 | {{{
254 | M-x elnode-start
255 | my-elnode-editor-handler
256 | 8002
257 | localhost
258 | }}}
259 |
260 | Now try and hit [[http://localhost:8002]] - you should see whatever
261 | you typed in the ~*my-elnode-editor-buffer~*.
262 |
263 | Try updating the text in the buffer and refreshing the browser. We're
264 | displaying that buffer whatever it has in it.
265 |
266 | Ok. So we've published a buffer. But what about someone else updating
267 | it?
268 |
269 | Let's make another handler to handle updates, add this to your {{{my-elnode-editor.el}}}:
270 |
271 | {{{
272 | (defun my-elnode-editor-update-handler (httpcon)
273 | (let ((change-text (elnode-http-param httpcon "change")))
274 | (with-current-buffer my-elnode-editor-buffer
275 | (goto-char (point-max))
276 | (if (stringp change-text)
277 | (insert change-text))))
278 | (elnode-http-start httpcon 302 '("Location" . "/"))
279 | (elnode-http-return httpcon))
280 | }}}
281 |
282 | Now we have two handlers we'll have to map them together
283 | somehow. Let's map one to the root ({{{/}}}) and one to
284 | {{{/update/}}}. Add the following code to {{{my-elnode-editor.el}}}:
285 |
286 | {{{
287 | (defconst my-elnode-editor-urls
288 | `(("^/$" . my-elnode-editor-handler)
289 | ("^/update/.*$" . my-elnode-editor-update-handler)))
290 | }}}
291 |
292 | And now we need to add a handler to do the dispatching for these URLs,
293 | add this to {{{my-elnode-editor.el}}} as well:
294 |
295 | {{{
296 | (defun my-elnode-editor-dispatcher-handler (httpcon)
297 | (elnode-dispatcher httpcon my-elnode-editor-urls))
298 | }}}
299 |
300 | //What is a dispatcher?// - a dispatcher is a handler that take a list
301 | of URL pattern mappings and works out, by reading the data from the
302 | HTTP connection, what handler should be invoked for what request.
303 |
304 | Now we have our new dispatcher based code we need to stop the old server:
305 |
306 | {{{
307 | M-x elnode-stop 8002
308 | }}}
309 |
310 | And now start the new server with the dispatcher handler:
311 |
312 | {{{
313 | M-x elnode-start
314 | my-elnode-editor-dispatcher-handler
315 | 8002
316 | localhost
317 | }}}
318 |
319 | Now visit [[http://localhost:8002]] and see the buffer as it stands
320 | and then visit
321 | [[http://localhost:8002/update/?change=%0dlah+dee+dah%0d]] and see the
322 | updated buffer.
323 |
324 | == More advanced again - Make a webapp around the service ==
325 |
326 | Let's take our editor on another step. Let's add some static files and
327 | have the Elnode handlers be called by client side Javascript.
328 |
329 | If we're going to add some static files, we'll need a webserver. We
330 | already know how to do that. Once we've got some javascript though,
331 | we'll probably not want to retrieve the text by {{{HTTP GET}}}ing the
332 | root url, so let's alter that binding to {{{/text/}}} as well:
333 |
334 | {{{
335 | (defconst my-elnode-editor-webserver-handler
336 | (elnode-webserver-handler-maker "~/my-directory")
337 | "The webserver handler.")
338 |
339 | (defconst my-elnode-editor-urls
340 | '(("^/text/$" . my-elnode-editor-handler)
341 | ("^/update/.*$" . my-elnode-editor-update-handler)
342 | ("^/[^/]+/.*$" . my-elnode-editor-webserver-handler)))
343 | }}}
344 |
345 | Obviously {{{~/my-directory}}} needs to be the place where you are
346 | going to save your HTML and Javascript files.
347 |
348 | Now we need those HTML and Javascript files. Let's make the HTML
349 | first:
350 |
351 | {{{
352 |
353 |
354 |
357 |
359 |
360 |
361 |
363 |
364 |
365 | }}}
366 |
367 | We're going to pull jQuery from Google's Content Delivery
368 | Network. We've put in a placeholder for our own Javascript file and
369 | other than that the HTML is really just a {{{textarea}}}
370 | element. We'll use //that// for putting the buffer text in.
371 |
372 | Now, what should the Javascript do?
373 |
374 | * when the page loads
375 | * make an AJAX call to Elnode for the buffer text
376 | * stick the received text into the {{{textarea}}}
377 |
378 | Ok. So here is {{{my-elnode-editor.js}}}:
379 |
380 | {{{
381 | var my_elnode_editor = (function () {
382 | var self = {
383 | /** Get the text from Emacs.
384 | */
385 | get_text: function () {
386 | $.ajax("/text/", {
387 | dataType: "text",
388 | success: function (data, textStatus, jqXHR) {
389 | $("#text").text(data);
390 | }
391 | });
392 | }
393 | };
394 | return self;
395 | })();
396 |
397 | $(document).ready(
398 | function () {
399 | my_elnode_editor.get_text();
400 | }
401 | );
402 | }}}
403 |
404 | Save this as {{{my-elnode-editor.js}}} (in whatever directory the
405 | webserver is serving) and save the HTML in the same directory, call it
406 | {{{my-elnode-editor.html}}}, say?
407 |
408 | You don't even have to restart the Elnode handler, because it already
409 | is pointing to the dispatcher handler. If you just:
410 |
411 | {{{
412 | M-x eval-buffer
413 | }}}
414 |
415 | this will re-evaluate the URL mappings. Now if you visit
416 | [[http://localhost:8002/my-elnode-editor.html]] you should see the
417 | webpage with the {{{textarea}}} and the text of your buffer.
418 |
419 |
420 |
421 | == That's all for now! ==
422 |
423 | This is as far as Nic has got writing the tutorial. More will come soon I hope:
424 |
425 | * {{{defer}}} with an example based around the editor service
426 | * debugging a running Elnode service
427 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-rle.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-rle.el --- Remote Lisp Executiion with Elnode -*- lexical-binding: t -*-
2 |
3 | ;; Copyright (C) 2012 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords: lisp, hypermedia, processes
7 |
8 | ;; This program is free software; you can redistribute it and/or modify
9 | ;; it under the terms of the GNU General Public License as published by
10 | ;; the Free Software Foundation, either version 3 of the License, or
11 | ;; (at your option) any later version.
12 |
13 | ;; This program is distributed in the hope that it will be useful,
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | ;; GNU General Public License for more details.
17 |
18 | ;; You should have received a copy of the GNU General Public License
19 | ;; along with this program. If not, see .
20 |
21 | ;;; Commentary:
22 | ;;
23 | ;; This is an elnode handler and tools for doing asynchrous
24 | ;; programming.
25 | ;;
26 | ;; The idea is that you can setup associated child processes and pass
27 | ;; them work to do and receive their output over HTTP.
28 |
29 | ;;; Code:
30 |
31 | (require 'elnode)
32 | (require 'web)
33 | (require 'loadhist)
34 | (require 'server)
35 |
36 | (defun elnode-rle--handler (httpcon)
37 | "Remote Lisp Evaluator handler.
38 |
39 | This can be spawned in a client to allow any lisp code to be
40 | passed over the client-server link."
41 | (let* ((lisp-to-run (elnode-http-param httpcon "lisp"))
42 | (lisp
43 | (if lisp-to-run
44 | (car (read-from-string lisp-to-run))))
45 | (bindings-to-use (elnode-http-param httpcon "bindings"))
46 | (bindings
47 | (if bindings-to-use
48 | (car (read-from-string bindings-to-use))))
49 | (to-eval (list 'let bindings lisp)))
50 | (elnode-http-start httpcon 200 '("Content-type" . "text/plain"))
51 | (let ((nomessage t))
52 | (with-stdout-to-elnode httpcon
53 | (eval to-eval)))))
54 |
55 | (ert-deftest elnode-rle--handler ()
56 | "Test the Remote Lisp Evaluator handler."
57 | :expected-result :failed
58 | (flet ((lisp-encode (param lisp)
59 | (cons param (format "%S" lisp)))
60 | (do-test (lisp bindings)
61 | (fakir-mock-process
62 | :httpcon
63 | ((:elnode-http-params (list lisp bindings)))
64 | (elnode-rle--handler :httpcon)
65 | (with-current-buffer (process-buffer :httpcon)
66 | (goto-char (point-min))
67 | ;; Find the header end.
68 | (re-search-forward "\r\n\r\n" nil 't)
69 | (buffer-substring (point) (point-max))))))
70 | (should
71 | (equal
72 | ;; Match the content transfer encoded
73 | "c\r\nhello world!\r\n0\r\n\r\n"
74 | (let*
75 | ((lisp (lisp-encode
76 | "lisp" '(let ((a "hello world!")) (princ a))))
77 | (bindings (lisp-encode
78 | "bindings" '((a 10)(b 20)))))
79 | (do-test lisp bindings))))
80 | (should
81 | (equal
82 | "2\r\n30\r\n0\r\n\r\n"
83 | (let*
84 | ((lisp (lisp-encode
85 | "lisp" '(let ((a (+ b 10))) (princ a))))
86 | (bindings (lisp-encode
87 | "bindings" '((a 10)(b 20)))))
88 | (do-test lisp bindings))))))
89 |
90 | (defvar elnode-rle--servers (make-hash-table :test 'equal)
91 | "The hash of RLE servers available.")
92 |
93 | (defun elnode-rle--load-path-ize (lisp)
94 | "Wrap LISP in the current load-path."
95 | (concat
96 | ;; There is a very strange thing with sending lisp to
97 | ;; (read) over a piped stream... (read) can't cope with
98 | ;; multiple lines; so we encode newline here.
99 | ;;(replace-regexp-in-string
100 | ;; "\n"
101 | ;; "\\\\n"
102 | (format "(progn (setq load-path (quote %S)) %s)"
103 | (append (list default-directory) load-path)
104 | lisp)))
105 |
106 | (defun elnode-rle--handler-lisp (to-require)
107 | "Return a file with Lisp to start Elnode with TO-REQUIRE.
108 |
109 | Used to construct the lisp to send. You're unlikely to need to
110 | override this at all, the function is just here to make the
111 | implementation easier to debug.
112 |
113 | TO-REQUIRE is a list of things to require, currently only 1 is
114 | allowed."
115 | (let ((temp-file
116 | (make-temp-file
117 | (format "elnode-rle-%s" (symbol-name to-require)))))
118 | (with-temp-file temp-file
119 | (insert
120 | (elnode-rle--load-path-ize
121 | (format "(progn
122 | (setq elnode-do-init nil)
123 | (setq elnode--do-error-logging nil)
124 | (require (quote %s))
125 | (require (quote elnode-rle))
126 | (toggle-debug-on-error)
127 | (setq elnode-rle-port (elnode-find-free-service))
128 | (elnode-start 'elnode-rle--handler :port elnode-rle-port)
129 | (print (format \"\\nelnode-port=%%d\\n\" port)))"
130 | to-require))))
131 | temp-file))
132 |
133 | (defun elnode-rle--httpcon-mapper (client-header
134 | client-data
135 | elnode-httpcon
136 | &optional end-callback)
137 | "Elnode specific client connection to HTTP connection mapper.
138 |
139 | Maps client async data responses to an elnode server response."
140 | (unless (process-get elnode-httpcon :elnode-rle-header-sent)
141 | (elnode-http-start
142 | elnode-httpcon
143 | (gethash 'status-code client-header))
144 | (process-put elnode-httpcon :elnode-rle-header-sent t))
145 | (if (eq client-data :done)
146 | (elnode-http-return elnode-httpcon) ; return if we're done
147 | ;; Else just send the data
148 | (elnode-http-send-string elnode-httpcon client-data)))
149 |
150 | (defun elnode-rle--client-data-mapper (con header data stream end-callback)
151 | "Recevies data from the RLE server and sends it to the STREAM.
152 |
153 | END-CALLBACK is to be called when the client sees EOF."
154 | (cond
155 | ((processp stream) ; this should really elnode-http-p
156 | (elnode-rle--httpcon-mapper header data stream end-callback))
157 | ((bufferp stream)
158 | (if (not (eq data :done))
159 | (with-current-buffer stream
160 | (save-excursion
161 | (goto-char (point-max))
162 | (insert data)))
163 | ;; Process is done.
164 | (and (functionp end-callback)
165 | (funcall end-callback header))))))
166 |
167 | (defun elnode-rle--call-mapper (data-to-send stream port
168 | &optional end-callback)
169 | "Make a client call to PORT mapping response to STREAM.
170 |
171 | When it finishes, call END-CALLBACK, if present, with the header."
172 | (web-http-post
173 | (lambda (con header data)
174 | (elnode-rle--client-data-mapper
175 | con
176 | header
177 | data
178 | stream
179 | end-callback))
180 | "/"
181 | :host "localhost"
182 | :port port
183 | :data data-to-send
184 | :mime-type "application/x-elnode"
185 | :mode 'stream))
186 |
187 | (defun elnode-rle--make-server (to-require)
188 | "Make an RLE server, a child Emacs running the RLE handler.
189 |
190 | Return a proc that represents the child process. The child
191 | process has a property `:exec' which is a function that calls the
192 | RLE handler in the child's Elnode server (waiting for the server
193 | to start first and provide the relevant port) by calling
194 | `elnode-rle-call-mapper' with the stream from the `:exec' call
195 | and the child's remote HTTP port.
196 |
197 | The `:exec' proc will signal `elnode-rle-child-port' if the child
198 | server does not start properly." ; yes. I know it's bloody complicated.
199 | (let* ((proc-buffer
200 | (get-buffer-create
201 | (format "* %s *" "thingy")))
202 | (emacsrun
203 | "/usr/bin/emacs -Q --daemon=elnode-debugit")
204 | (proc
205 | (start-process-shell-command
206 | "elnode-rle-server"
207 | proc-buffer
208 | emacsrun))
209 | (file-of-lisp
210 | (elnode-rle--handler-lisp
211 | to-require)))
212 | ;; Start elnode in it
213 | (server-eval-at "elnode-debugit" `(load-file ,file-of-lisp))
214 | (process-put proc :daemonhandle "elnode-debugit")
215 | (process-put
216 | proc
217 | :port
218 | (server-eval-at
219 | (process-get proc :daemonhandle)
220 | 'elnode-rle-port))
221 | ;; Collect the port from the remote Emacs
222 | ;; - FIXME this should also collect the secure token
223 | (set-process-filter
224 | proc
225 | (lambda (proc data)
226 | ;; Optional delay for test reasons
227 | (with-current-buffer (process-buffer proc)
228 | (save-excursion
229 | (goto-char (point-max))
230 | (insert data)))))
231 | ;; Make a handler to call the server
232 | (process-put
233 | proc :exec
234 | (lambda (data stream &optional end-callback)
235 | (let ((ephemeral-port (process-get proc :port)))
236 | (elnode-rle--call-mapper data stream ephemeral-port end-callback))))
237 | proc))
238 |
239 | (defun elnode-rle--sender (stream to-require bindings body
240 | &optional end-callback)
241 | "Make a call using a client to the RLE server elsewhere.
242 |
243 | The RLE server is reused over TO-REQUIRE, if it's not already
244 | existing, it is created."
245 | (let ((server (gethash to-require elnode-rle--servers)))
246 | ;; Make the server if we don't have it
247 | (unless server
248 | (setq server
249 | (puthash to-require
250 | (elnode-rle--make-server (car to-require))
251 | elnode-rle--servers)))
252 | ;; Now make the call to the server
253 | (let ((data (make-hash-table :test 'equal)))
254 | (puthash "bindings" (format "%S" bindings) data)
255 | (puthash "lisp" (format "%S" body) data)
256 | (let ((client-connection
257 | (funcall
258 | (process-get server :exec)
259 | data
260 | stream
261 | end-callback)))
262 | ;; If we're streaming to elnode then we need to mark the connection
263 | (when (processp stream)
264 | (process-put
265 | stream
266 | :elnode-child-process
267 | client-connection))))))
268 |
269 | (defvar elnode-rle--async-do-end-callback nil
270 | "Used by `elnode-async-do' as the source of an end-callback.
271 |
272 | This is just used by tests for end signalling.")
273 |
274 | (defmacro elnode-async-do (stream
275 | requires requirements
276 | with-environment bindings
277 | do &rest body)
278 | "Execute the BODY in a remote Emacs.
279 |
280 | The STREAM is used to handle any output.
281 |
282 | The REQUIREMENTS is a list of provide symbol names that will be
283 | used to establish the right environment in the remote.
284 |
285 | The BINDINGS are also sent to the remote.
286 |
287 | TODO
288 |
289 | security for the remote using the stored key."
290 | (assert (eq with-environment 'with-environment))
291 | (assert (eq requires 'requires))
292 | (assert (eq do 'do))
293 | (let ((bodyv (make-symbol "body"))
294 | (bindsv (make-symbol "binds"))
295 | (streamv (make-symbol "streamv"))
296 | (requirev (make-symbol "providing")))
297 | `(let* ((,streamv ,stream)
298 | (,bodyv (quote (progn ,@body)))
299 | (,bindsv (list
300 | ,@(loop for p in bindings
301 | collect
302 | (if (and p (listp p))
303 | (list 'list `(quote ,(car p)) (cadr p))
304 | (list 'cons `,p nil)))))
305 | (,requirev (quote ,requirements)))
306 | (elnode-rle--sender
307 | ,streamv ,requirev ,bindsv ,bodyv
308 | elnode-rle--async-do-end-callback))))
309 |
310 | (defmacro with-elnode-rle-wait (&rest body)
311 | "Simplify the wait for RLE; for testers."
312 | `(unwind-protect
313 | (let (ended)
314 | (progn
315 | ,@body)
316 | (while (not ended) (sit-for 1)))
317 | ;; FIXME - can we get to the name of this?
318 | (server-eval-at "elnode-debugit" '(kill-emacs))))
319 |
320 | (ert-deftest elnode-rle--make-server ()
321 | "Test making an RLE server.
322 |
323 | Do it all 3 ways: directly with the `elnode-rle-make-server',
324 | with the `elnode-rle--sender' function and finally with the user
325 | facing macro `elnode-async-do'.
326 |
327 | The output from the RLE call is collected in a buffer
328 | and tested."
329 | :expected-result :failed
330 | (flet ((make-hash (bindings)
331 | (let ((h (make-hash-table :test 'equal)))
332 | (loop for b in bindings
333 | do (puthash (car b) (cadr b) h))
334 | h)))
335 | ;; Do it RAW
336 | (should
337 | (equal
338 | "hello"
339 | (with-temp-buffer
340 | (let* ((child-proc (elnode-rle--make-server 'elnode))
341 | (daemon-handler (process-get child-proc :daemonhandle))
342 | (collect-buf (current-buffer)))
343 | (with-elnode-rle-wait
344 | (funcall
345 | (process-get child-proc :exec)
346 | (make-hash '(("bindings" "((a \"hello\"))")
347 | ("lisp" "(princ \"hello\")")))
348 | (current-buffer)
349 | (lambda (hdr) ; the end proc
350 | (setq ended t))))
351 | (buffer-substring (point-min) (point-max))))))
352 | ;; Do it via the sender func
353 | (should
354 | (equal
355 | "40"
356 | (with-temp-buffer
357 | (with-elnode-rle-wait
358 | (let ((elnode-rle--servers (make-hash-table :test 'equal)))
359 | (elnode-rle--sender
360 | (current-buffer)
361 | '(elnode)
362 | '((a 10) (b 20))
363 | '(let ((c 30))(princ (+ c a)))
364 | (lambda (header)
365 | (message "elnode-rle: all done!")(setq ended t)))))
366 | (buffer-substring (point-min) (point-max)))))
367 | ;; Do it with the macro
368 | (should
369 | (equal
370 | "hello"
371 | (with-temp-buffer
372 | (with-elnode-rle-wait
373 | (let ((elnode-rle--servers (make-hash-table :test 'equal))
374 | (elnode-rle--async-do-end-callback
375 | (lambda (header)
376 | (message "elnode-rle: in the dyn bound callback!")
377 | (setq ended t))))
378 | (elnode-async-do
379 | (current-buffer)
380 | requires (elnode enode-rle)
381 | with-environment ((a 10)(b 20))
382 | do (princ "hello"))))
383 | (buffer-substring (point-min) (point-max)))))))
384 |
385 | (provide 'elnode-rle)
386 |
387 | ;; elnode-rle ends here
388 |
--------------------------------------------------------------------------------
/emacs-kv/kv.el:
--------------------------------------------------------------------------------
1 | ;;; kv.el --- key/value data structure functions
2 |
3 | ;; Copyright (C) 2012 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier
6 | ;; Keywords: lisp
7 | ;; Version: 0.0.19
8 | ;; Maintainer: Nic Ferrier
9 | ;; Created: 7th September 2012
10 |
11 | ;; This program is free software; you can redistribute it and/or modify
12 | ;; it under the terms of the GNU General Public License as published by
13 | ;; the Free Software Foundation, either version 3 of the License, or
14 | ;; (at your option) any later version.
15 |
16 | ;; This program is distributed in the hope that it will be useful,
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 | ;; GNU General Public License for more details.
20 |
21 | ;; You should have received a copy of the GNU General Public License
22 | ;; along with this program. If not, see .
23 |
24 | ;;; Commentary:
25 |
26 | ;; Some routines for working with key/value data structures like
27 | ;; hash-tables and alists and plists.
28 |
29 | ;; This also takes over the dotassoc stuff and provides it separately.
30 |
31 | ;;; Code:
32 |
33 | (eval-when-compile (require 'cl))
34 |
35 |
36 | (defun kvalist->hash (alist &rest hash-table-args)
37 | "Convert ALIST to a HASH.
38 |
39 | HASH-TABLE-ARGS are passed to the hash-table creation."
40 | (let ((table (apply 'make-hash-table hash-table-args)))
41 | (mapc
42 | (lambda (pair)
43 | (puthash (car pair) (cdr pair) table))
44 | alist)
45 | table))
46 |
47 | (defun kvhash->alist (hash &optional func)
48 | "Convert HASH to an ALIST.
49 |
50 | Optionally filter through FUNC, only non-nil values returned from
51 | FUNC are stored as the resulting value against the converted
52 | key."
53 | (when hash
54 | (let (store)
55 | (maphash
56 | (lambda (key value)
57 | (when key
58 | (if (and (functionp func))
59 | (let ((res (funcall func key value)))
60 | (when res
61 | (setq store (acons key res store))))
62 | ;; else no filtering, just return
63 | (setq store (acons key value store)))))
64 | hash)
65 | store)))
66 |
67 | (defun kvfa (key alist receive)
68 | "Call RECEIVE with whatever comes out of ALIST for KEY.
69 |
70 | RECEIVE can do whatever destructuring you want, the first
71 | argument is always the car of the alist pair."
72 | (apply receive (let ((a (assoc key alist)))
73 | (append (list (car a))
74 | (if (listp (cdr a))(cdr a)(list (cdr a)))))))
75 |
76 | (defun kva (key alist)
77 | "Retrieve the value assigned to KEY in ALIST.
78 |
79 | This uses `assoc' as the lookup mechanism."
80 | (cdr (assoc key alist)))
81 |
82 | (defun kvaq (key alist)
83 | "Retrieve the value assigned to KEY in ALIST.
84 |
85 | This uses `assq' as the lookup mechanism."
86 | (cdr (assq key alist)))
87 |
88 | (defun kvaqc (key alist)
89 | "Retrieve the value assigned to KEY in ALIST.
90 |
91 | This uses first the `assq' and then `assoc' as the lookup
92 | mechanism."
93 | (cdr (or (assq key alist)
94 | (assoc key alist))))
95 |
96 | (defun kvassoc= (key value alist)
97 | "Is the value assocd to KEY in ALIST equal to VALUE?
98 |
99 | Returns the value looked up by KEY that passes, so normally:
100 |
101 | KEY . VALUE
102 | "
103 | (let ((v (assoc key alist)))
104 | (and v (equal (cdr v) value) v)))
105 |
106 | (defun kvassoqc (key alist)
107 | "String or symbol assoc."
108 | (let ((v (or
109 | (assq (if (symbolp key) key (intern key)) alist)
110 | (or (assoc key alist)
111 | ;; not sure about this behaviour... see test
112 | (assoc (symbol-name key) alist))))) v))
113 |
114 | (defun kvassoq= (key value alist)
115 | "Test the VALUE with the value bound to KEY in ALIST.
116 |
117 | The lookup mechanism is to ensure the key is a symbol and then
118 | use assq. Hence the name of the function being a mix of assoc
119 | and assq.
120 |
121 | Returns the value looked up by KEY that passes, so normally:
122 |
123 | KEY . VALUE
124 | "
125 | (let ((v (kvassoqc key alist)))
126 | (and v (equal (cdr v) value) v)))
127 |
128 | (defun kvmatch (key regex alist)
129 | "Test the value with KEY in ALIST matches REGEX."
130 | (let ((v (kvassoqc key alist)))
131 | (and v (string-match regex (cdr v)) v)))
132 |
133 | (defun* kvquery->func (query &key
134 | (equal-func 'kvassoc=)
135 | (match-func 'kvmatch))
136 | "Turn a simple QUERY expression into a filter function.
137 |
138 | EQUAL-FUNC is the function that implements the equality
139 | predicate.
140 |
141 | MATCH-FUNC is the function that implements the match predicate.
142 |
143 | The query language is:
144 |
145 | | a b - true if a or b is true
146 | & a b - true only if a and b is true
147 | = a b - true if a equals b as per the EQUAL-FUNC
148 | ~ a b - true if a matches b as per the MATCH-FUNC
149 |
150 | So, for example:
151 |
152 | (|(= a b)(= c d))
153 |
154 | Means: if `a' equals `b', or if `c' equals `d' then the
155 | expression is true."
156 | (flet ((query-parse (query)
157 | (let ((part (car query))
158 | (rest (cdr query)))
159 | (cond
160 | ((eq part '|)
161 | (cons 'or
162 | (loop for i in rest
163 | collect (query-parse i))))
164 | ((eq part '&)
165 | (cons 'and
166 | (loop for i in rest
167 | collect (query-parse i))))
168 | ((eq part '~)
169 | (destructuring-bind (field value) rest
170 | (list match-func field value (quote record))))
171 | ((eq part '=)
172 | (destructuring-bind (field value) rest
173 | (list equal-func field value (quote record))))))))
174 | (eval `(lambda (record) ,(query-parse query)))))
175 |
176 | (defun kvplist2get (plist2 keyword value)
177 | "Get the plist with KEYWORD / VALUE from the list of plists."
178 | (loop for plist in plist2
179 | if (equal (plist-get plist keyword) value)
180 | return plist))
181 |
182 | (defun kvthing->keyword (str-or-symbol)
183 | "Convert STR-OR-SYMBOL into a keyword symbol."
184 | (let ((str
185 | (cond
186 | ((symbolp str-or-symbol) (symbol-name str-or-symbol))
187 | ((stringp str-or-symbol) str-or-symbol))))
188 | (intern
189 | (if (eq (aref str 0) ?:) str (concat ":" str)))))
190 |
191 | (defun kvalist->plist (alist)
192 | "Convert an alist to a plist."
193 | ;; Why doesn't elisp provide this?
194 | (loop for pair in alist
195 | append (list
196 | (kvthing->keyword
197 | (car pair))
198 | (cdr pair))))
199 |
200 | (defun kvacons (&rest args)
201 | "Make an alist from the plist style args."
202 | (kvplist->alist args))
203 |
204 | (defun keyword->symbol (keyword)
205 | "A keyword is a symbol leading with a :.
206 |
207 | Converting to a symbol means dropping the :."
208 | (if (keywordp keyword)
209 | (intern (substring (symbol-name keyword) 1))
210 | keyword))
211 |
212 | (defun kvplist->alist (plist &optional keys-are-keywords)
213 | "Convert PLIST to an alist.
214 |
215 | The keys are expected to be :prefixed and the colons are removed
216 | unless KEYS-ARE-KEYWORDS is `t'.
217 |
218 | The keys in the resulting alist are always symbols."
219 | (when plist
220 | (loop for (key value . rest) on plist by 'cddr
221 | collect
222 | (cons (if keys-are-keywords
223 | key
224 | (keyword->symbol key))
225 | value))))
226 |
227 | (defun kvalist2->plist (alist2)
228 | "Convert a list of alists too a list of plists."
229 | (loop for alist in alist2
230 | append
231 | (list (kvalist->plist alist))))
232 |
233 | (defun kvalist->keys (alist)
234 | "Get just the keys from the alist."
235 | (mapcar (lambda (pair) (car pair)) alist))
236 |
237 | (defun kvalist->values (alist)
238 | "Get just the values from the alist."
239 | (mapcar (lambda (pair) (cdr pair)) alist))
240 |
241 | (defun kvalist-sort (alist pred)
242 | "Sort ALIST (by key) with PRED."
243 | (sort alist (lambda (a b) (funcall pred (car a) (car b)))))
244 |
245 | (defun kvalist-sort-by-value (alist pred)
246 | "Sort ALIST by value with PRED."
247 | (sort alist (lambda (a b) (funcall pred (cdr a) (cdr b)))))
248 |
249 | (defun kvalist->filter-keys (alist &rest keys)
250 | "Return the ALIST filtered to the KEYS list.
251 |
252 | Only pairs where the car is a `member' of KEYS will be returned."
253 | (loop for a in alist
254 | if (member (car a) keys)
255 | collect a))
256 |
257 | (defun kvplist->filter-keys (plist &rest keys)
258 | "Filter the plist to just those matching KEYS.
259 |
260 | `kvalist->filter-keys' is actually used to do this work."
261 | (let ((symkeys
262 | (loop for k in keys
263 | collect (let ((strkey (symbol-name k)))
264 | (if (equal (substring strkey 0 1) ":")
265 | (intern (substring strkey 1))
266 | k)))))
267 | (kvalist->plist
268 | (apply
269 | 'kvalist->filter-keys
270 | (cons (kvplist->alist plist) symkeys)))))
271 |
272 | (defun kvplist2->filter-keys (plist2 &rest keys)
273 | "Return the PLIST2 (a list of plists) filtered to the KEYS."
274 | (loop for plist in plist2
275 | collect (apply 'kvplist->filter-keys (cons plist keys))))
276 |
277 | (defun kvalist2->filter-keys (alist2 &rest keys)
278 | "Return the ALIST2 (a list of alists) filtered to the KEYS."
279 | (loop for alist in alist2
280 | collect (apply 'kvalist->filter-keys (cons alist keys))))
281 |
282 | (defun kvalist2->alist (alist2 car-key cdr-key &optional proper)
283 | "Reduce the ALIST2 (a list of alists) to a single alist.
284 |
285 | CAR-KEY is the key of each alist to use as the resulting key and
286 | CDR-KEY is the key of each alist to user as the resulting cdr.
287 |
288 | For example, if CAR-KEY is `email' and CDR-KEY is `name' the
289 | records:
290 |
291 | '((user . \"nic\")(name . \"Nic\")(email . \"nic@domain\")
292 | (user . \"jim\")(name . \"Jim\")(email . \"jim@domain\"))
293 |
294 | could be reduced to:
295 |
296 | '((\"nic@domain\" . \"Nic\")
297 | (\"jim@domain\" . \"Jic\"))
298 |
299 | If PROPER is `t' then the alist is a list of proper lists, not
300 | cons cells."
301 | (loop for alist in alist2
302 | collect (apply (if proper 'list 'cons)
303 | (list
304 | (assoc-default car-key alist)
305 | (assoc-default cdr-key alist)))))
306 |
307 | (defun kvalist-keys->* (alist fn)
308 | "Convert the keys of ALIST through FN."
309 | (mapcar
310 | (lambda (pair)
311 | (cons
312 | (funcall fn (car pair))
313 | (cdr pair)))
314 | alist))
315 |
316 | (defun* kvalist-keys->symbols (alist &key (first-fn 'identity))
317 | "Convert the keys of ALIST into symbols.
318 |
319 | If key parameter FIRST-FN is present it should be a function
320 | which will be used to first transform the string key. A popular
321 | choice might be `downcase' for example, to cause all symbol keys
322 | to be lower-case."
323 | (kvalist-keys->*
324 | alist
325 | (lambda (key)
326 | (intern (funcall first-fn (format "%s" key))))))
327 |
328 | (defun kvalist2-filter (alist2 fn)
329 | "Filter the list of alists with FN."
330 | (let (value)
331 | (loop for rec in alist2
332 | do (setq value (funcall fn rec))
333 | if value
334 | collect rec)))
335 |
336 | (defun kvidentity (a b)
337 | "Returns a cons of A B."
338 | (cons a b))
339 |
340 | (defun kvcar (a b)
341 | "Given A B returns A."
342 | a)
343 |
344 | (defun kvcdr (a b)
345 | "Given A B returns B."
346 | b)
347 |
348 | (defun kvcmp (a b)
349 | "Do a comparison of the two values using printable syntax.
350 |
351 | Use this as the function to pass to `sort'."
352 | (string-lessp (if a (format "%S" a) "")
353 | (if b (format "%S" b) "")))
354 |
355 | (defun kvqsort (lst)
356 | "Do a sort using `kvcmp'."
357 | (sort lst 'kvcmp))
358 |
359 | (progn
360 | (put 'kvalist-key
361 | 'error-conditions
362 | '(error))
363 | (put 'kvalist-key
364 | 'error-message
365 | "No such key found in alist."))
366 |
367 | (defun kvalist-set-value! (alist key value)
368 | "Destructively set the value of KEY to VALUE in ALIST.
369 |
370 | If the assoc is not found this adds it to alist."
371 | (let ((cell (assoc key alist)))
372 | (if (consp cell)
373 | (setcdr cell value)
374 | ;; Else what to do?
375 | (signal 'kvalist-key (list alist key)))))
376 |
377 | (defun kvdotassoc-fn (expr table func)
378 | "Use the dotted EXPR to access deeply nested data in TABLE.
379 |
380 | EXPR is a dot separated expression, either a symbol or a string.
381 | For example:
382 |
383 | \"a.b.c\"
384 |
385 | or:
386 |
387 | 'a.b.c
388 |
389 | If the EXPR is a symbol then the keys of the alist are also
390 | expected to be symbols.
391 |
392 | TABLE is expected to be an alist currently.
393 |
394 | FUNC is some sort of `assoc' like function."
395 | (let ((state table)
396 | (parts
397 | (if (symbolp expr)
398 | (mapcar
399 | 'intern
400 | (split-string (symbol-name expr) "\\."))
401 | ;; Else it's a string
402 | (split-string expr "\\."))))
403 | (catch 'break
404 | (while (listp parts)
405 | (let ((traverse (funcall func (car parts) state)))
406 | (setq parts (cdr parts))
407 | (if parts
408 | (setq state (cdr traverse))
409 | (throw 'break (cdr traverse))))))))
410 |
411 | (defun kvdotassoc (expr table)
412 | "Dotted expression handling with `assoc'."
413 | (kvdotassoc-fn expr table 'assoc))
414 |
415 | (defun kvdotassq (expr table)
416 | "Dotted expression handling with `assq'."
417 | (kvdotassoc-fn expr table 'assq))
418 |
419 | (defun kvdotassoc= (expr value table)
420 | (let ((v (kvdotassoc expr table)))
421 | (and v (equal v value) v)))
422 |
423 | (defalias 'dotassoc 'kvdotassoc)
424 | (defalias 'dotassq 'kvdotassq)
425 |
426 | ;; Thank you taylanub for this wonderful abstraction.
427 | (defmacro kv--destructuring-map (map-function args sequence &rest body)
428 | "Helper macro for `destructuring-mapcar' and `destructuring-map'."
429 | (declare (indent 3))
430 | (let ((entry (gensym)))
431 | `(,map-function (lambda (,entry)
432 | (destructuring-bind ,args ,entry ,@body))
433 | ,sequence)))
434 |
435 | (defmacro kvmap-bind (args sexp seq)
436 | "A hybrid of `destructuring-bind' and `mapcar'
437 | ARGS shall be of the form used with `destructuring-bind'
438 |
439 | Unlike most other mapping forms this is a macro intended to be
440 | used for structural transformations, so the expected usage will
441 | be that ARGS describes the structure of the items in SEQ, and
442 | SEXP will describe the structure desired."
443 | (declare (indent 2))
444 | `(kv--destructuring-map mapcar ,args ,seq ,sexp))
445 |
446 | (defalias 'map-bind 'kvmap-bind)
447 |
448 | (defun kvplist-merge (&rest plists)
449 | "Merge the 2nd and subsequent plists into the first.
450 |
451 | Values set by lists to the left are clobbered."
452 | (let ((result (car plists))
453 | (plists (cdr plists)))
454 | (loop for plist in plists do
455 | (loop for (key val) on plist by 'cddr do
456 | (setq result (plist-put result key val))))
457 | result))
458 |
459 | (provide 'kv)
460 | (provide 'dotassoc)
461 |
462 | ;;; kv.el ends here
463 |
--------------------------------------------------------------------------------
/elnode-auth/README.creole:
--------------------------------------------------------------------------------
1 | = Elnode =
2 |
3 | An evented IO webserver in Emacs Lisp.
4 |
5 |
6 | == Requirements ==
7 |
8 | Elnode will not run properly on anything less than Emacs 24. Elnode
9 | requires Emacs 24's lexical binding as it makes extensive use of
10 | closures.
11 |
12 |
13 | == Rationale ==
14 |
15 | Elnode is a great for these things:
16 |
17 | * nice simple server with few dependancies (just Emacs and {{{cat}}} basically)
18 | * prototyping webapps
19 | * browser testing
20 | * asynchronous apps, like chat apps
21 |
22 |
23 | == Installation ==
24 |
25 | Elnode is packaged in [[http://marmalade-repo.org/packages/elnode|marmalade]].
26 |
27 | For dealing with package repositories check out the
28 | [[http://www.emacswiki.org/emacs/ELPA|Emacs Wiki]] but the short version
29 | is to add the following to your {{{.emacs}}} or your
30 | {{{.emacs.d/init.el}}}:
31 |
32 | {{{
33 | (add-to-list
34 | 'package-archives
35 | '("marmalade" . "http://marmalade-repo.org/packages/"))
36 | }}}
37 |
38 | And then do:
39 |
40 | {{{
41 | M-x list-packages
42 | }}}
43 |
44 | find Elnode in the list and press {{{i}}} or {{{ENTER}}} to install it.
45 |
46 | If you don't want to use packages you can just install {{{elnode.el}}}
47 | on your {{{load-path}}} somewhere and:
48 |
49 | {{{
50 | (require 'elnode)
51 | }}}
52 |
53 | === Install from this repository ===
54 |
55 | Installing from the sources is complex and requires the dependancies
56 | declared in the file {{{recipes/elnode}}}.
57 |
58 | The recipe file is used by
59 | [[http://github.com/nicferrier/elpakit|elpakit]] or other tools to
60 | build the package.
61 |
62 | elpakit can help build elnode, and help with running tests. Install
63 | elpakit from [[http://marmalade-repo.org/packages/elpakit|marmalade]]
64 | and then you can build Elnode with elpakit by doing:
65 |
66 | {{{
67 | M-x elpakit-make-multi
68 | }}}
69 |
70 | in the Elnode directory.
71 |
72 | You can build the Elnode package and run the Elnode tests on that
73 | package with the following lisp:
74 |
75 | {{{
76 | (elpakit-test (list elnode-directory) 'elnode-tests 'elnode)
77 | }}}
78 |
79 | Where {{{elnode-directory}}} specifies your local Elnode repository
80 | directory.
81 |
82 | The list //can// include more repository directories which will be
83 | combined into a single package archive.
84 |
85 | == Out of the box ==
86 |
87 | When Elnode initializes it automatically starts a webserver and a Wiki
88 | engine.
89 |
90 | If you:
91 |
92 | {{{
93 | M-x customize-group
94 | elnode
95 | }}}
96 |
97 | you can alter a number of variables pertaining to the default
98 | configuration, including the directory used to keep files.
99 |
100 | By default the package installs files in your {{{.emacs.d}}} - it uses
101 | a directory called {{{elnode}}} for the Wiki root and the
102 | webroot. Both are configurable with Elnode config variables.
103 |
104 | You can also just ignore the built in stuff completely and write your
105 | own servers.
106 |
107 | === What Elnode servers are running? ===
108 |
109 | Elnode tracks the servers an Emacs instance is running and you can see
110 | the view of that with:
111 |
112 | {{{
113 | M-x list-elnode-servers
114 | }}}
115 |
116 | The list shows TCP ports and handlers and you can press return on a
117 | handler and move to it's source code definition.
118 |
119 | You can kill a server by hitting "k" on it.
120 |
121 |
122 | == How does it work? ==
123 |
124 | The simplest thing that Elnode does is let you start a webserver on a
125 | directory:
126 |
127 | {{{
128 | M-x elnode-make-webserver [RET]
129 | Serve files from: [enter directory] [RET]
130 | TCP Port (try something over 8000): 8009 [RET]
131 | }}}
132 |
133 | and there will be a webserver started on port 8009 serving files from
134 | whatever directory you specified.
135 |
136 | By default Elnode starts that server on the host specified by
137 | {{{elnode-init-host}}} which is a variable you can customize:
138 |
139 | {{{
140 | M-x customize-variable [RET] elnode-init-host [RET]
141 | }}}
142 |
143 | Take care though, you don't want to expose your Emacs session to the
144 | Internet.
145 |
146 | You can also use the prefix key to specify the host for just this one
147 | server:
148 |
149 | {{{
150 | C-u M-x elnode-make-webserver [RET]
151 | Docroot: [enter directory] [RET]
152 | Port: 8009 [RET]
153 | Host: 0.0.0.0
154 | }}}
155 |
156 |
157 | === Basic Elnode for programmers ===
158 |
159 | Elnode's power is most visible to programmers though.
160 |
161 | You can define a handler function:
162 |
163 | {{{
164 | (defun my-test-handler (httpcon)
165 | "Demonstration function"
166 | (elnode-http-start httpcon 200 '("Content-type" . "text/html"))
167 | (elnode-http-return httpcon "HELLO!"))
168 | }}}
169 |
170 | And then start the server:
171 |
172 | {{{
173 | (elnode-start 'my-test-handler :port 8010 :host "localhost")
174 | }}}
175 |
176 | You can also start the server interactively... with:
177 |
178 | {{{
179 | M-x elnode-start
180 | }}}
181 |
182 | it interactively asks for the handler function and a port.
183 |
184 | === Stopping the server ===
185 |
186 | If you can remember the port you started your server on then you'll be
187 | able to stop it, like:
188 |
189 | {{{
190 | (elnode-stop 8010)
191 | }}}
192 |
193 | You can also stop interactively:
194 |
195 | {{{
196 | M-x elnode-stop
197 | }}}
198 |
199 |
200 |
201 | == API ==
202 |
203 | === Mapping paths to handlers ===
204 |
205 | {{{elnode-hostpath-dispatcher}}} takes a-list of path/handler mappings:
206 |
207 | {{{
208 | ##!emacs-lisp
209 | (defvar
210 | my-app-routes
211 | '(("^my-host.example.com//wiki/\\(.*\\)" . elnode-wikiserver)
212 | ("^admin.example.com//admintool/\\(.*\\)" . user-admin)
213 | ("^.*//\\(.*\\)" . elnode-webserver)))
214 |
215 | (defun root-handler (httpcon)
216 | (elnode-hostpath-dispatcher httpcon my-app-routes))
217 |
218 | (elnode-start 'root-handler :port 8009)
219 | }}}
220 |
221 | This will create a server on port 8009 being handled by
222 | {{{root-handler}}} which will root the requests to the appropriate handler.
223 |
224 | Any request for the host {{{my-host.example.com}}} with the path
225 | {{{/wiki/}}} will be sent to the Elnode Wiki engine.
226 |
227 | Any request for the host {{{admin.example.com}}} with the path
228 | {{{/admintool/}}} will be sent to the {{{user-admin}}} handler,
229 | presumably that is defined somewhere.
230 |
231 | Any other request will be sent to the default Elnode webserver.
232 |
233 | Elnode itself uses a hostpath dispatcher on the default Elnode server.
234 | This can actually be configured with the variable
235 | {{{elnode-hostpath-default-table}}}, so you can actually change the
236 | default behaviour of the Elnode default server just with Emacs config.
237 |
238 |
239 | The use of regexs in Elnode's mapping is supported by other
240 | tools. Sub-expressions are capturable in mapping support routines such
241 | as {{{elnode-docroot-for}}}.
242 |
243 | When a handler is called by {{{elnode-hostpath-dispatcher}}} then the
244 | parts of the match are available through the function
245 | {{{elnode-http-mapping}}}. So we could code the {{{user-admin}}}
246 | handler like this:
247 |
248 | {{{
249 | ##! emacs-lisp
250 | (defun user-admin (httpcon)
251 | (let ((username (elnode-http-mapping httpcon 1)))
252 | (user-admin-send-admin-page httpcon username)))
253 | }}}
254 |
255 | The {{{(elnode-http-mapping httpcon 1)}}} accesses the first
256 | sub-expression of the regex that caused the match:
257 |
258 | {{{
259 | ("^admin.example.com//admintool/\\(.*\\)" . user-admin)
260 | }}}
261 |
262 | so, everything AFTER the {{{admintool/}}}.
263 |
264 | Some tools in Elnode do this for you, so you don't have to. Again,
265 | look at {{{elnode-docroot-for}}}.
266 |
267 | === Serving files ===
268 |
269 | There are several helpers for serving files with Elnode. You can serve
270 | directories of files directly by making a webserver handler. A
271 | function {{{elnode-webserver-handler-maker}}} can make webservers:
272 |
273 | {{{
274 | ##! emacs-lisp
275 |
276 | (setq my-webserver
277 | (elnode-webserver-handler-maker "~/my-webroot"))
278 |
279 | (elnode-start my-webserver :port 8010)
280 | }}}
281 |
282 | The Elnode webserver also produces index pages and can be configured
283 | with a number of variables:
284 |
285 | * {{{elnode-webserver-index-page-template}}} defines the page template used for the index
286 | * {{{elnode-webserver-index-file-template}}} defines the template for each file in the index, normally it's just an A tag ponting to the file.
287 |
288 |
289 | === More controlled serving ===
290 |
291 | If you need more control over serving files you can write handlers
292 | with {{{elnode-docroot-for}}}. This does a lot of complex work for you
293 | to map a directory tree to a webserver namespace.
294 |
295 | This example shows how to use {{{elnode-docroot-for}}}
296 |
297 | {{{
298 | ##! emacs-lisp
299 |
300 | (defun elnode-org-handler (httpcon)
301 | (elnode-docroot-for "~/work/org"
302 | with org-file
303 | on httpcon
304 | do (with-current-buffer (find-file-noselect org-file)
305 | (let ((org-html
306 | ;; This might throw errors so you could condition-case it
307 | (org-export-as-html 3 nil nil 'string)))
308 | (elnode-send-html httpcon org-html)))))
309 | }}}
310 |
311 | The first argument is the directory of files which you want to serve,
312 | then {{{with variable}}} specifies the name of a variable to use in
313 | the body of the code which will be bound to the filename of the file
314 | the user wants. Then {{{on httpcon}}} specifies the HTTP connection to
315 | use and then {{{do ....}}} specifies the code to use.
316 |
317 | {{{elnode-docroot-for}}} processes incomming requests on the
318 | {{{httpcon}}} you specify by checking the request matches a file in
319 | the directory you specify (it sends a 404 if it does not find one).
320 |
321 | It also does last modified caching on the file and sends an HTTP 304
322 | response if the file has not been updated since the last request.
323 |
324 | If a matching file exists and the it is not cached then
325 | {{{elnode-docroot-for}}} runs the {{{do}}} code to send the response
326 | correctly.
327 |
328 | === Sending files ===
329 |
330 | Elnode also has {{{elnode-send-file}}} for sending files to the response,
331 | along with {{{elnode-docroot-for}}} this makes a powerful simple
332 | webserver tool. {{{elnode-send-file}}} can be used to send any
333 | arbitary file:
334 |
335 | {{{
336 | ##! emacs-lisp
337 | (defun my-status-page (httpcon)
338 | (elnode-http-start httpcon 200 '("Content-type" . "text/html"))
339 | (elnode-send-file httpcon "~/static-status-file.html"))
340 | }}}
341 |
342 | A handler that will only ever respond with one static file. Of
343 | course, this isn't very interesting, combined with
344 | {{{elnode-docroot-for}}} it can be used to serve directories and the
345 | like, or you could work out the filename to be sent with some other
346 | method.
347 |
348 | There is another use for {{{elnode-send-file}}} which is simple
349 | templating. You can pass parameters to {{{elnode-send-file}}} and it
350 | will template them into the file:
351 |
352 | {{{
353 | (defun my-templater(httpcon)
354 | (let ((hash (make-hash-table
355 | :test 'equal
356 | :data "username" "nicferrier")))
357 | (elnode-http-start httpcon 200 '("Content-type" . "text/html"))
358 | (elnode-send-file
359 | httpcon "~/my-template.html"
360 | :replacements hash)))
361 | }}}
362 |
363 | The template file must have sections marked up like:
364 |
365 | <>
368 |
369 | for each of the variables.
370 |
371 | This makes for simple but quite powerful templating.
372 |
373 | === Really Really simple file sending ===
374 |
375 | It's also possible to make send file functions automatically so if you
376 | want to map a handler that serves just one file in a dispatcher that's
377 | possible:
378 |
379 | {{{
380 | ##! emacs-lisp
381 | `(("^my-host.example.com//wiki/\\(.*\\)" . elnode-wikiserver)
382 | ("^.*//styles.css" . ,(elnode-make-send-file "~/mainstyles.css"))
383 | ("^.*//\\(.*\\)" . elnode-webserver))
384 | }}}
385 |
386 | It's also possible to use templating with this style of programming by
387 | passing a function returning the alist variable map as
388 | {{{:replacements}}}:
389 |
390 | {{{
391 | ##! emacs-lisp
392 | (defun my-templater ()
393 | '(("username" . "william occam")))
394 |
395 | `(("^my-host.example.com//wiki/\\(.*\\)" . elnode-wikiserver)
396 | ("^.*//styles.css" . ,(elnode-make-send-file
397 | "~/mainstyles.css"
398 | :replacements 'my-templater))
399 | ("^.*//\\(.*\\)" . elnode-webserver))
400 | }}}
401 |
402 | This makes templating and setting up very simple websites very easy
403 | indeed.
404 |
405 | === Accessing data in the HTTP request ===
406 |
407 | There are a bunch of functions that do what you would expect about
408 | data in the HTTP request:
409 |
410 | {{{
411 | ##! emacs-lisp
412 |
413 | (elnode-http-method httpcon)
414 | => "POST"
415 |
416 | (elnode-http-pathinfo httpcon)
417 | => "/wiki/blah.creole"
418 |
419 | (elnode-http-query httpcon)
420 | => "a=10&b=20&c=the+quick+brown+fox"
421 |
422 | (elnode-http-params httpcon)
423 | => (("a" . "10")("b" . "20")("c" . "the quick brown fox"))
424 |
425 | (elnode-http-param httpcon "username")
426 | => "nicferrier"
427 |
428 | (elnode-http-cookie httpcon "session-id")
429 | => "1213313"
430 |
431 | (elnode-http-header httpcon "Date")
432 | => "Mon, Feb 27 2012 22:10:21 GMT"
433 |
434 | (elnode-http-header httpcon 'date)
435 | => "Mon, Feb 27 2012 22:10:21 GMT"
436 |
437 | (elnode-http-header httpcon 'date :time) ;; with convert flag set to :time
438 | => (20299 65357)
439 | }}}
440 |
441 | Note that Elnode generally can accept symbol's as well as strings to
442 | name things, if it can't it's a bug,
443 | [[https://github.com/nicferrier/elnode/issues|please report it]].
444 |
445 | Also, Elnode can handle some conversions sometimes. I would like to
446 | respond to user demand about when and where to do that and what to
447 | do. Please give me feedback.
448 |
449 | === Elnode's raw data ===
450 |
451 | Elnode stores most of it's internal state on the connection object and
452 | it's all accessible via a macro {{{elnode/con-get}}}.
453 |
454 | Some interesting properties and how to access them:
455 |
456 | {{{
457 | ##! emacs-lisp
458 |
459 | (elnode/con-get httpcon :elnode-http-status)
460 | => "GET / HTTP/1.1"
461 |
462 | (elnode/con-get httpcon :elnode-http-resource)
463 | => "/"
464 |
465 | (elnode/con-get httpcon :elnode-http-version)
466 | => "1.1"
467 | }}}
468 |
469 | These are not supported by Elnode at all, there is no guarantee that
470 | the names of these properties won't change. If you feel that you want
471 | official support (ie: a function) then make an issue on the Elnode
472 | github.
473 |
474 |
475 | == To Do? ==
476 |
477 | If you're playing with elnode but you can't think of anything to do with it...
478 |
479 | * make an elnode param handler that sanitzes input
480 | ** one way to do that was found by aidalgol:
481 |
482 | {{{
483 | (require 'htmlize)
484 | (htmlize-protect-string
485 | "")
486 | }}}
487 |
488 | * an emacsclient with elnode
489 | ** write a command line client that submits data to the server over HTTP
490 | ** it should interact with the emacs user in the same way that emacs server does
491 | ** //why?// because then a single Emacs could have just 1 server socket open for all sorts of different roles
492 | * alter {{{elnode-webserver-handler-maker}}} to do indexing better
493 | ** take an optional index producing function?
494 | ** take keyword flags that set the behaviour?
495 | ** eg: {{{:doindexes 't }}}
496 | * browse-current-buffer
497 | ** start an elnode server on some random port exposing the current buffer
498 | ** automatically open a browser on the started server
499 |
500 | {{https://raw.github.com/nicferrier/elnode/master/default-wiki-logo.gif}}
501 |
--------------------------------------------------------------------------------
/README.creole:
--------------------------------------------------------------------------------
1 | = A package and archive builder =
2 |
3 | Elpakit is a bunch of tools for authoring Emacs ELPA packages.
4 |
5 | * Elpakit makes package-archives for you
6 | * Elpakit builds multi-file packages or single file packages
7 | * Elpakit runs tests on packages in isolated Emacs processes
8 | * Elpakit runs occur on package symbols for you
9 |
10 |
11 | An example:
12 |
13 | {{{
14 | (elpakit
15 | "/tmp/shoesoffsaas" ;; the directory to make the archive in
16 | '("~/work/elnode-auth" ;; the list of package directories
17 | "~/work/emacs-db"
18 | "~/work/shoes-off"
19 | "~/work/rcirc-ssh"))
20 | }}}
21 |
22 | Elpakit will make a package archive in "/tmp/shoesoffsaas". It will
23 | have an //archive-contents// formatted correctly. It will have
24 | packages made from the listed directories but also any packages that
25 | those packages depend on will be downloaded from the rest of your
26 | package archives.
27 |
28 |
29 | == Status ==
30 |
31 | This is very early code and it's difficult to test a lot of it. It
32 | mostly works. You may find bugs. If you do please tell me.
33 |
34 |
35 | == Packaging Details ==
36 |
37 | To use elpakit your development tree must conform to a particular
38 | standard.
39 |
40 | Packages are directories with either:
41 |
42 | * a single elisp file in them which is the package file; a single-file
43 | package is constructed from these
44 |
45 | * a single elisp file, which is the package file, and some form of
46 | README file; a single-file package is constructed from these.
47 | Essentially the README is ignored.
48 |
49 | * multiple elisp files where all but one elisp file is of the form:
50 | {{{test*.el}}} or {{{*test.el}}}. The package is built from the one
51 | elisp file remaining. A test package //may// be built from the test
52 | files.
53 |
54 | * a recipes directory containing a file named for the package (eg:
55 | "elnode", it can also be different from the dev dir, eg: "emacs-db"
56 | might have a "recipes/db" recipe file). The recipes file //broadly//
57 | follows the MELPA conventions. It mostly specifies the {{{:files}}}
58 | in the dev directory which belong to the package.
59 | ** There must be only one elisp file in the recipe for a recipe dev
60 | directory to be considered a single-file package.
61 |
62 | * a recipes directory, just as above, but containing many elisp files;
63 | these are considered tar packages and are built as such.
64 |
65 | == Recipe files ==
66 |
67 | The recipe format is based on the MELPA format but extended to include
68 | the extra meta-data required by tar packages.
69 |
70 | The keys that are present in a recipe file are:
71 |
72 | * name - the name of the package
73 | * version - the string version of the package
74 | * doc - a doc string
75 | * requires - the standard package requires sexp
76 | * files - a list of files that will be embedded in the package.
77 | * test - how to test the package
78 |
79 | The //files// component may include directories and the directories
80 | are then included in the package tarball.
81 |
82 | The //test// is a sort of recursive recipe, more information below.
83 |
84 |
85 | Here are some examples.
86 |
87 | {{{db}}} is a single file package, but the repository directory
88 | includes a tests file and the README:
89 |
90 | {{{
91 | (db
92 | :files ("db.el"))
93 | }}}
94 |
95 | this is the simplest form of recipe. It should not be needed very
96 | often because there is enough intelligence in elpakit about what is in
97 | a repository directory to infer this recipe.
98 |
99 | elpakit can help with testing if you tell it about your test files and
100 | dependancies, here's the recipe for //web//, an HTTP client:
101 |
102 | {{{
103 | (web
104 | :files
105 | ("web.el")
106 | :test
107 | (:requires
108 | ((fakir "0.0.10")
109 | (elnode "0.9"))
110 | :files
111 | ("web-test.el")))
112 | }}}
113 |
114 | This is still a single file recipe. The test file and it's //requires//
115 | are not needed for running the package, only testing it. Therefore
116 | they do not need to be packaged.
117 |
118 | //elnode// is a tar package and has quite a lot of complexity:
119 |
120 | {{{
121 | (elnode
122 | :version "0.9.9.6.1"
123 | :doc "The Emacs webserver."
124 | :requires
125 | ((web "0.1.4") ;; for rle
126 | (creole "0.8.14") ;; for wiki
127 | (db "0.0.1")
128 | (kv "0.0.9"))
129 | :files
130 | ("elnode.el"
131 | "elnode-rle.el"
132 | "elnode-wiki.el"
133 | "default-wiki-index.creole"
134 | "default-webserver-test.html"
135 | "default-webserver-image.png"
136 | "README.creole"
137 | "COPYING")
138 | :test
139 | (:requires
140 | ((fakir "0.0.14"))
141 | :files
142 | ("elnode-tests.el")))
143 | }}}
144 |
145 | //Elnode// is like this because it needs to deliver the default wiki
146 | pages, these must be packaged so they can be installed at package
147 | deploy time.
148 |
149 | //elmarmalade// is an example of packaging directories:
150 |
151 | {{{
152 | (marmalade-service
153 | :version "2.0.9"
154 | :doc "The Marmalade package store service."
155 | :requires
156 | ((dash "1.1.0")
157 | (s "1.6.0")
158 | (s-buffer "0.0.4")
159 | (elnode "0.9.9.6.11")
160 | (htmlize "1.3.9"))
161 | :files
162 | ("marmalade-archive.el"
163 | "marmalade-service.el"
164 | "marmalade-customs.el"
165 | "marmalade-boot.el"
166 | "front-page.html"
167 | "login-page.html"
168 | "upload-page.html"
169 | "static/style.css") ;; the directory 'static' will be included
170 | :test
171 | (:requires
172 | ((fakir "0.1.1")
173 | (s "1.4.0"))
174 | :files
175 | ("marmalade-tests.el"
176 | "elnode-0.9.9.6.9.tar")))
177 | }}}
178 |
179 | == Test packages ==
180 |
181 | Test packages can be defined in the recipe or automatically inferred
182 | through the presence of files matching the pattern {{{test.*.el}}} or
183 | {{{.*test.el}}}.
184 |
185 | Test packages are always named //package-name//{{{-test}}}.
186 |
187 | == Testing ==
188 |
189 | A useful feature of elpakit is being able to build the kit and then
190 | run tests defined for a package (note: only //one// of the packages in
191 | the kit right now).
192 |
193 | You can do that like this:
194 |
195 | {{{
196 | (elpakit-test
197 | '("~/work/emacs-db"
198 | "~/work/emacs-db-pg"
199 | "~/work/pg"
200 | "~/work/emacs-kv")
201 | 'db-pg-tests
202 | 'db-pg)
203 | }}}
204 |
205 | The output is stored in the buffer //*elpakit*//.
206 |
207 | Elpakit constructs a temporary archive for the kit and then builds the
208 | packages to it and then runs an Emacs instance with your local
209 | {{{package-archives}}} plus the temporary one and then installs the
210 | package you've specified and then runs the tests you specified with an
211 | ERT selector.
212 |
213 | === Testing interactively ===
214 |
215 | {{{elpakit-test}}} can be run interactively. When used like that it
216 | uses the current directory as a guess about a //package dir//. This
217 | means you can only package and test one package right now. Any
218 | dependancies must be present in the repositories declared in your
219 | local {{{package-archives}}} variable.
220 |
221 |
222 | === Testing with a daemon ===
223 |
224 | You can also start an elpakit in a daemonized Emacs and optionally run
225 | tests.
226 |
227 | {{{
228 | (elpakit-start-server some-elpakit to-install)
229 | }}}
230 |
231 | will start a server, open the //*elpakit-daemon*// buffer and setup
232 | the //to-install// there.
233 |
234 | To run tests automatically, add the //test// argument, for example:
235 |
236 | {{{
237 | (elpakit-start-server elnode-elpakit 'elnode-tests "elnode")
238 | }}}
239 |
240 | will install the //elnode-tests// package and then run tests for
241 | //elnode.*// in a server Emacs.
242 |
243 | You can kill that server Emacs from the command line or from the
244 | //*elpakit-daemon*// buffer like this:
245 |
246 | {{{
247 | M-x elpakit-stop-server
248 | }}}
249 |
250 |
251 | === Managing test processes ===
252 |
253 | Elpakit includes a management tool for processes it starts. Use:
254 |
255 | {{{
256 | M-x elpakit-list-processes
257 | }}}
258 |
259 | to make a process list of elpakit started processes. You can use this
260 | to show the log of an elpakit process (key {{{L}}}) or to kill a
261 | running elpakit process (key {{{K}}}) even if it's a daemon.
262 |
263 | Keys available:
264 |
265 | | F | elpakit-process-open-emacsd | Open the emacsd directory in dired |
266 | | O | elpakit-process-open-emacsd | |
267 | | f | elpakit-process-open-emacs-init | Open the init.el file |
268 | | K | elpakit-process-kill | Kill the process or daemon |
269 | | k | elpakit-process-kill | |
270 | | L | elpakit-process-show-buffer | Show the process buffer |
271 |
272 | == Refactoring Support ==
273 |
274 | Elpakit includes some support for refactoring. When you are dealing
275 | with projects with lots of files (which Elpakit makes quite easy) it's
276 | common to need to refactor.
277 |
278 | Elpakit includes {{{elpakit-multi-occur}}} which can show you every
279 | reference to a symbol within your Elpakit project.
280 |
281 | {{{elpakit-isearch-hook-jack-in}}} can be added to
282 | {{{emacs-lisp-mode-hook}}} to connect {{{elpakit-multi-occur}}} to
283 | isearch.
284 |
285 | It might also be advisable to connect {{{elpakit-multi-occur}}} to a
286 | keybinding in the normal {{{emacs-lisp-mode}}}. This is left up to you
287 | but I suggest:
288 |
289 | {{{
290 | (define-key emacs-lisp-mode-map (kbd "M-o") 'elpakit-multi-occur)
291 | }}}
292 |
293 | == Notes on the differences with MELPA and Cask ==
294 |
295 | I once hoped to merge elpakit with MELPA and Cask but it doesn't seem
296 | possible. So I build elpakit purely for my own ends these days.
297 |
298 | The MELPA recipe standard has no:
299 |
300 | * {{{version}}}
301 | * {{{doc}}}
302 | * {{{requires}}}
303 | * or {{{test}}} sections
304 |
305 | as far as I can see. These have been added to elpakit to make the task
306 | of building tar files possible without having to build the {{{-pkg.el}}} file.
307 |
308 | MELPA doesn't even need the version since it pulls it from the GIT
309 | commit?
310 |
311 | A side aim for elpakit is that it makes defining a package partly a
312 | function of the package's source control. Just like it normally is
313 | with other package systems (dpkg, rpm, pip, etc...).
314 |
315 | MELPA specifies the recipes elsewhere than the repository source
316 | control. It's obvious why this has happened, they needed to support
317 | people MELPA packaging repositories they did not have commit access
318 | to.
319 |
320 | I don't know how to solve this problem, maybe the MELPA guys could
321 | switch their code to autodetect repository provided recipes somehow?
322 |
323 | Elpakit covers pretty much the same ground as Cask. The Cask program
324 | uses an external binary though while elpakit is just elisp. Elpakit
325 | also uses file based package archives quite a lot, while Cask seems to
326 | prefer HTTP. This requires an HTTP server which I don't think is a
327 | necessary step at all.
328 |
329 |
330 | == Useful tips ==
331 |
332 | There are a bunch of useful things you can do if you're building apps
333 | that are collections of elpa packages.
334 |
335 |
336 | === Building a tar package ===
337 |
338 | elpakit has all the logic to build multi-file packages so it made
339 | sense to make that available with a command:
340 |
341 | {{{
342 | M-x elpakit-make-multi
343 | }}}
344 |
345 | will use the directory you are in as a package directory (if it can be
346 | established that it is a package) or ask you to specify a package
347 | directory. It will then build that package for you in a temorary
348 | directory. It will open the temporary directory with the built package
349 | in it. You can use that to upload to Marmalade or some such.
350 |
351 |
352 | === Making a multi-file package branch for MELPA ===
353 |
354 | MELPA requires multi-file packages repositories to be packaged in a
355 | particular way. Namely that they should have the pkg.el file present
356 | in the repository.
357 |
358 | elpakit will automatically build an orphan branch for you in your
359 | repository for use by MELPA.
360 |
361 | Just set the customization variable
362 | {{{elpakit-do-melpa-on-multi-file-package}}} to true and then use
363 | {{{elpakit-make-multi}}} on a git repository based multi-file package
364 | and elpakit will make the branch for you. Elpakit won't push the
365 | branch so you get to review stuff before it goes back to your origin.
366 |
367 | === Evaling an elpakit ===
368 |
369 | You can build an elpakit entirely inside your emacs. This basically
370 | means just evaling all the lisp it finds.
371 |
372 | {{{
373 | (elpakit-eval
374 | '("~/work/elnode-auth"
375 | "~/work/emacs-db"
376 | "~/work/shoes-off"
377 | "~/work/rcirc-ssh"))
378 | }}}
379 |
380 | Sometimes you have to muck about with the ordering of the kit to make
381 | it work because there are dependancies (requires) that don't work
382 | unless you eval things in a particular order.
383 |
384 | === A remote elpakit destination ===
385 |
386 | Elpakit doesn't care what the destination is as long as it looks like
387 | a directory to Emacs. That means you can use TRAMP:
388 |
389 | {{{
390 | (elpakit "/ssh:my-remote-host.example.com/myapp-elpa/"
391 | '("~/work/elnode-auth"
392 | "~/work/emacs-db"
393 | "~/work/shoes-off"))
394 | }}}
395 |
396 | This is useful for deploying packages to remote locations, for example
397 | "live" in an [[http://elnode.org|elnode]] app.
398 |
399 | === Copyable elpakits ===
400 |
401 | An alternative to the //push to remote// elpakit is building it
402 | locally and having the remote pull it. This is possible too,
403 | especially with a bit of elnode magic.
404 |
405 | {{{
406 | (elpakit "/tmp/my-archive"
407 | '("~/work/elnode-auth"
408 | "~/work/emacs-db"
409 | "~/work/shoes-off"))
410 | (elnode-make-webserver "/tmp/my-archive" :port 8007 :host "0.0.0.0")
411 | }}}
412 |
413 | and on the remote use:
414 |
415 | {{{
416 | wget -r -np http://elnode-server:8007
417 | }}}
418 |
419 | to get the package archive built by elpakit.
420 |
421 |
422 | === Defining kits to be reusable ===
423 |
424 | Just collecting the list of package directories into a list means you
425 | can do lots of different things with elpakit:
426 |
427 | {{{
428 | (defconst shoes-off-elpakit
429 | '("~/work/shoes-off"
430 | "~/work/rcirc-ssh"
431 | "~/work/emacs-db"
432 | "~/work/esxml"
433 | "~/work/elnode-auth"
434 | "~/work/emacs-kv"
435 | "~/work/shoes-off-aas/talkapp"))
436 | }}}
437 |
438 | Then you can:
439 |
440 | {{{
441 | (elpakit "~/my-app-elpa" shoes-off-elpakit)
442 | }}}
443 |
444 | If you use a {{{defconst}}} then you can re-eval it more easily.
445 |
446 |
447 | === Building kits remotely ===
448 |
449 | If you want to deploy to a remote host without pushing to an official
450 | repository you can still do that, just use tramp for the destination:
451 |
452 | {{{
453 | (elpakit
454 | "/ssh:nic@livehost.example.com:apps/app1/app-elpa"
455 | my-elpakit)
456 | }}}
457 |
458 | Presuming {{{my-elpakit}}} is an elpakit list. Elpakit uses a straight
459 | copy so tramp works fine.
460 |
461 | === Starting a server ===
462 |
463 | Starting a server and running some tests in it:
464 |
465 | {{{
466 | (setq nic-server
467 | (elpakit-start-server
468 | shoes-off-train 'talkapp :test t))
469 | }}}
470 |
471 | Server's can be started with extra lisp to initialize them, in this
472 | case they do not auto-require the install target.
473 |
474 | So here's a quick snippet to start a server with an archive, copy some
475 | files in to the package location, then require the main thing:
476 |
477 | {{{
478 | (setq nic-server
479 | (elpakit-start-server
480 | shoes-off-train
481 | 'talkapp
482 | :extra-lisp
483 | '(progn
484 | (shell-command
485 | (format
486 | "cp -r ~/work/teamchat/talkapp/*db*.elc %s"
487 | (file-name-directory
488 | (find-lisp-object-file-name
489 | 'talkapp-start
490 | (symbol-function 'talkapp-start)))))
491 | (require (quote talkapp)))))
492 | }}}
493 |
494 | Note the clever hack to find the package location based on an autoload
495 | specified function.
496 |
497 | Here's a more clever version of that wrapped up in an interactive,
498 | defun, very useful startup routine:
499 |
500 | {{{
501 | (defvar talkapp-elpakit-server nil)
502 |
503 | ;; Start the talkapp in an elpakit server
504 | (defun talkapp-do-elpakit-server ()
505 | (interactive)
506 | (condition-case err
507 | (progn
508 | (server-eval-at (cdr talkapp-elpakit-server) '1)
509 | (error
510 | "talkapp-elpakit-server already running %s"
511 | (cdr talkapp-elpakit-server)))
512 | (error (if (string-match "^No such server" (cadr err))
513 | (setq talkapp-elpakit-server
514 | (elpakit-start-server
515 | shoes-off-train
516 | 'talkapp
517 | :extra-lisp
518 | ;; Copy in the db files from the working dir...
519 | '(progn
520 | (shell-command
521 | (format
522 | "cp -r ~/work/teamchat/talkapp/*db*.elc %s"
523 | (file-name-directory
524 | (find-lisp-object-file-name
525 | 'talkapp-start
526 | (symbol-function 'talkapp-start)))))
527 | (require (quote talkapp)))))
528 | ;; Else rethrow
529 | (signal (car err) (cdr err))))))
530 | }}}
531 |
532 | It only allows one at a time atm but that's still better than trying
533 | to do everything inside a single emacs.
534 |
535 | === Making a package from your ELPA ===
536 |
537 | Elpakit will also let you make a package from your currently installed
538 | ELPA packages. This is useful if you want to share a lot of
539 | dependencies with friends or colleagues.
540 |
541 | {{{
542 | M-x elpakit-package-list-buf
543 | }}}
544 |
545 | Makes a buffer with a list of your packages in it.
546 |
547 | In the ELPA package list buffer:
548 |
549 | | Key | What it does |
550 | | k | kill the current package |
551 | | M | make a new package file from the remaining package names |
552 |
553 | The package file that it makes can then be checked into Git (to be
554 | made available with MELPA) or uploaded
555 | to [[http://marmalade-repo.org|marmalade-repo]].
556 |
557 |
558 |
559 | == Glossary ==
560 |
561 | A //package// is either a single EmacsLisp file with a special header
562 | or a collection of EmacsLisp and possibly other files (like an info
563 | file or HTML files) in a tarball. A single file EmacsLisp package is
564 | called a //single file package// and a tar package is called a
565 | //multi-file package//. Elpakit deals with either single or multi file
566 | packages and can //build// a multi-file package for you (a non-trivial
567 | process) from a collection of source files.
568 |
569 | A //package dir// is a directory in which the source files for a
570 | package are kept. Probably this is a checkout of a version control
571 | repository but need not be.
572 |
573 | A //recipe// is a file that tells Elpakit how to put together a
574 | package. It is found in a //package-dir//. For single file packages
575 | this is almost never necessary. For multi-file packages it is
576 | necessary. The recipe is necessary for multi-file packages because it
577 | contains information about the package that has no other home //and//
578 | because Elpakit cannot guess what files in your tree you actually want
579 | to be present in your resulting package.
580 |
581 | An //archive// is a place you can install packages from. Archives can
582 | either be {{{http}}} URLs or a local directory. Elpakit can make
583 | archives from collections of //package dirs//. To actually install
584 | from a particular archive you need to add the archive to the Emacs
585 | variable {{{package-archives}}}.
586 |
587 | An //elpakit// is a list of //package-dir// that are going to be built
588 | into an archive. Once the archive is built we can do more with it,
589 | such as running tests on the packages we've built (which will be clean
590 | and not tainted by any local evaluation you have done in your local
591 | Emacs).
592 |
593 | A //local emacs// is the Emacs you are writing code and running
594 | Elpakit in, as opposed to an Emacs instance you start to do testing or
595 | such.
596 |
597 |
598 | == TODO ==
599 |
600 | * include any dir file and info files in multi-file packages
601 | * add a walk through constructor process for recipe files?
602 | * add a mode (other than lisp-mode) for editing recipe files?
603 | * add the URL to the package in {{{elpakit/make-pkg-lisp}}}
604 | ** should go into {{{define-package}}}'s {{{extra-properties}}}
605 | * add upstream repository list to a recipe
606 | ** so that a package could specify where it's dependant repositorys can be found
607 | ** this is mainly so a package could be installed from a url and specify that depends come from marmalade (for example)
608 |
--------------------------------------------------------------------------------
18 |
19 |
20 |
21 |
--------------------------------------------------------------------------------
/elpakit-run.el:
--------------------------------------------------------------------------------
1 | ;;; elpakit-run.el --- run elpakit from the command line
2 |
3 | ;; run with:
4 | ;;
5 | ;; emacs -batch -l elpakit-run.el
6 |
7 | (when (member
8 | "elpakit-run.el"
9 | (mapcar 'file-name-nondirectory command-line-args))
10 | (let ((elpakit-command (car-safe (reverse command-line-args)))
11 | (package-user-dir (make-temp-name "/tmp/elpakit-run")))
12 | (package-initialize)
13 | (add-to-list
14 | 'package-archives
15 | '("marmalade" . "http://marmalade-repo.org/packages/"))
16 | (package-refresh-contents)
17 | (package-install 'elpakit)
18 | (elpakit-make-multi ".")))
19 |
20 | ;;; elpakit-run.el ends here
21 |
--------------------------------------------------------------------------------
/emacs-db/todo.org:
--------------------------------------------------------------------------------
1 | * postgresql driver
2 | ** use the marsden library
3 | ** [[~/work/emacs-postgres/pg.el]]
4 | ** async plan
5 | *** writes
6 | **** have a hashtable db but then send writes async to pg
7 | **** when they come back you can mark the original row as stored in pg
8 | **** if it doesn't ever write it's because the db is down
9 | ***** and you can start really really alerting
10 | *** reads are the problem
11 | **** because of course stuff can change in the db but not the local db
12 | ** how does it work
13 | *** we need lazy connection establishment
14 | **** connection tied to a db
15 | **** possibly a connection pool
16 | *** db-get
17 | **** find or make a connection
18 | ****
19 |
--------------------------------------------------------------------------------
/examples/scratch.el:
--------------------------------------------------------------------------------
1 | ;;; scratch working of various elpakits
2 |
3 | (elpakit
4 | "/tmp/elpatest1"
5 | '("~/work/emacs-db"
6 | "~/work/emacs-db-pg"
7 | "~/work/pg"
8 | "~/work/emacs-kv"))
9 |
10 | (elpakit-test
11 | '("~/work/emacs-db"
12 | "~/work/emacs-db-pg"
13 | "~/work/pg"
14 | "~/work/emacs-kv")
15 | 'db-pg-tests
16 | 'db)
17 |
18 | (elpakit-test
19 | '("~/work/elnode-auth"
20 | "~/work/emacs-db"
21 | "~/work/emacs-kv")
22 | 'elnode-tests
23 | 'elnode)
24 |
25 | (elpakit-test
26 | '("~/work/emacs-web")
27 | 'web-test
28 | 'web)
29 |
30 | (elpakit-test
31 | '("~/work/mongo-el")
32 | 'mongo-tests
33 | 'bson)
34 |
35 |
36 | ;;; end of scratch.el
37 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-js-tests.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-js-tests.el --- tests for elnode-js -*- lexical-binding: t -*-
2 |
3 | (require 'fakir)
4 | (require 'elnode)
5 |
6 | (ert-deftest elnode-js/browserify-bin ()
7 | (should
8 | (equal
9 | (let ((default-directory (expand-file-name "node-test-dir/src")))
10 | (elnode-js/browserify-bin "."))
11 | (expand-file-name "node-test-dir/node_modules/.bin/browserify"))))
12 |
13 | (with-elnode-mock-httpcon :httpcon
14 | (:elnode-http-method "GET")
15 | (elnode-js/browserify-send-func
16 | :httpcon
17 | (expand-file-name "src/example.js" "node-test-dir"))
18 | (with-current-buffer (fakir-get-output-buffer)
19 | (buffer-string)))
20 |
21 | (provide 'elnode-js-tests)
22 |
23 | ;;; elnode-js-tests.el ends here
24 |
--------------------------------------------------------------------------------
/elnode-auth/recipes/elnode:
--------------------------------------------------------------------------------
1 | (elnode
2 | :version "0.9.9.8.7"
3 | :doc "The Emacs webserver."
4 | :requires
5 | ((web "0.4.3") ;; for proxy
6 | (dash "1.1.0")
7 | (noflet "0.0.7")
8 | (s "1.5.0")
9 | (creole "0.8.14") ;; for wiki
10 | (fakir "0.1.6") ;; we provide the test-call with fakir
11 | (db "0.0.5")
12 | (kv "0.0.17"))
13 | :files
14 | ("elnode.el"
15 | "elnode-compat.el"
16 | "elnode-lists.el"
17 | "elnode-js.el"
18 | "elnode-tools.el"
19 | "elnode-wiki.el"
20 | "elnode-proxy.el"
21 | "elnode-log-mode.el"
22 | "elnode-testsupport.el"
23 | "default-wiki-index.creole"
24 | "default-webserver-test.html"
25 | "default-webserver-image.png"
26 | "README.creole"
27 | "COPYING")
28 | :test
29 | (:files
30 | ("elnode-tests.el")))
31 |
--------------------------------------------------------------------------------
/elnode-auth/elnode-log-mode.el:
--------------------------------------------------------------------------------
1 | ;;; elnode-log-mode.el - view elnode log files nicely
2 |
3 | ;;;###autoload
4 | (define-generic-mode 'elnode-log-mode
5 | nil ; comments
6 | nil; keywords
7 | `(("^\\([0-9:-]+\\) .*" 1 '(face '(italic (:foreground "blue"))))
8 | ("^[0-9:-]+ \\([32][0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "green")))
9 | ("^[0-9:-]+ \\(4[0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "yellow")))
10 | ("^[0-9:-]+ \\(5[0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "red")))
11 | ("^.* \\(GET\\|POST\\|HEAD\\|DELETE\\|TRACE\\)" 1 '(face '(bold (:foreground "purple"))))) ; font-lock list
12 | nil
13 | '((lambda ()
14 | ;;(use-local-map elnode-log-mode-map)
15 | (setq buffer-read-only 't)
16 | (set-buffer-modified-p nil)
17 | ))
18 | "Elnode log viewing mode.
19 |
20 | For viewing access log files from Elnode.")
21 |
22 | ;;; elnode-log-mode.el ends here
23 |
--------------------------------------------------------------------------------
/elnode-auth/FAQ.creole:
--------------------------------------------------------------------------------
1 | = FAQ =
2 |
3 | == is Elnode fast enough? ==
4 |
5 | Speed just isn't a concern of Elnode. Elnode is focussed on making it
6 | easy to write asynchronous webapps with EmacsLisp. The focus is on
7 | scalability, not speed.
8 |
9 |
10 | == is Elnode scalable enough? ==
11 |
12 | No. But this is mostly a function of Emacs' IO which uses {{{select}}}
13 | for non-blocking calls and not other, more scalable non-blocking IO
14 | librarys.
15 |
16 | I hope at some point to contribute a better IO library to Emacs.
17 |
18 |
19 | == Why does Elnode always use chunked encoding? ==
20 |
21 | Because it's simpler. {{{elnode-http-start}}} can send the header
22 | without knowing what sort of data you'll be sending.
23 |
24 | I may provide a single start and return call in the future that can
25 | send a buffer or a single string. Pre-buffered, one shot computed
26 | stuff isn't really the point of async programming though.
27 |
--------------------------------------------------------------------------------
/fake-package-with-elisp/fake-package.el:
--------------------------------------------------------------------------------
1 | ;;; fake-package.el --- just a fake package for elpakit testing -*- lexical-binding: t; -*-
2 |
3 | ;; Copyright (C) 2014 Nic Ferrier
4 |
5 | ;; Author: Nic Ferrier