├── .dir-locals.el
├── .gitignore
├── .gitmodules
├── .travis.yml
├── COPYING
├── Cask
├── Makefile
├── README.rst
├── doc
├── Makefile
├── make.bat
└── source
│ ├── conf.el
│ ├── conf.py
│ ├── manual.rst
│ └── tail.rest
├── request-deferred.el
├── request.el
└── tests
├── request-testing.el
├── test-request.el
└── testserver.py
/.dir-locals.el:
--------------------------------------------------------------------------------
1 | ;;; Directory Local Variables
2 | ;;; For more information see (info "(emacs) Directory Variables")
3 |
4 | ((emacs-lisp-mode (indent-tabs-mode . nil)))
5 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .cask
2 | dist
3 | doc/build
4 | doc/source/index.rst
5 |
--------------------------------------------------------------------------------
/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "doc/eldomain"]
2 | path = doc/eldomain
3 | url = git://github.com/tkf/sphinx-eldomain.git
4 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | language: python
2 | env:
3 | matrix:
4 | - EMACS=emacs
5 | - EMACS=emacs24 EMACS_PPA=ppa:cassou/emacs
6 | - EMACS=emacs-snapshot EMACS_PPA=ppa:cassou/emacs
7 | - EMACS=emacs-snapshot EMACS_PPA=ppa:ubuntu-elisp/ppa
8 | global:
9 | - CASK=$HOME/.cask/bin/cask
10 | matrix:
11 | allow_failures:
12 | - env: EMACS=emacs
13 | - env: EMACS=emacs-snapshot EMACS_PPA=ppa:cassou/emacs
14 | - env: EMACS=emacs-snapshot EMACS_PPA=ppa:ubuntu-elisp/ppa
15 | before_install:
16 | - pip install -q flask tornado
17 |
18 | # Install Emacs
19 | - if [ -n "$EMACS_PPA" ]; then
20 | sudo add-apt-repository -y "$EMACS_PPA";
21 | fi
22 | - sudo apt-get update -qq
23 | - sudo apt-get install --force-yes -qq "$EMACS"
24 | - sudo apt-get install --force-yes -qq "${EMACS}-el" || true # OK to fail
25 |
26 | # Install Cask
27 | - curl -fsSkL
28 | --max-time 10
29 | --retry 10
30 | --retry-delay 10
31 | https://raw.github.com/cask/cask/master/go
32 | | python
33 |
34 | # The following command does (should) not have any effect on test,
35 | # but to separate installation phase and testing phase:
36 | - make before-test
37 | script:
38 | make travis-ci
39 |
--------------------------------------------------------------------------------
/COPYING:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 3, 29 June 2007
3 |
4 | Copyright (C) 2007 Free Software Foundation, Inc.
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 | Preamble
9 |
10 | The GNU General Public License is a free, copyleft license for
11 | software and other kinds of works.
12 |
13 | The licenses for most software and other practical works are designed
14 | to take away your freedom to share and change the works. By contrast,
15 | the GNU General Public License is intended to guarantee your freedom to
16 | share and change all versions of a program--to make sure it remains free
17 | software for all its users. We, the Free Software Foundation, use the
18 | GNU General Public License for most of our software; it applies also to
19 | any other work released this way by its authors. You can apply it to
20 | your programs, too.
21 |
22 | When we speak of free software, we are referring to freedom, not
23 | price. Our General Public Licenses are designed to make sure that you
24 | have the freedom to distribute copies of free software (and charge for
25 | them if you wish), that you receive source code or can get it if you
26 | want it, that you can change the software or use pieces of it in new
27 | free programs, and that you know you can do these things.
28 |
29 | To protect your rights, we need to prevent others from denying you
30 | these rights or asking you to surrender the rights. Therefore, you have
31 | certain responsibilities if you distribute copies of the software, or if
32 | you modify it: responsibilities to respect the freedom of others.
33 |
34 | For example, if you distribute copies of such a program, whether
35 | gratis or for a fee, you must pass on to the recipients the same
36 | freedoms that you received. You must make sure that they, too, receive
37 | or can get the source code. And you must show them these terms so they
38 | know their rights.
39 |
40 | Developers that use the GNU GPL protect your rights with two steps:
41 | (1) assert copyright on the software, and (2) offer you this License
42 | giving you legal permission to copy, distribute and/or modify it.
43 |
44 | For the developers' and authors' protection, the GPL clearly explains
45 | that there is no warranty for this free software. For both users' and
46 | authors' sake, the GPL requires that modified versions be marked as
47 | changed, so that their problems will not be attributed erroneously to
48 | authors of previous versions.
49 |
50 | Some devices are designed to deny users access to install or run
51 | modified versions of the software inside them, although the manufacturer
52 | can do so. This is fundamentally incompatible with the aim of
53 | protecting users' freedom to change the software. The systematic
54 | pattern of such abuse occurs in the area of products for individuals to
55 | use, which is precisely where it is most unacceptable. Therefore, we
56 | have designed this version of the GPL to prohibit the practice for those
57 | products. If such problems arise substantially in other domains, we
58 | stand ready to extend this provision to those domains in future versions
59 | of the GPL, as needed to protect the freedom of users.
60 |
61 | Finally, every program is threatened constantly by software patents.
62 | States should not allow patents to restrict development and use of
63 | software on general-purpose computers, but in those that do, we wish to
64 | avoid the special danger that patents applied to a free program could
65 | make it effectively proprietary. To prevent this, the GPL assures that
66 | patents cannot be used to render the program non-free.
67 |
68 | The precise terms and conditions for copying, distribution and
69 | modification follow.
70 |
71 | TERMS AND CONDITIONS
72 |
73 | 0. Definitions.
74 |
75 | "This License" refers to version 3 of the GNU General Public License.
76 |
77 | "Copyright" also means copyright-like laws that apply to other kinds of
78 | works, such as semiconductor masks.
79 |
80 | "The Program" refers to any copyrightable work licensed under this
81 | License. Each licensee is addressed as "you". "Licensees" and
82 | "recipients" may be individuals or organizations.
83 |
84 | To "modify" a work means to copy from or adapt all or part of the work
85 | in a fashion requiring copyright permission, other than the making of an
86 | exact copy. The resulting work is called a "modified version" of the
87 | earlier work or a work "based on" the earlier work.
88 |
89 | A "covered work" means either the unmodified Program or a work based
90 | on the Program.
91 |
92 | To "propagate" a work means to do anything with it that, without
93 | permission, would make you directly or secondarily liable for
94 | infringement under applicable copyright law, except executing it on a
95 | computer or modifying a private copy. Propagation includes copying,
96 | distribution (with or without modification), making available to the
97 | public, and in some countries other activities as well.
98 |
99 | To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies. Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 |
103 | An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License. If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 |
112 | 1. Source Code.
113 |
114 | The "source code" for a work means the preferred form of the work
115 | for making modifications to it. "Object code" means any non-source
116 | form of a work.
117 |
118 | A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 |
123 | The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form. A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 |
134 | The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities. However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work. For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 |
147 | The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 |
151 | The Corresponding Source for a work in source code form is that
152 | same work.
153 |
154 | 2. Basic Permissions.
155 |
156 | All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met. This License explicitly affirms your unlimited
159 | permission to run the unmodified Program. The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work. This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 |
164 | You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force. You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright. Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 |
175 | Conveying under any other circumstances is permitted solely under
176 | the conditions stated below. Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 |
179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 |
181 | No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 |
187 | When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 |
195 | 4. Conveying Verbatim Copies.
196 |
197 | You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 |
205 | You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 |
208 | 5. Conveying Modified Source Versions.
209 |
210 | You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 |
214 | a) The work must carry prominent notices stating that you modified
215 | it, and giving a relevant date.
216 |
217 | b) The work must carry prominent notices stating that it is
218 | released under this License and any conditions added under section
219 | 7. This requirement modifies the requirement in section 4 to
220 | "keep intact all notices".
221 |
222 | c) You must license the entire work, as a whole, under this
223 | License to anyone who comes into possession of a copy. This
224 | License will therefore apply, along with any applicable section 7
225 | additional terms, to the whole of the work, and all its parts,
226 | regardless of how they are packaged. This License gives no
227 | permission to license the work in any other way, but it does not
228 | invalidate such permission if you have separately received it.
229 |
230 | d) If the work has interactive user interfaces, each must display
231 | Appropriate Legal Notices; however, if the Program has interactive
232 | interfaces that do not display Appropriate Legal Notices, your
233 | work need not make them do so.
234 |
235 | A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit. Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 |
245 | 6. Conveying Non-Source Forms.
246 |
247 | You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 |
252 | a) Convey the object code in, or embodied in, a physical product
253 | (including a physical distribution medium), accompanied by the
254 | Corresponding Source fixed on a durable physical medium
255 | customarily used for software interchange.
256 |
257 | b) Convey the object code in, or embodied in, a physical product
258 | (including a physical distribution medium), accompanied by a
259 | written offer, valid for at least three years and valid for as
260 | long as you offer spare parts or customer support for that product
261 | model, to give anyone who possesses the object code either (1) a
262 | copy of the Corresponding Source for all the software in the
263 | product that is covered by this License, on a durable physical
264 | medium customarily used for software interchange, for a price no
265 | more than your reasonable cost of physically performing this
266 | conveying of source, or (2) access to copy the
267 | Corresponding Source from a network server at no charge.
268 |
269 | c) Convey individual copies of the object code with a copy of the
270 | written offer to provide the Corresponding Source. This
271 | alternative is allowed only occasionally and noncommercially, and
272 | only if you received the object code with such an offer, in accord
273 | with subsection 6b.
274 |
275 | d) Convey the object code by offering access from a designated
276 | place (gratis or for a charge), and offer equivalent access to the
277 | Corresponding Source in the same way through the same place at no
278 | further charge. You need not require recipients to copy the
279 | Corresponding Source along with the object code. If the place to
280 | copy the object code is a network server, the Corresponding Source
281 | may be on a different server (operated by you or a third party)
282 | that supports equivalent copying facilities, provided you maintain
283 | clear directions next to the object code saying where to find the
284 | Corresponding Source. Regardless of what server hosts the
285 | Corresponding Source, you remain obligated to ensure that it is
286 | available for as long as needed to satisfy these requirements.
287 |
288 | e) Convey the object code using peer-to-peer transmission, provided
289 | you inform other peers where the object code and Corresponding
290 | Source of the work are being offered to the general public at no
291 | charge under subsection 6d.
292 |
293 | A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 |
297 | A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling. In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage. For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product. A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 |
310 | "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source. The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 |
318 | If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information. But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 |
329 | The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed. Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 |
337 | Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 |
343 | 7. Additional Terms.
344 |
345 | "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law. If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 |
354 | When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it. (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.) You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 |
361 | Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 |
365 | a) Disclaiming warranty or limiting liability differently from the
366 | terms of sections 15 and 16 of this License; or
367 |
368 | b) Requiring preservation of specified reasonable legal notices or
369 | author attributions in that material or in the Appropriate Legal
370 | Notices displayed by works containing it; or
371 |
372 | c) Prohibiting misrepresentation of the origin of that material, or
373 | requiring that modified versions of such material be marked in
374 | reasonable ways as different from the original version; or
375 |
376 | d) Limiting the use for publicity purposes of names of licensors or
377 | authors of the material; or
378 |
379 | e) Declining to grant rights under trademark law for use of some
380 | trade names, trademarks, or service marks; or
381 |
382 | f) Requiring indemnification of licensors and authors of that
383 | material by anyone who conveys the material (or modified versions of
384 | it) with contractual assumptions of liability to the recipient, for
385 | any liability that these contractual assumptions directly impose on
386 | those licensors and authors.
387 |
388 | All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10. If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term. If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 |
398 | If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 |
403 | Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 |
407 | 8. Termination.
408 |
409 | You may not propagate or modify a covered work except as expressly
410 | provided under this License. Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 |
415 | However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 |
422 | Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 |
429 | Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License. If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 |
435 | 9. Acceptance Not Required for Having Copies.
436 |
437 | You are not required to accept this License in order to receive or
438 | run a copy of the Program. Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance. However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work. These actions infringe copyright if you do
443 | not accept this License. Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 |
446 | 10. Automatic Licensing of Downstream Recipients.
447 |
448 | Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License. You are not responsible
451 | for enforcing compliance by third parties with this License.
452 |
453 | An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations. If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 |
463 | You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License. For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 |
471 | 11. Patents.
472 |
473 | A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based. The
475 | work thus licensed is called the contributor's "contributor version".
476 |
477 | A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version. For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 |
487 | Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 |
492 | In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement). To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 |
499 | If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients. "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 |
513 | If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 |
521 | A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License. You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 |
536 | Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 |
540 | 12. No Surrender of Others' Freedom.
541 |
542 | If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License. If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all. For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 |
552 | 13. Use with the GNU Affero General Public License.
553 |
554 | Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work. The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 |
563 | 14. Revised Versions of this License.
564 |
565 | The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time. Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 |
570 | Each version is given a distinguishing version number. If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation. If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 |
579 | If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 |
584 | Later license versions may give you additional or different
585 | permissions. However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 |
589 | 15. Disclaimer of Warranty.
590 |
591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 |
600 | 16. Limitation of Liability.
601 |
602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 |
612 | 17. Interpretation of Sections 15 and 16.
613 |
614 | If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 |
621 | END OF TERMS AND CONDITIONS
622 |
623 | How to Apply These Terms to Your New Programs
624 |
625 | If you develop a new program, and you want it to be of the greatest
626 | possible use to the public, the best way to achieve this is to make it
627 | free software which everyone can redistribute and change under these terms.
628 |
629 | To do so, attach the following notices to the program. It is safest
630 | to attach them to the start of each source file to most effectively
631 | state the exclusion of warranty; and each file should have at least
632 | the "copyright" line and a pointer to where the full notice is found.
633 |
634 |
635 | Copyright (C)
636 |
637 | This program is free software: you can redistribute it and/or modify
638 | it under the terms of the GNU General Public License as published by
639 | the Free Software Foundation, either version 3 of the License, or
640 | (at your option) any later version.
641 |
642 | This program is distributed in the hope that it will be useful,
643 | but WITHOUT ANY WARRANTY; without even the implied warranty of
644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
645 | GNU General Public License for more details.
646 |
647 | You should have received a copy of the GNU General Public License
648 | along with this program. If not, see .
649 |
650 | Also add information on how to contact you by electronic and paper mail.
651 |
652 | If the program does terminal interaction, make it output a short
653 | notice like this when it starts in an interactive mode:
654 |
655 | Copyright (C)
656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
657 | This is free software, and you are welcome to redistribute it
658 | under certain conditions; type `show c' for details.
659 |
660 | The hypothetical commands `show w' and `show c' should show the appropriate
661 | parts of the General Public License. Of course, your program's commands
662 | might be different; for a GUI interface, you would use an "about box".
663 |
664 | You should also get your employer (if you work as a programmer) or school,
665 | if any, to sign a "copyright disclaimer" for the program, if necessary.
666 | For more information on this, and how to apply and follow the GNU GPL, see
667 | .
668 |
669 | The GNU General Public License does not permit incorporating your program
670 | into proprietary programs. If your program is a subroutine library, you
671 | may consider it more useful to permit linking proprietary applications with
672 | the library. If this is what you want to do, use the GNU Lesser General
673 | Public License instead of this License. But first, please read
674 | .
675 |
--------------------------------------------------------------------------------
/Cask:
--------------------------------------------------------------------------------
1 | (source melpa)
2 | (source marmalade)
3 |
4 | (package "request" "0" "Compatible layer for URL request in Emacs")
5 |
6 | (development
7 | (depends-on "ert")
8 | (depends-on "deferred"))
9 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | CASK ?= cask
2 | EMACS ?= emacs
3 | VIRTUAL_EMACS = ${CASK} exec ${EMACS}
4 |
5 | ELPA_DIR = \
6 | .cask/$(shell ${EMACS} -Q --batch --eval '(princ emacs-version)')/elpa
7 | # See: cask-elpa-dir
8 |
9 | TEST_1 = ${MAKE} EMACS=${EMACS} CASK=${CASK} test-1
10 |
11 | .PHONY : test test-all test-1 compile elpa clean clean-elpa clean-elc \
12 | print-deps before-test travis-ci
13 |
14 | test: elpa
15 | ${MAKE} test-3
16 |
17 | test-3: test-3-tornado test-3-flask
18 |
19 | test-3-tornado:
20 | EL_REQUEST_TEST_SERVER=tornado ${MAKE} test-2
21 |
22 | test-3-flask:
23 | EL_REQUEST_TEST_SERVER=flask ${MAKE} test-2
24 |
25 | # Run test for different backends, for one server.
26 | test-2: test-2-url-retrieve test-2-curl
27 |
28 | test-2-url-retrieve:
29 | EL_REQUEST_BACKEND=url-retrieve ${TEST_1}
30 |
31 | test-2-curl:
32 | EL_REQUEST_BACKEND=curl ${TEST_1}
33 |
34 | # Run test without checking elpa directory.
35 | test-1:
36 | ${VIRTUAL_EMACS} -Q -batch \
37 | -L . -L tests -l tests/test-request.el \
38 | -f ert-run-tests-batch-and-exit
39 |
40 | elpa: ${ELPA_DIR}
41 | ${ELPA_DIR}: Cask
42 | ${CASK} install
43 | touch $@
44 |
45 | clean-elpa:
46 | rm -rf ${ELPA_DIR}
47 |
48 | compile: clean-elc elpa
49 | ${VIRTUAL_EMACS} -Q -batch -L . -L tests \
50 | -f batch-byte-compile *.el */*.el
51 |
52 | clean-elc:
53 | rm -f *.elc */*.elc
54 |
55 | clean: clean-elpa clean-elc
56 |
57 | print-deps: elpa
58 | @echo "----------------------- Dependencies -----------------------"
59 | $(EMACS) --version
60 | curl --version
61 | @echo "------------------------------------------------------------"
62 |
63 | before-test: elpa
64 |
65 | travis-ci: print-deps test
66 |
67 |
68 |
69 | # Run test against Emacs listed in ${EMACS_LIST}.
70 | # This is for running tests for multiple Emacs versions.
71 | # This is not used in Travis CI. Usage::
72 | #
73 | # make EMACS_LIST="emacs emacs-snapshot emacs23" test-all
74 | #
75 | # See: http://stackoverflow.com/a/12110773/727827
76 | #
77 | # Use ${MET_MAKEFLAGS} to do the tests in parallel.
78 | #
79 | # MET_MAKEFLAGS=-j4
80 | #
81 | # Use ${MET_PRE_TARGETS} to set additional jobs to do before tests.
82 | #
83 | # MET_PRE_TARGETS=compile
84 |
85 | JOBS := $(addprefix job-,${EMACS_LIST})
86 | .PHONY: ${JOBS}
87 |
88 | ${JOBS}: job-%:
89 | ${MAKE} EMACS=$* clean-elc ${MET_PRE_TARGETS}
90 | ${MAKE} EMACS=$* ${MET_MAKEFLAGS} test
91 |
92 | test-all: ${JOBS}
93 |
94 |
95 |
96 | ### Package installation
97 | PACKAGE = request.el
98 | PACKAGE_USER_DIR =
99 | TEST_PACKAGE_DIR = dist/test
100 | TEST_INSTALL = ${MAKE} install-dist PACKAGE_USER_DIR=${TEST_PACKAGE_DIR}
101 |
102 | install-dist:
103 | test -d '${PACKAGE_USER_DIR}'
104 | ${EMACS} --batch -Q \
105 | -l package \
106 | --eval " \
107 | (add-to-list 'package-archives \
108 | '(\"marmalade\" . \"http://marmalade-repo.org/packages/\") t)" \
109 | --eval '(setq package-user-dir "${PWD}/${PACKAGE_USER_DIR}")' \
110 | --eval '(package-list-packages)' \
111 | --eval '(package-install-file "${PWD}/${PACKAGE}")'
112 |
113 | test-install:
114 | rm -rf ${TEST_PACKAGE_DIR}
115 | mkdir -p ${TEST_PACKAGE_DIR}
116 | ${TEST_INSTALL}
117 | ${TEST_INSTALL} PACKAGE=request-deferred.el
118 |
--------------------------------------------------------------------------------
/README.rst:
--------------------------------------------------------------------------------
1 | ================================================
2 | Request.el -- Easy HTTP request for Emacs Lisp
3 | ================================================
4 |
5 | .. sidebar:: Links
6 |
7 | * `Documentation `_ (at GitHub Pages)
8 |
9 | * `Manual `_
10 |
11 | * `Repository `_ (at GitHub)
12 | * `Issue tracker `_ (at GitHub)
13 | * `Travis CI `_ |build-status|
14 |
15 |
16 | What is it?
17 | ===========
18 |
19 | Request.el is a HTTP request library with multiple backends. It
20 | supports url.el which is shipped with Emacs and curl command line
21 | program. User can use curl when s/he has it, as curl is more reliable
22 | than url.el. Library author can use request.el to avoid imposing
23 | external dependencies such as curl to users while giving richer
24 | experience for users who have curl.
25 |
26 | As request.el is implemented in extensible manner, it is possible to
27 | implement other backend such as wget. Also, if future version of
28 | Emacs support linking with libcurl, it is possible to implement a
29 | backend using it. Libraries using request.el automatically can
30 | use these backend without modifying their code.
31 |
32 | Request.el also patches url.el dynamically, to fix bugs in url.el.
33 | See `monkey patches for url.el`_ for the bugs fixed by request.el.
34 |
35 |
36 | Examples
37 | ========
38 |
39 | GET::
40 |
41 | (request
42 | "http://httpbin.org/get"
43 | :params '(("key" . "value") ("key2" . "value2"))
44 | :parser 'json-read
45 | :success (cl-function
46 | (lambda (&key data &allow-other-keys)
47 | (message "I sent: %S" (assoc-default 'args data)))))
48 |
49 | POST::
50 |
51 | (request
52 | "http://httpbin.org/post"
53 | :type "POST"
54 | :data '(("key" . "value") ("key2" . "value2"))
55 | ;; :data "key=value&key2=value2" ; this is equivalent
56 | :parser 'json-read
57 | :success (cl-function
58 | (lambda (&key data &allow-other-keys)
59 | (message "I sent: %S" (assoc-default 'form data)))))
60 |
61 | POST file (**WARNING**: it will send the contents of the current buffer!)::
62 |
63 | (request
64 | "http://httpbin.org/post"
65 | :type "POST"
66 | :files `(("current buffer" . ,(current-buffer))
67 | ("data" . ("data.csv" :data "1,2,3\n4,5,6\n")))
68 | :parser 'json-read
69 | :success (cl-function
70 | (lambda (&key data &allow-other-keys)
71 | (message "I sent: %S" (assoc-default 'files data)))))
72 |
73 | Rich callback dispatch (like `jQuery.ajax`)::
74 |
75 | (request
76 | "http://httpbin.org/status/418" ; try other codes, for example:
77 | ;; "http://httpbin.org/status/200" ; success callback will be called.
78 | ;; "http://httpbin.org/status/400" ; you will see "Got 400."
79 | :parser 'buffer-string
80 | :success
81 | (cl-function (lambda (&key data &allow-other-keys)
82 | (when data
83 | (with-current-buffer (get-buffer-create "*request demo*")
84 | (erase-buffer)
85 | (insert data)
86 | (pop-to-buffer (current-buffer))))))
87 | :error
88 | (cl-function (lambda (&rest args &key error-thrown &allow-other-keys)
89 | (message "Got error: %S" error-thrown)))
90 | :complete (lambda (&rest _) (message "Finished!"))
91 | :status-code '((400 . (lambda (&rest _) (message "Got 400.")))
92 | (418 . (lambda (&rest _) (message "Got 418.")))))
93 |
94 | Flexible PARSER option::
95 |
96 | (request
97 | "https://github.com/tkf/emacs-request/commits/master.atom"
98 | ;; Parse XML in response body:
99 | :parser (lambda () (libxml-parse-xml-region (point) (point-max)))
100 | :success (cl-function
101 | (lambda (&key data &allow-other-keys)
102 | ;; Just don't look at this function....
103 | (let ((get (lambda (node &rest names)
104 | (if names
105 | (apply get
106 | (first (xml-get-children
107 | node (car names)))
108 | (cdr names))
109 | (first (xml-node-children node))))))
110 | (message "Latest commit: %s (by %s)"
111 | (funcall get data 'entry 'title)
112 | (funcall get data 'entry 'author 'name))))))
113 |
114 | PUT JSON data::
115 |
116 | (request
117 | "http://httpbin.org/put"
118 | :type "PUT"
119 | :data (json-encode '(("key" . "value") ("key2" . "value2")))
120 | :headers '(("Content-Type" . "application/json"))
121 | :parser 'json-read
122 | :success (cl-function
123 | (lambda (&key data &allow-other-keys)
124 | (message "I sent: %S" (assoc-default 'json data)))))
125 |
126 |
127 | Compatibility / backends
128 | ========================
129 |
130 | Supported Emacs versions:
131 |
132 | ====================== ========================== =====================
133 | Emacs version Does request.el work? Tested on Travis CI
134 | |build-status|
135 | ====================== ========================== =====================
136 | GNU Emacs 24.3-devel yes (as of this writing) yes
137 | GNU Emacs 24.2 yes yes
138 | GNU Emacs 24.1 yes no
139 | GNU Emacs 23.4 yes no
140 | GNU Emacs 23.3 yes yes
141 | GNU Emacs 23.1 yes (as of this writing) no
142 | GNU Emacs < 23 ? no
143 | ====================== ========================== =====================
144 |
145 |
146 | Supported backends:
147 |
148 | ========== ==================== ================ =========================
149 | Backends Remarks Multipart Form Automatic Decompression
150 | ========== ==================== ================ =========================
151 | url.el Included in Emacs
152 | curl Reliable ✔ ✔
153 | ========== ==================== ================ =========================
154 |
155 |
156 | Monkey patches for url.el
157 | =========================
158 |
159 | Patches for following bugs are applied when request.el is loaded.
160 | If the patch is not required for the Emacs version you are using, it
161 | will not be applied.
162 |
163 | - `#12374 - 24.1.50;
164 | Incorrect redirect in url-retrieve when URL contains port number -
165 | GNU bug report logs
166 | `_
167 |
168 | (patch: `PATCH Fix bug 12374 treat port number when expanding URL
169 | `_)
170 |
171 | - `#11469 - 24.1.50; url-retrieve with PUT method fails every two
172 | times - GNU bug report logs
173 | `_
174 |
175 | (patch: `PATCH Fix bug 11469 propagate url request vars properly
176 | `_)
177 |
178 |
179 | Related projects
180 | ================
181 |
182 | `leathekd/grapnel · GitHub `_:
183 | "HTTP request for Emacs lib built on curl with flexible callback dispatch"
184 |
185 | `cinsk/emacs-curl · GitHub `_:
186 | "CURL wrapper for Emacs"
187 |
188 | `furl-el - Google Project Hosting `_:
189 | "A wrapper for url.el that adds a nicer API and the ability to make
190 | multipart POST requests."
191 |
192 |
193 | License
194 | =======
195 |
196 | Request.el is free software under GPL v3.
197 | See COPYING file for details.
198 |
199 |
200 | .. |build-status|
201 | image:: https://secure.travis-ci.org/tkf/emacs-request.png
202 | ?branch=master
203 | :target: http://travis-ci.org/tkf/emacs-request
204 | :alt: Build Status
205 |
--------------------------------------------------------------------------------
/doc/Makefile:
--------------------------------------------------------------------------------
1 | # Makefile for Sphinx documentation
2 | #
3 |
4 | # You can set these variables from the command line.
5 | SPHINXOPTS =
6 | SPHINXBUILD = sphinx-build
7 | PAPER =
8 | BUILDDIR = build
9 |
10 | # Internal variables.
11 | PAPEROPT_a4 = -D latex_paper_size=a4
12 | PAPEROPT_letter = -D latex_paper_size=letter
13 | ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
14 | # the i18n builder cannot share the environment and doctrees with the others
15 | I18NSPHINXOPTS = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
16 |
17 | .PHONY: help clean source html dirhtml singlehtml pickle \
18 | json htmlhelp qthelp devhelp epub latex latexpdf \
19 | text man changes linkcheck doctest gettext \
20 | _gh-pages-assert-repo gh-pages-update gh-pages-push \
21 | gh-pages-clone gh-pages-pull
22 |
23 | help:
24 | @echo "Please use \`make ' where is one of"
25 | @echo " html to make standalone HTML files"
26 | @echo " dirhtml to make HTML files named index.html in directories"
27 | @echo " singlehtml to make a single large HTML file"
28 | @echo " pickle to make pickle files"
29 | @echo " json to make JSON files"
30 | @echo " htmlhelp to make HTML files and a HTML help project"
31 | @echo " qthelp to make HTML files and a qthelp project"
32 | @echo " devhelp to make HTML files and a Devhelp project"
33 | @echo " epub to make an epub"
34 | @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter"
35 | @echo " latexpdf to make LaTeX files and run them through pdflatex"
36 | @echo " text to make text files"
37 | @echo " man to make manual pages"
38 | @echo " texinfo to make Texinfo files"
39 | @echo " info to make Texinfo files and run them through makeinfo"
40 | @echo " gettext to make PO message catalogs"
41 | @echo " changes to make an overview of all changed/added/deprecated items"
42 | @echo " linkcheck to check all external links for integrity"
43 | @echo " doctest to run all doctests embedded in the documentation (if enabled)"
44 |
45 | clean:
46 | -rm -rf $(BUILDDIR)/*/*
47 |
48 | source: source/index.rst
49 | source/index.rst: ../README.rst source/tail.rest
50 | cat $^ > $@
51 |
52 | html: source
53 | $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html
54 | @echo
55 | @echo "Build finished. The HTML pages are in $(BUILDDIR)/html."
56 |
57 | dirhtml:
58 | $(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml
59 | @echo
60 | @echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."
61 |
62 | singlehtml:
63 | $(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml
64 | @echo
65 | @echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."
66 |
67 | pickle:
68 | $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle
69 | @echo
70 | @echo "Build finished; now you can process the pickle files."
71 |
72 | json:
73 | $(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json
74 | @echo
75 | @echo "Build finished; now you can process the JSON files."
76 |
77 | htmlhelp:
78 | $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp
79 | @echo
80 | @echo "Build finished; now you can run HTML Help Workshop with the" \
81 | ".hhp project file in $(BUILDDIR)/htmlhelp."
82 |
83 | qthelp:
84 | $(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp
85 | @echo
86 | @echo "Build finished; now you can run "qcollectiongenerator" with the" \
87 | ".qhcp project file in $(BUILDDIR)/qthelp, like this:"
88 | @echo "# qcollectiongenerator $(BUILDDIR)/qthelp/Requestel.qhcp"
89 | @echo "To view the help file:"
90 | @echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Requestel.qhc"
91 |
92 | devhelp:
93 | $(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp
94 | @echo
95 | @echo "Build finished."
96 | @echo "To view the help file:"
97 | @echo "# mkdir -p $$HOME/.local/share/devhelp/Requestel"
98 | @echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/Requestel"
99 | @echo "# devhelp"
100 |
101 | epub:
102 | $(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub
103 | @echo
104 | @echo "Build finished. The epub file is in $(BUILDDIR)/epub."
105 |
106 | latex:
107 | $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
108 | @echo
109 | @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."
110 | @echo "Run \`make' in that directory to run these through (pdf)latex" \
111 | "(use \`make latexpdf' here to do that automatically)."
112 |
113 | latexpdf:
114 | $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
115 | @echo "Running LaTeX files through pdflatex..."
116 | $(MAKE) -C $(BUILDDIR)/latex all-pdf
117 | @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
118 |
119 | text:
120 | $(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text
121 | @echo
122 | @echo "Build finished. The text files are in $(BUILDDIR)/text."
123 |
124 | man:
125 | $(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man
126 | @echo
127 | @echo "Build finished. The manual pages are in $(BUILDDIR)/man."
128 |
129 | texinfo:
130 | $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
131 | @echo
132 | @echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."
133 | @echo "Run \`make' in that directory to run these through makeinfo" \
134 | "(use \`make info' here to do that automatically)."
135 |
136 | info:
137 | $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
138 | @echo "Running Texinfo files through makeinfo..."
139 | make -C $(BUILDDIR)/texinfo info
140 | @echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."
141 |
142 | gettext:
143 | $(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale
144 | @echo
145 | @echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."
146 |
147 | changes:
148 | $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes
149 | @echo
150 | @echo "The overview file is in $(BUILDDIR)/changes."
151 |
152 | linkcheck:
153 | $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck
154 | @echo
155 | @echo "Link check complete; look for any errors in the above output " \
156 | "or in $(BUILDDIR)/linkcheck/output.txt."
157 |
158 | doctest:
159 | $(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest
160 | @echo "Testing of doctests in the sources finished, look at the " \
161 | "results in $(BUILDDIR)/doctest/output.txt."
162 |
163 |
164 | ## GitHub Pages
165 | REPO_URL = git@github.com:tkf/emacs-request.git
166 |
167 | # Check if build/html is really a git repository. Otherwise,
168 | # committing files in there is pretty dangerous as it might goes into
169 | # Jedi's master branch.
170 | _gh-pages-assert-repo:
171 | test -d build/html/.git
172 |
173 | gh-pages-clone:
174 | rm -rf build/html
175 | git clone --branch gh-pages $(REPO_URL) build/html
176 |
177 | gh-pages-pull: _gh-pages-assert-repo
178 | cd build/html && git pull
179 |
180 | gh-pages-update: _gh-pages-assert-repo clean html
181 | @echo "Update gh-pages"
182 | cd build/html/ && \
183 | git add . && \
184 | if [ -n "$$(git ls-files --deleted)" ]; then \
185 | git ls-files --deleted | xargs git rm; \
186 | fi && \
187 | git commit -m "Update"
188 |
189 | gh-pages-push: _gh-pages-assert-repo
190 | cd build/html && git push -u origin gh-pages
191 |
--------------------------------------------------------------------------------
/doc/make.bat:
--------------------------------------------------------------------------------
1 | @ECHO OFF
2 |
3 | REM Command file for Sphinx documentation
4 |
5 | if "%SPHINXBUILD%" == "" (
6 | set SPHINXBUILD=sphinx-build
7 | )
8 | set BUILDDIR=build
9 | set ALLSPHINXOPTS=-d %BUILDDIR%/doctrees %SPHINXOPTS% source
10 | set I18NSPHINXOPTS=%SPHINXOPTS% source
11 | if NOT "%PAPER%" == "" (
12 | set ALLSPHINXOPTS=-D latex_paper_size=%PAPER% %ALLSPHINXOPTS%
13 | set I18NSPHINXOPTS=-D latex_paper_size=%PAPER% %I18NSPHINXOPTS%
14 | )
15 |
16 | if "%1" == "" goto help
17 |
18 | if "%1" == "help" (
19 | :help
20 | echo.Please use `make ^` where ^ is one of
21 | echo. html to make standalone HTML files
22 | echo. dirhtml to make HTML files named index.html in directories
23 | echo. singlehtml to make a single large HTML file
24 | echo. pickle to make pickle files
25 | echo. json to make JSON files
26 | echo. htmlhelp to make HTML files and a HTML help project
27 | echo. qthelp to make HTML files and a qthelp project
28 | echo. devhelp to make HTML files and a Devhelp project
29 | echo. epub to make an epub
30 | echo. latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter
31 | echo. text to make text files
32 | echo. man to make manual pages
33 | echo. texinfo to make Texinfo files
34 | echo. gettext to make PO message catalogs
35 | echo. changes to make an overview over all changed/added/deprecated items
36 | echo. linkcheck to check all external links for integrity
37 | echo. doctest to run all doctests embedded in the documentation if enabled
38 | goto end
39 | )
40 |
41 | if "%1" == "clean" (
42 | for /d %%i in (%BUILDDIR%\*) do rmdir /q /s %%i
43 | del /q /s %BUILDDIR%\*
44 | goto end
45 | )
46 |
47 | if "%1" == "html" (
48 | %SPHINXBUILD% -b html %ALLSPHINXOPTS% %BUILDDIR%/html
49 | if errorlevel 1 exit /b 1
50 | echo.
51 | echo.Build finished. The HTML pages are in %BUILDDIR%/html.
52 | goto end
53 | )
54 |
55 | if "%1" == "dirhtml" (
56 | %SPHINXBUILD% -b dirhtml %ALLSPHINXOPTS% %BUILDDIR%/dirhtml
57 | if errorlevel 1 exit /b 1
58 | echo.
59 | echo.Build finished. The HTML pages are in %BUILDDIR%/dirhtml.
60 | goto end
61 | )
62 |
63 | if "%1" == "singlehtml" (
64 | %SPHINXBUILD% -b singlehtml %ALLSPHINXOPTS% %BUILDDIR%/singlehtml
65 | if errorlevel 1 exit /b 1
66 | echo.
67 | echo.Build finished. The HTML pages are in %BUILDDIR%/singlehtml.
68 | goto end
69 | )
70 |
71 | if "%1" == "pickle" (
72 | %SPHINXBUILD% -b pickle %ALLSPHINXOPTS% %BUILDDIR%/pickle
73 | if errorlevel 1 exit /b 1
74 | echo.
75 | echo.Build finished; now you can process the pickle files.
76 | goto end
77 | )
78 |
79 | if "%1" == "json" (
80 | %SPHINXBUILD% -b json %ALLSPHINXOPTS% %BUILDDIR%/json
81 | if errorlevel 1 exit /b 1
82 | echo.
83 | echo.Build finished; now you can process the JSON files.
84 | goto end
85 | )
86 |
87 | if "%1" == "htmlhelp" (
88 | %SPHINXBUILD% -b htmlhelp %ALLSPHINXOPTS% %BUILDDIR%/htmlhelp
89 | if errorlevel 1 exit /b 1
90 | echo.
91 | echo.Build finished; now you can run HTML Help Workshop with the ^
92 | .hhp project file in %BUILDDIR%/htmlhelp.
93 | goto end
94 | )
95 |
96 | if "%1" == "qthelp" (
97 | %SPHINXBUILD% -b qthelp %ALLSPHINXOPTS% %BUILDDIR%/qthelp
98 | if errorlevel 1 exit /b 1
99 | echo.
100 | echo.Build finished; now you can run "qcollectiongenerator" with the ^
101 | .qhcp project file in %BUILDDIR%/qthelp, like this:
102 | echo.^> qcollectiongenerator %BUILDDIR%\qthelp\Requestel.qhcp
103 | echo.To view the help file:
104 | echo.^> assistant -collectionFile %BUILDDIR%\qthelp\Requestel.ghc
105 | goto end
106 | )
107 |
108 | if "%1" == "devhelp" (
109 | %SPHINXBUILD% -b devhelp %ALLSPHINXOPTS% %BUILDDIR%/devhelp
110 | if errorlevel 1 exit /b 1
111 | echo.
112 | echo.Build finished.
113 | goto end
114 | )
115 |
116 | if "%1" == "epub" (
117 | %SPHINXBUILD% -b epub %ALLSPHINXOPTS% %BUILDDIR%/epub
118 | if errorlevel 1 exit /b 1
119 | echo.
120 | echo.Build finished. The epub file is in %BUILDDIR%/epub.
121 | goto end
122 | )
123 |
124 | if "%1" == "latex" (
125 | %SPHINXBUILD% -b latex %ALLSPHINXOPTS% %BUILDDIR%/latex
126 | if errorlevel 1 exit /b 1
127 | echo.
128 | echo.Build finished; the LaTeX files are in %BUILDDIR%/latex.
129 | goto end
130 | )
131 |
132 | if "%1" == "text" (
133 | %SPHINXBUILD% -b text %ALLSPHINXOPTS% %BUILDDIR%/text
134 | if errorlevel 1 exit /b 1
135 | echo.
136 | echo.Build finished. The text files are in %BUILDDIR%/text.
137 | goto end
138 | )
139 |
140 | if "%1" == "man" (
141 | %SPHINXBUILD% -b man %ALLSPHINXOPTS% %BUILDDIR%/man
142 | if errorlevel 1 exit /b 1
143 | echo.
144 | echo.Build finished. The manual pages are in %BUILDDIR%/man.
145 | goto end
146 | )
147 |
148 | if "%1" == "texinfo" (
149 | %SPHINXBUILD% -b texinfo %ALLSPHINXOPTS% %BUILDDIR%/texinfo
150 | if errorlevel 1 exit /b 1
151 | echo.
152 | echo.Build finished. The Texinfo files are in %BUILDDIR%/texinfo.
153 | goto end
154 | )
155 |
156 | if "%1" == "gettext" (
157 | %SPHINXBUILD% -b gettext %I18NSPHINXOPTS% %BUILDDIR%/locale
158 | if errorlevel 1 exit /b 1
159 | echo.
160 | echo.Build finished. The message catalogs are in %BUILDDIR%/locale.
161 | goto end
162 | )
163 |
164 | if "%1" == "changes" (
165 | %SPHINXBUILD% -b changes %ALLSPHINXOPTS% %BUILDDIR%/changes
166 | if errorlevel 1 exit /b 1
167 | echo.
168 | echo.The overview file is in %BUILDDIR%/changes.
169 | goto end
170 | )
171 |
172 | if "%1" == "linkcheck" (
173 | %SPHINXBUILD% -b linkcheck %ALLSPHINXOPTS% %BUILDDIR%/linkcheck
174 | if errorlevel 1 exit /b 1
175 | echo.
176 | echo.Link check complete; look for any errors in the above output ^
177 | or in %BUILDDIR%/linkcheck/output.txt.
178 | goto end
179 | )
180 |
181 | if "%1" == "doctest" (
182 | %SPHINXBUILD% -b doctest %ALLSPHINXOPTS% %BUILDDIR%/doctest
183 | if errorlevel 1 exit /b 1
184 | echo.
185 | echo.Testing of doctests in the sources finished, look at the ^
186 | results in %BUILDDIR%/doctest/output.txt.
187 | goto end
188 | )
189 |
190 | :end
191 |
--------------------------------------------------------------------------------
/doc/source/conf.el:
--------------------------------------------------------------------------------
1 | (let* ((doc-source-path (file-name-directory load-file-name))
2 | (project-path (concat doc-source-path "../..")))
3 | (add-to-list 'load-path project-path))
4 |
5 | (require 'request)
6 |
7 | (provide 'deferred) ; Pretend like deferred.el is already imported
8 | (require 'request-deferred)
9 |
--------------------------------------------------------------------------------
/doc/source/conf.py:
--------------------------------------------------------------------------------
1 | # -*- coding: utf-8 -*-
2 | #
3 | # Request.el documentation build configuration file, created by
4 | # sphinx-quickstart on Tue Dec 18 20:00:05 2012.
5 | #
6 | # This file is execfile()d with the current directory set to its containing dir.
7 | #
8 | # Note that not all possible configuration values are present in this
9 | # autogenerated file.
10 | #
11 | # All configuration values have a default; values that are commented out
12 | # serve to show the default.
13 |
14 | import sys, os
15 |
16 | # If extensions (or modules to document with autodoc) are in another directory,
17 | # add these directories to sys.path here. If the directory is relative to the
18 | # documentation root, use os.path.abspath to make it absolute, like shown here.
19 | sys.path.insert(0, os.path.join(os.path.abspath('..'), 'eldomain'))
20 |
21 | # -- General configuration -----------------------------------------------------
22 |
23 | # If your documentation needs a minimal Sphinx version, state it here.
24 | #needs_sphinx = '1.0'
25 |
26 | # Add any Sphinx extension module names here, as strings. They can be extensions
27 | # coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
28 | extensions = [
29 | 'eldomain',
30 | ]
31 |
32 | # Add any paths that contain templates here, relative to this directory.
33 | templates_path = ['_templates']
34 |
35 | # The suffix of source filenames.
36 | source_suffix = '.rst'
37 |
38 | # The encoding of source files.
39 | #source_encoding = 'utf-8-sig'
40 |
41 | # The master toctree document.
42 | master_doc = 'index'
43 |
44 | # General information about the project.
45 | project = u'Request.el'
46 | copyright = u'2012, Takafumi Arakaki'
47 |
48 | # The version info for the project you're documenting, acts as replacement for
49 | # |version| and |release|, also used in various other places throughout the
50 | # built documents.
51 | #
52 | # The short X.Y version.
53 | version = '0.2.0'
54 | # The full version, including alpha/beta/rc tags.
55 | release = '0.2.0'
56 |
57 | # The language for content autogenerated by Sphinx. Refer to documentation
58 | # for a list of supported languages.
59 | #language = None
60 |
61 | # There are two options for replacing |today|: either, you set today to some
62 | # non-false value, then it is used:
63 | #today = ''
64 | # Else, today_fmt is used as the format for a strftime call.
65 | #today_fmt = '%B %d, %Y'
66 |
67 | # List of patterns, relative to source directory, that match files and
68 | # directories to ignore when looking for source files.
69 | exclude_patterns = []
70 |
71 | # The reST default role (used for this markup: `text`) to use for all documents.
72 | #default_role = None
73 |
74 | # If true, '()' will be appended to :func: etc. cross-reference text.
75 | #add_function_parentheses = True
76 |
77 | # If true, the current module name will be prepended to all description
78 | # unit titles (such as .. function::).
79 | #add_module_names = True
80 |
81 | # If true, sectionauthor and moduleauthor directives will be shown in the
82 | # output. They are ignored by default.
83 | #show_authors = False
84 |
85 | # The name of the Pygments (syntax highlighting) style to use.
86 | pygments_style = 'sphinx'
87 |
88 | # A list of ignored prefixes for module index sorting.
89 | #modindex_common_prefix = []
90 |
91 | highlight_language = 'cl'
92 |
93 | # -- Options for HTML output ---------------------------------------------------
94 |
95 | # The theme to use for HTML and HTML Help pages. See the documentation for
96 | # a list of builtin themes.
97 | html_theme = 'nature'
98 |
99 | # Theme options are theme-specific and customize the look and feel of a theme
100 | # further. For a list of options available for each theme, see the
101 | # documentation.
102 | html_theme_options = {
103 | 'nosidebar': True,
104 | }
105 |
106 | # Add any paths that contain custom themes here, relative to this directory.
107 | #html_theme_path = []
108 |
109 | # The name for this set of Sphinx documents. If None, it defaults to
110 | # " v documentation".
111 | #html_title = None
112 |
113 | # A shorter title for the navigation bar. Default is the same as html_title.
114 | #html_short_title = None
115 |
116 | # The name of an image file (relative to this directory) to place at the top
117 | # of the sidebar.
118 | #html_logo = None
119 |
120 | # The name of an image file (within the static path) to use as favicon of the
121 | # docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32
122 | # pixels large.
123 | #html_favicon = None
124 |
125 | # Add any paths that contain custom static files (such as style sheets) here,
126 | # relative to this directory. They are copied after the builtin static files,
127 | # so a file named "default.css" will overwrite the builtin "default.css".
128 | # html_static_path = ['_static']
129 |
130 | # If not '', a 'Last updated on:' timestamp is inserted at every page bottom,
131 | # using the given strftime format.
132 | #html_last_updated_fmt = '%b %d, %Y'
133 |
134 | # If true, SmartyPants will be used to convert quotes and dashes to
135 | # typographically correct entities.
136 | #html_use_smartypants = True
137 |
138 | # Custom sidebar templates, maps document names to template names.
139 | #html_sidebars = {}
140 |
141 | # Additional templates that should be rendered to pages, maps page names to
142 | # template names.
143 | #html_additional_pages = {}
144 |
145 | # If false, no module index is generated.
146 | #html_domain_indices = True
147 |
148 | # If false, no index is generated.
149 | #html_use_index = True
150 |
151 | # If true, the index is split into individual pages for each letter.
152 | #html_split_index = False
153 |
154 | # If true, links to the reST sources are added to the pages.
155 | #html_show_sourcelink = True
156 |
157 | # If true, "Created using Sphinx" is shown in the HTML footer. Default is True.
158 | #html_show_sphinx = True
159 |
160 | # If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.
161 | #html_show_copyright = True
162 |
163 | # If true, an OpenSearch description file will be output, and all pages will
164 | # contain a tag referring to it. The value of this option must be the
165 | # base URL from which the finished HTML is served.
166 | #html_use_opensearch = ''
167 |
168 | # This is the file name suffix for HTML files (e.g. ".xhtml").
169 | #html_file_suffix = None
170 |
171 | # Output file base name for HTML help builder.
172 | htmlhelp_basename = 'Requesteldoc'
173 |
174 |
175 | # -- Options for LaTeX output --------------------------------------------------
176 |
177 | latex_elements = {
178 | # The paper size ('letterpaper' or 'a4paper').
179 | #'papersize': 'letterpaper',
180 |
181 | # The font size ('10pt', '11pt' or '12pt').
182 | #'pointsize': '10pt',
183 |
184 | # Additional stuff for the LaTeX preamble.
185 | #'preamble': '',
186 | }
187 |
188 | # Grouping the document tree into LaTeX files. List of tuples
189 | # (source start file, target name, title, author, documentclass [howto/manual]).
190 | latex_documents = [
191 | ('index', 'Requestel.tex', u'Request.el Documentation',
192 | u'Takafumi Arakaki', 'manual'),
193 | ]
194 |
195 | # The name of an image file (relative to this directory) to place at the top of
196 | # the title page.
197 | #latex_logo = None
198 |
199 | # For "manual" documents, if this is true, then toplevel headings are parts,
200 | # not chapters.
201 | #latex_use_parts = False
202 |
203 | # If true, show page references after internal links.
204 | #latex_show_pagerefs = False
205 |
206 | # If true, show URL addresses after external links.
207 | #latex_show_urls = False
208 |
209 | # Documents to append as an appendix to all manuals.
210 | #latex_appendices = []
211 |
212 | # If false, no module index is generated.
213 | #latex_domain_indices = True
214 |
215 |
216 | # -- Options for manual page output --------------------------------------------
217 |
218 | # One entry per manual page. List of tuples
219 | # (source start file, name, description, authors, manual section).
220 | man_pages = [
221 | ('index', 'requestel', u'Request.el Documentation',
222 | [u'Takafumi Arakaki'], 1)
223 | ]
224 |
225 | # If true, show URL addresses after external links.
226 | #man_show_urls = False
227 |
228 |
229 | # -- Options for Texinfo output ------------------------------------------------
230 |
231 | # Grouping the document tree into Texinfo files. List of tuples
232 | # (source start file, target name, title, author,
233 | # dir menu entry, description, category)
234 | texinfo_documents = [
235 | ('index', 'Requestel', u'Request.el Documentation',
236 | u'Takafumi Arakaki', 'Requestel', 'One line description of project.',
237 | 'Miscellaneous'),
238 | ]
239 |
240 | # Documents to append as an appendix to all manuals.
241 | #texinfo_appendices = []
242 |
243 | # If false, no module index is generated.
244 | #texinfo_domain_indices = True
245 |
246 | # How to display URL addresses: 'footnote', 'no', or 'inline'.
247 | #texinfo_show_urls = 'footnote'
248 |
249 |
250 | # -- Options for EL domain -----------------------------------------------------
251 |
252 | elisp_packages = {
253 | 'request': 'request',
254 | }
255 |
--------------------------------------------------------------------------------
/doc/source/manual.rst:
--------------------------------------------------------------------------------
1 | ===================
2 | Request.el manual
3 | ===================
4 |
5 | .. note:: Entire manual is generated from docstrings. To
6 | quickly check what function/variable does, use :kbd:` f`
7 | or :kbd:` v`, (or :kbd:`C-h` instead of :kbd:`` if you
8 | don't rebind it).
9 |
10 | API
11 | ===
12 |
13 | .. el:package:: request
14 |
15 | .. el:function:: request
16 | .. el:function:: request-abort
17 |
18 | Response object
19 | ---------------
20 |
21 | .. el:function:: request-response-status-code
22 | .. el:function:: request-response-history
23 | .. el:function:: request-response-data
24 | .. el:function:: request-response-error-thrown
25 | .. el:function:: request-response-symbol-status
26 | .. el:function:: request-response-url
27 | .. el:function:: request-response-done-p
28 | .. el:function:: request-response-settings
29 |
30 | .. el:function:: request-response-header
31 |
32 |
33 | Cookie
34 | ------
35 |
36 | .. el:function:: request-cookie-string
37 | .. el:function:: request-cookie-alist
38 |
39 |
40 | Deferred
41 | --------
42 |
43 | deferred.el_ is a concise way to write callback chain.
44 | You can use :el:symbol:`require-deferred` to do requests
45 | with deferred.el_.
46 |
47 | .. _deferred.el: https://github.com/kiwanami/emacs-deferred
48 |
49 | .. el:function:: request-deferred
50 |
51 |
52 | Configuration
53 | =============
54 |
55 | Configuration variables are for users.
56 | Libraries using request.el must not modify these variables.
57 |
58 | .. el:variable:: request-storage-directory
59 | .. el:variable:: request-curl
60 | .. el:variable:: request-backend
61 | .. el:variable:: request-timeout
62 | .. el:variable:: request-log-level
63 | .. el:variable:: request-message-level
64 |
--------------------------------------------------------------------------------
/doc/source/tail.rest:
--------------------------------------------------------------------------------
1 |
2 |
3 | .. ^- put some space after README.rst
4 |
5 | Indices and tables
6 | ==================
7 |
8 | .. toctree::
9 | :maxdepth: 2
10 |
11 | manual
12 |
13 | * :ref:`genindex`
14 | * :ref:`search`
15 |
--------------------------------------------------------------------------------
/request-deferred.el:
--------------------------------------------------------------------------------
1 | ;;; request-deferred.el --- Wrap request.el by deferred
2 |
3 | ;; Copyright (C) 2012 Takafumi Arakaki
4 |
5 | ;; Author: Takafumi Arakaki
6 | ;; Package-Requires: ((deferred "0.3.1") (request "0.2.0"))
7 | ;; Version: 0.2.0
8 |
9 | ;; This file is NOT part of GNU Emacs.
10 |
11 | ;; request-deferred.el 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 | ;; request-deferred.el 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 request-deferred.el.
23 | ;; If not, see .
24 |
25 | ;;; Commentary:
26 |
27 | ;;
28 |
29 | ;;; Code:
30 |
31 | (require 'request)
32 | (require 'deferred)
33 |
34 | (defun request-deferred (url &rest args)
35 | "Send a request and return deferred object associated with it.
36 |
37 | Following deferred callback takes a response object regardless of
38 | the response result. To make sure no error occurs during the
39 | request, check `request-response-error-thrown'.
40 |
41 | Arguments are the same as `request', but COMPLETE callback cannot
42 | be used as it is used for starting deferred callback chain.
43 |
44 | Example::
45 |
46 | (require 'request-deferred)
47 |
48 | (deferred:$
49 | (request-deferred \"http://httpbin.org/get\" :parser 'json-read)
50 | (deferred:nextc it
51 | (lambda (response)
52 | (message \"Got: %S\" (request-response-data response)))))
53 | "
54 |
55 | (let* ((d (deferred:new #'identity))
56 | (callback-post (apply-partially
57 | (lambda (d &rest args)
58 | (deferred:callback-post
59 | d (plist-get args :response)))
60 | d)))
61 | ;; As `deferred:errorback-post' requires an error object to be
62 | ;; posted, use `deferred:callback-post' for success and error
63 | ;; cases.
64 | (setq args (plist-put args :complete callback-post))
65 | (apply #'request url args)
66 | d))
67 |
68 | (provide 'request-deferred)
69 |
70 | ;;; request-deferred.el ends here
71 |
--------------------------------------------------------------------------------
/request.el:
--------------------------------------------------------------------------------
1 | ;;; request.el --- Compatible layer for URL request in Emacs
2 |
3 | ;; Copyright (C) 2012 Takafumi Arakaki
4 | ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012
5 | ;; Free Software Foundation, Inc.
6 |
7 | ;; Author: Takafumi Arakaki
8 | ;; Package-Requires: ((cl-lib "0.5"))
9 | ;; Version: 0.2.0
10 |
11 | ;; This file is NOT part of GNU Emacs.
12 |
13 | ;; request.el is free software: you can redistribute it and/or modify
14 | ;; it under the terms of the GNU General Public License as published by
15 | ;; the Free Software Foundation, either version 3 of the License, or
16 | ;; (at your option) any later version.
17 |
18 | ;; request.el is distributed in the hope that it will be useful,
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 | ;; GNU General Public License for more details.
22 |
23 | ;; You should have received a copy of the GNU General Public License
24 | ;; along with request.el.
25 | ;; If not, see .
26 |
27 | ;;; Commentary:
28 |
29 | ;; Request.el is a HTTP request library with multiple backends. It
30 | ;; supports url.el which is shipped with Emacs and curl command line
31 | ;; program. User can use curl when s/he has it, as curl is more reliable
32 | ;; than url.el. Library author can use request.el to avoid imposing
33 | ;; external dependencies such as curl to users while giving richer
34 | ;; experience for users who have curl.
35 |
36 | ;; Following functions are adapted from GNU Emacs source code.
37 | ;; Free Software Foundation holds the copyright of them.
38 | ;; * `request--process-live-p'
39 | ;; * `request--url-default-expander'
40 |
41 | ;;; Code:
42 |
43 | (eval-when-compile
44 | (require 'cl) ; for obsolete `lexical-let'
45 | (require 'cl-lib)
46 | (defvar url-http-method)
47 | (defvar url-http-response-status))
48 | (require 'url)
49 | (require 'mail-utils)
50 |
51 | (defgroup request nil
52 | "Compatible layer for URL request in Emacs."
53 | :group 'comm
54 | :prefix "request-")
55 |
56 | (defconst request-version "0.2.0")
57 |
58 |
59 | ;;; Customize variables
60 |
61 | (defcustom request-storage-directory
62 | (concat (file-name-as-directory user-emacs-directory) "request")
63 | "Directory to store data related to request.el."
64 | :group 'request)
65 |
66 | (defcustom request-curl "curl"
67 | "Executable for curl command."
68 | :group 'request)
69 |
70 | (defcustom request-backend (if (executable-find request-curl)
71 | 'curl
72 | 'url-retrieve)
73 | "Backend to be used for HTTP request.
74 | Automatically set to `curl' if curl command is found."
75 | :group 'request)
76 |
77 | (defcustom request-timeout nil
78 | "Default request timeout in second.
79 | `nil' means no timeout."
80 | :group 'request)
81 |
82 | (defcustom request-log-level -1
83 | "Logging level for request.
84 | One of `error'/`warn'/`info'/`verbose'/`debug'.
85 | -1 means no logging."
86 | :group 'request)
87 |
88 | (defcustom request-message-level 'warn
89 | "Logging level for request.
90 | See `request-log-level'."
91 | :group 'request)
92 |
93 |
94 | ;;; Utilities
95 |
96 | (defun request--safe-apply (function &rest arguments)
97 | (condition-case err
98 | (apply #'apply function arguments)
99 | ((debug error))))
100 |
101 | (defun request--safe-call (function &rest arguments)
102 | (request--safe-apply function arguments))
103 |
104 | ;; (defun request--url-no-cache (url)
105 | ;; "Imitate `cache=false' of `jQuery.ajax'.
106 | ;; See: http://api.jquery.com/jQuery.ajax/"
107 | ;; ;; FIXME: parse URL before adding ?_=TIME.
108 | ;; (concat url (format-time-string "?_=%s")))
109 |
110 | (defmacro request--document-function (function docstring)
111 | "Document FUNCTION with DOCSTRING. Use this for defstruct accessor etc."
112 | (declare (indent defun)
113 | (doc-string 2))
114 | `(put ',function 'function-documentation ,docstring))
115 |
116 | (defun request--process-live-p (process)
117 | "Copied from `process-live-p' for backward compatibility (Emacs < 24).
118 | Adapted from lisp/subr.el.
119 | FSF holds the copyright of this function:
120 | Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012
121 | Free Software Foundation, Inc."
122 | (memq (process-status process) '(run open listen connect stop)))
123 |
124 |
125 | ;;; Logging
126 |
127 | (defconst request--log-level-def
128 | '(;; debugging
129 | (blather . 60) (trace . 50) (debug . 40)
130 | ;; information
131 | (verbose . 30) (info . 20)
132 | ;; errors
133 | (warn . 10) (error . 0))
134 | "Named logging levels.")
135 |
136 | (defun request--log-level-as-int (level)
137 | (if (integerp level)
138 | level
139 | (or (cdr (assq level request--log-level-def))
140 | 0)))
141 |
142 | (defvar request-log-buffer-name " *request-log*")
143 |
144 | (defun request--log-buffer ()
145 | (get-buffer-create request-log-buffer-name))
146 |
147 | (defmacro request-log (level fmt &rest args)
148 | (declare (indent 1))
149 | `(let ((level (request--log-level-as-int ,level))
150 | (log-level (request--log-level-as-int request-log-level))
151 | (msg-level (request--log-level-as-int request-message-level)))
152 | (when (<= level (max log-level msg-level))
153 | (let ((msg (format "[%s] %s" ,level
154 | (condition-case err
155 | (format ,fmt ,@args)
156 | (error (format "
157 | !!! Logging error while executing:
158 | %S
159 | !!! Error:
160 | %S"
161 | ',args err))))))
162 | (when (<= level log-level)
163 | (with-current-buffer (request--log-buffer)
164 | (setq buffer-read-only t)
165 | (let ((inhibit-read-only t))
166 | (goto-char (point-max))
167 | (insert msg "\n"))))
168 | (when (<= level msg-level)
169 | (message "REQUEST %s" msg))))))
170 |
171 |
172 | ;;; HTTP specific utilities
173 |
174 | (defconst request--url-unreserved-chars
175 | '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
176 | ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
177 | ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
178 | ?- ?_ ?. ?~)
179 | "`url-unreserved-chars' copied from Emacs 24.3 release candidate.
180 | This is used for making `request--urlencode-alist' RFC 3986 compliant
181 | for older Emacs versions.")
182 |
183 | (defun request--urlencode-alist (alist)
184 | ;; FIXME: make monkey patching `url-unreserved-chars' optional
185 | (let ((url-unreserved-chars request--url-unreserved-chars))
186 | (cl-loop for sep = "" then "&"
187 | for (k . v) in alist
188 | concat sep
189 | concat (url-hexify-string (format "%s" k))
190 | concat "="
191 | concat (url-hexify-string v))))
192 |
193 |
194 | ;;; Header parser
195 |
196 | (defun request--parse-response-at-point ()
197 | "Parse the first header line such as \"HTTP/1.1 200 OK\"."
198 | (re-search-forward "\\=[ \t\n]*HTTP/\\([0-9\\.]+\\) +\\([0-9]+\\)")
199 | (list :version (match-string 1)
200 | :code (string-to-number (match-string 2))))
201 |
202 | (defun request--goto-next-body ()
203 | (re-search-forward "^\r\n"))
204 |
205 |
206 | ;;; Response object
207 |
208 | (cl-defstruct request-response
209 | "A structure holding all relevant information of a request."
210 | status-code history data error-thrown symbol-status url
211 | done-p settings
212 | ;; internal variables
213 | -buffer -raw-header -timer -backend -tempfiles)
214 |
215 | (defmacro request--document-response (function docstring)
216 | (declare (indent defun)
217 | (doc-string 2))
218 | `(request--document-function ,function ,(concat docstring "
219 |
220 | .. This is an accessor for `request-response' object.
221 |
222 | \(fn RESPONSE)")))
223 |
224 | (request--document-response request-response-status-code
225 | "Integer HTTP response code (e.g., 200).")
226 |
227 | (request--document-response request-response-history
228 | "Redirection history (a list of response object).
229 | The first element is the oldest redirection.
230 |
231 | You can use restricted portion of functions for the response
232 | objects in the history slot. It also depends on backend. Here
233 | is the table showing what functions you can use for the response
234 | objects in the history slot.
235 |
236 | ==================================== ============== ==============
237 | Slots Backends
238 | ------------------------------------ -----------------------------
239 | \\ curl url-retrieve
240 | ==================================== ============== ==============
241 | request-response-url yes yes
242 | request-response-header yes no
243 | other functions no no
244 | ==================================== ============== ==============
245 | ")
246 |
247 | (request--document-response request-response-data
248 | "Response parsed by the given parser.")
249 |
250 | (request--document-response request-response-error-thrown
251 | "Error thrown during request.
252 | It takes the form of ``(ERROR-SYMBOL . DATA)``, which can be
253 | re-raised (`signal'ed) by ``(signal ERROR-SYMBOL DATA)``.")
254 |
255 | (request--document-response request-response-symbol-status
256 | "A symbol representing the status of request (not HTTP response code).
257 | One of success/error/timeout/abort/parse-error.")
258 |
259 | (request--document-response request-response-url
260 | "Final URL location of response.")
261 |
262 | (request--document-response request-response-done-p
263 | "Return t when the request is finished or aborted.")
264 |
265 | (request--document-response request-response-settings
266 | "Keyword arguments passed to `request' function.
267 | Some arguments such as HEADERS is changed to the one actually
268 | passed to the backend. Also, it has additional keywords such
269 | as URL which is the requested URL.")
270 |
271 | (defun request-response-header (response field-name)
272 | "Fetch the values of RESPONSE header field named FIELD-NAME.
273 |
274 | It returns comma separated values when the header has multiple
275 | field with the same name, as :RFC:`2616` specifies.
276 |
277 | Examples::
278 |
279 | (request-response-header response
280 | \"content-type\") ; => \"text/html; charset=utf-8\"
281 | (request-response-header response
282 | \"unknown-field\") ; => nil
283 | "
284 | (let ((raw-header (request-response--raw-header response)))
285 | (when raw-header
286 | (with-temp-buffer
287 | (erase-buffer)
288 | (insert raw-header)
289 | ;; ALL=t to fetch all fields with the same name to get comma
290 | ;; separated value [#rfc2616-sec4]_.
291 | (mail-fetch-field field-name nil t)))))
292 | ;; .. [#rfc2616-sec4] RFC2616 says this is the right thing to do
293 | ;; (see http://tools.ietf.org/html/rfc2616.html#section-4.2).
294 | ;; Python's requests module does this too.
295 |
296 |
297 | ;;; Backend dispatcher
298 |
299 | (defconst request--backend-alist
300 | '((url-retrieve
301 | . ((request . request--url-retrieve)
302 | (request-sync . request--url-retrieve-sync)
303 | (terminate-process . delete-process)
304 | (get-cookies . request--url-retrieve-get-cookies)))
305 | (curl
306 | . ((request . request--curl)
307 | (request-sync . request--curl-sync)
308 | (terminate-process . interrupt-process)
309 | (get-cookies . request--curl-get-cookies))))
310 | "Map backend and method name to actual method (symbol).
311 |
312 | It's alist of alist, of the following form::
313 |
314 | ((BACKEND . ((METHOD . FUNCTION) ...)) ...)
315 |
316 | It would be nicer if I can use EIEIO. But as CEDET is included
317 | in Emacs by 23.2, using EIEIO means abandon older Emacs versions.
318 | It is probably necessary if I need to support more backends. But
319 | let's stick to manual dispatch for now.")
320 | ;; See: (view-emacs-news "23.2")
321 |
322 | (defun request--choose-backend (method)
323 | "Return `fucall'able object for METHOD of current `request-backend'."
324 | (assoc-default
325 | method
326 | (or (assoc-default request-backend request--backend-alist)
327 | (error "%S is not valid `request-backend'." request-backend))))
328 |
329 |
330 | ;;; Cookie
331 |
332 | (defun request-cookie-string (host &optional localpart secure)
333 | "Return cookie string (like `document.cookie').
334 |
335 | Example::
336 |
337 | (request-cookie-string \"127.0.0.1\" \"/\") ; => \"key=value; key2=value2\"
338 | "
339 | (mapconcat (lambda (nv) (concat (car nv) "=" (cdr nv)))
340 | (request-cookie-alist host localpart secure)
341 | "; "))
342 |
343 | (defun request-cookie-alist (host &optional localpart secure)
344 | "Return cookies as an alist.
345 |
346 | Example::
347 |
348 | (request-cookie-alist \"127.0.0.1\" \"/\") ; => ((\"key\" . \"value\") ...)
349 | "
350 | (funcall (request--choose-backend 'get-cookies) host localpart secure))
351 |
352 |
353 | ;;; Main
354 |
355 | (cl-defun request-default-error-callback (url &key symbol-status
356 | &allow-other-keys)
357 | (request-log 'error
358 | "Error (%s) while connecting to %s." symbol-status url))
359 |
360 | (cl-defun request (url &rest settings
361 | &key
362 | (type "GET")
363 | (params nil)
364 | (data nil)
365 | (files nil)
366 | (parser nil)
367 | (headers nil)
368 | (success nil)
369 | (error nil)
370 | (complete nil)
371 | (timeout request-timeout)
372 | (status-code nil)
373 | (sync nil)
374 | (response (make-request-response)))
375 | "Send request to URL.
376 |
377 | Request.el has a single entry point. It is `request'.
378 |
379 | ==================== ========================================================
380 | Keyword argument Explanation
381 | ==================== ========================================================
382 | TYPE (string) type of request to make: POST/GET/PUT/DELETE
383 | PARAMS (alist) set \"?key=val\" part in URL
384 | DATA (string/alist) data to be sent to the server
385 | FILES (alist) files to be sent to the server (see below)
386 | PARSER (symbol) a function that reads current buffer and return data
387 | HEADERS (alist) additional headers to send with the request
388 | SUCCESS (function) called on success
389 | ERROR (function) called on error
390 | COMPLETE (function) called on both success and error
391 | TIMEOUT (number) timeout in second
392 | STATUS-CODE (alist) map status code (int) to callback
393 | SYNC (bool) If `t', wait until request is done. Default is `nil'.
394 | ==================== ========================================================
395 |
396 |
397 | * Callback functions
398 |
399 | Callback functions STATUS, ERROR, COMPLETE and `cdr's in element of
400 | the alist STATUS-CODE take same keyword arguments listed below. For
401 | forward compatibility, these functions must ignore unused keyword
402 | arguments (i.e., it's better to use `&allow-other-keys' [#]_).::
403 |
404 | (CALLBACK ; SUCCESS/ERROR/COMPLETE/STATUS-CODE
405 | :data data ; whatever PARSER function returns, or nil
406 | :error-thrown error-thrown ; (ERROR-SYMBOL . DATA), or nil
407 | :symbol-status symbol-status ; success/error/timeout/abort/parse-error
408 | :response response ; request-response object
409 | ...)
410 |
411 | .. [#] `&allow-other-keys' is a special \"markers\" available in macros
412 | in the CL library for function definition such as `cl-defun' and
413 | `cl-function'. Without this marker, you need to specify all arguments
414 | to be passed. This becomes problem when request.el adds new arguments
415 | when calling callback functions. If you use `&allow-other-keys'
416 | (or manually ignore other arguments), your code is free from this
417 | problem. See info node `(cl) Argument Lists' for more information.
418 |
419 | Arguments data, error-thrown, symbol-status can be accessed by
420 | `request-response-data', `request-response-error-thrown',
421 | `request-response-symbol-status' accessors, i.e.::
422 |
423 | (request-response-data RESPONSE) ; same as data
424 |
425 | Response object holds other information which can be accessed by
426 | the following accessors:
427 | `request-response-status-code',
428 | `request-response-url' and
429 | `request-response-settings'
430 |
431 | * STATUS-CODE callback
432 |
433 | STATUS-CODE is an alist of the following format::
434 |
435 | ((N-1 . CALLBACK-1)
436 | (N-2 . CALLBACK-2)
437 | ...)
438 |
439 | Here, N-1, N-2,... are integer status codes such as 200.
440 |
441 |
442 | * FILES
443 |
444 | FILES is an alist of the following format::
445 |
446 | ((NAME-1 . FILE-1)
447 | (NAME-2 . FILE-2)
448 | ...)
449 |
450 | where FILE-N is a list of the form::
451 |
452 | (FILENAME &key PATH BUFFER STRING MIME-TYPE)
453 |
454 | FILE-N can also be a string (path to the file) or a buffer object.
455 | In that case, FILENAME is set to the file name or buffer name.
456 |
457 | Example FILES argument::
458 |
459 | `((\"passwd\" . \"/etc/passwd\") ; filename = passwd
460 | (\"scratch\" . ,(get-buffer \"*scratch*\")) ; filename = *scratch*
461 | (\"passwd2\" . (\"password.txt\" :file \"/etc/passwd\"))
462 | (\"scratch2\" . (\"scratch.txt\" :buffer ,(get-buffer \"*scratch*\")))
463 | (\"data\" . (\"data.csv\" :data \"1,2,3\\n4,5,6\\n\")))
464 |
465 | .. note:: FILES is implemented only for curl backend for now.
466 | As furl.el_ supports multipart POST, it should be possible to
467 | support FILES in pure elisp by making furl.el_ another backend.
468 | Contributions are welcome.
469 |
470 | .. _furl.el: http://code.google.com/p/furl-el/
471 |
472 |
473 | * PARSER function
474 |
475 | PARSER function takes no argument and it is executed in the
476 | buffer with HTTP response body. The current position in the HTTP
477 | response buffer is at the beginning of the buffer. As the HTTP
478 | header is stripped off, the cursor is actually at the beginning
479 | of the response body. So, for example, you can pass `json-read'
480 | to parse JSON object in the buffer. To fetch whole response as a
481 | string, pass `buffer-string'.
482 |
483 | When using `json-read', it is useful to know that the returned
484 | type can be modified by `json-object-type', `json-array-type',
485 | `json-key-type', `json-false' and `json-null'. See docstring of
486 | each function for what it does. For example, to convert JSON
487 | objects to plist instead of alist, wrap `json-read' by `lambda'
488 | like this.::
489 |
490 | (request
491 | \"http://...\"
492 | :parser (lambda ()
493 | (let ((json-object-type 'plist))
494 | (json-read)))
495 | ...)
496 |
497 | This is analogous to the `dataType' argument of jQuery.ajax_.
498 | Only this function can access to the process buffer, which
499 | is killed immediately after the execution of this function.
500 |
501 | * SYNC
502 |
503 | Synchronous request is functional, but *please* don't use it
504 | other than testing or debugging. Emacs users have better things
505 | to do rather than waiting for HTTP request. If you want a better
506 | way to write callback chains, use `request-deferred'.
507 |
508 | If you can't avoid using it (e.g., you are inside of some hook
509 | which must return some value), make sure to set TIMEOUT to
510 | relatively small value.
511 |
512 | Due to limitation of `url-retrieve-synchronously', response slots
513 | `request-response-error-thrown', `request-response-history' and
514 | `request-response-url' are unknown (always `nil') when using
515 | synchronous request with `url-retrieve' backend.
516 |
517 | * Note
518 |
519 | API of `request' is somewhat mixture of jQuery.ajax_ (Javascript)
520 | and requests.request_ (Python).
521 |
522 | .. _jQuery.ajax: http://api.jquery.com/jQuery.ajax/
523 | .. _requests.request: http://docs.python-requests.org
524 | "
525 | (request-log 'debug "REQUEST")
526 | ;; FIXME: support CACHE argument (if possible)
527 | ;; (unless cache
528 | ;; (setq url (request--url-no-cache url)))
529 | (unless error
530 | (setq error (apply-partially #'request-default-error-callback url))
531 | (setq settings (plist-put settings :error error)))
532 | (unless (or (stringp data)
533 | (null data)
534 | (assoc-string "Content-Type" headers t))
535 | (setq data (request--urlencode-alist data))
536 | (setq settings (plist-put settings :data data)))
537 | (when params
538 | (cl-assert (listp params) nil "PARAMS must be an alist. Given: %S" params)
539 | (setq url (concat url (if (string-match-p "\\?" url) "&" "?")
540 | (request--urlencode-alist params))))
541 | (setq settings (plist-put settings :url url))
542 | (setq settings (plist-put settings :response response))
543 | (setf (request-response-settings response) settings)
544 | (setf (request-response-url response) url)
545 | (setf (request-response--backend response) request-backend)
546 | ;; Call `request--url-retrieve'(`-sync') or `request--curl'(`-sync').
547 | (apply (if sync
548 | (request--choose-backend 'request-sync)
549 | (request--choose-backend 'request))
550 | url settings)
551 | (when timeout
552 | (request-log 'debug "Start timer: timeout=%s sec" timeout)
553 | (setf (request-response--timer response)
554 | (run-at-time timeout nil
555 | #'request-response--timeout-callback response)))
556 | response)
557 |
558 | (defun request--clean-header (response)
559 | "Strip off carriage returns in the header of REQUEST."
560 | (request-log 'debug "-CLEAN-HEADER")
561 | (let ((buffer (request-response--buffer response))
562 | (backend (request-response--backend response))
563 | sep-regexp)
564 | (if (eq backend 'url-retrieve)
565 | ;; FIXME: make this workaround optional.
566 | ;; But it looks like sometimes `url-http-clean-headers'
567 | ;; fails to cleanup. So, let's be bit permissive here...
568 | (setq sep-regexp "^\r?$")
569 | (setq sep-regexp "^\r$"))
570 | (when (buffer-live-p buffer)
571 | (with-current-buffer buffer
572 | (request-log 'trace
573 | "(buffer-string) at %S =\n%s" buffer (buffer-string))
574 | (goto-char (point-min))
575 | (when (and (re-search-forward sep-regexp nil t)
576 | ;; Are \r characters stripped off already?:
577 | (not (equal (match-string 0) "")))
578 | (while (re-search-backward "\r$" (point-min) t)
579 | (replace-match "")))))))
580 |
581 | (defun request--cut-header (response)
582 | "Cut the first header part in the buffer of RESPONSE and move it to
583 | raw-header slot."
584 | (request-log 'debug "-CUT-HEADER")
585 | (let ((buffer (request-response--buffer response)))
586 | (when (buffer-live-p buffer)
587 | (with-current-buffer buffer
588 | (goto-char (point-min))
589 | (when (re-search-forward "^$" nil t)
590 | (setf (request-response--raw-header response)
591 | (buffer-substring (point-min) (point)))
592 | (delete-region (point-min) (min (1+ (point)) (point-max))))))))
593 |
594 | (defun request--parse-data (response parser)
595 | "Run PARSER in current buffer if ERROR-THROWN is nil,
596 | then kill the current buffer."
597 | (request-log 'debug "-PARSE-DATA")
598 | (let ((buffer (request-response--buffer response)))
599 | (request-log 'debug "parser = %s" parser)
600 | (when (and (buffer-live-p buffer) parser)
601 | (with-current-buffer buffer
602 | (request-log 'trace
603 | "(buffer-string) at %S =\n%s" buffer (buffer-string))
604 | (goto-char (point-min))
605 | (setf (request-response-data response) (funcall parser))))))
606 |
607 | (cl-defun request--callback (buffer &key parser success error complete
608 | timeout status-code response
609 | &allow-other-keys)
610 | (request-log 'debug "REQUEST--CALLBACK")
611 | (request-log 'debug "(buffer-string) =\n%s"
612 | (when (buffer-live-p buffer)
613 | (with-current-buffer buffer (buffer-string))))
614 |
615 | ;; Sometimes BUFFER given as the argument is different from the
616 | ;; buffer already set in RESPONSE. That's why it is reset here.
617 | ;; FIXME: Refactor how BUFFER is passed around.
618 | (setf (request-response--buffer response) buffer)
619 | (request-response--cancel-timer response)
620 | (cl-symbol-macrolet
621 | ((error-thrown (request-response-error-thrown response))
622 | (symbol-status (request-response-symbol-status response))
623 | (data (request-response-data response))
624 | (done-p (request-response-done-p response)))
625 |
626 | ;; Parse response header
627 | (request--clean-header response)
628 | (request--cut-header response)
629 | ;; Note: Try to do this even `error-thrown' is set. For example,
630 | ;; timeout error can occur while downloading response body and
631 | ;; header is there in that case.
632 |
633 | ;; Parse response body
634 | (request-log 'debug "error-thrown = %S" error-thrown)
635 | (unless error-thrown
636 | (condition-case err
637 | (request--parse-data response parser)
638 | (error
639 | (setq symbol-status 'parse-error)
640 | (setq error-thrown err)
641 | (request-log 'error "Error from parser %S: %S" parser err))))
642 | (kill-buffer buffer)
643 | (request-log 'debug "data = %s" data)
644 |
645 | ;; Determine `symbol-status'
646 | (unless symbol-status
647 | (setq symbol-status (if error-thrown 'error 'success)))
648 | (request-log 'debug "symbol-status = %s" symbol-status)
649 |
650 | ;; Call callbacks
651 | (let ((args (list :data data
652 | :symbol-status symbol-status
653 | :error-thrown error-thrown
654 | :response response)))
655 | (let* ((success-p (eq symbol-status 'success))
656 | (cb (if success-p success error))
657 | (name (if success-p "success" "error")))
658 | (when cb
659 | (request-log 'debug "Executing %s callback." name)
660 | (request--safe-apply cb args)))
661 |
662 | (let ((cb (cdr (assq (request-response-status-code response)
663 | status-code))))
664 | (when cb
665 | (request-log 'debug "Executing status-code callback.")
666 | (request--safe-apply cb args)))
667 |
668 | (when complete
669 | (request-log 'debug "Executing complete callback.")
670 | (request--safe-apply complete args)))
671 |
672 | (setq done-p t)
673 |
674 | ;; Remove temporary files
675 | ;; FIXME: Make tempfile cleanup more reliable. It is possible
676 | ;; callback is never called.
677 | (request--safe-delete-files (request-response--tempfiles response))))
678 |
679 | (cl-defun request-response--timeout-callback (response)
680 | (request-log 'debug "-TIMEOUT-CALLBACK")
681 | (setf (request-response-symbol-status response) 'timeout)
682 | (setf (request-response-error-thrown response) '(error . ("Timeout")))
683 | (let* ((buffer (request-response--buffer response))
684 | (proc (and (buffer-live-p buffer) (get-buffer-process buffer))))
685 | (when proc
686 | ;; This will call `request--callback':
687 | (funcall (request--choose-backend 'terminate-process) proc))
688 |
689 | (cl-symbol-macrolet ((done-p (request-response-done-p response)))
690 | (unless done-p
691 | ;; This code should never be executed. However, it occurs
692 | ;; sometimes with `url-retrieve' backend.
693 | ;; FIXME: In Emacs 24.3.50 or later, this is always executed in
694 | ;; request-get-timeout test. Find out if it is fine.
695 | (request-log 'error "Callback is not called when stopping process! \
696 | Explicitly calling from timer.")
697 | (when (buffer-live-p buffer)
698 | (cl-destructuring-bind (&key code &allow-other-keys)
699 | (with-current-buffer buffer
700 | (goto-char (point-min))
701 | (ignore-errors (request--parse-response-at-point)))
702 | (setf (request-response-status-code response) code)))
703 | (apply #'request--callback
704 | buffer
705 | (request-response-settings response))
706 | (setq done-p t)))))
707 |
708 | (defun request-response--cancel-timer (response)
709 | (request-log 'debug "REQUEST-RESPONSE--CANCEL-TIMER")
710 | (cl-symbol-macrolet ((timer (request-response--timer response)))
711 | (when timer
712 | (cancel-timer timer)
713 | (setq timer nil))))
714 |
715 |
716 | (defun request-abort (response)
717 | "Abort request for RESPONSE (the object returned by `request').
718 | Note that this function invoke ERROR and COMPLETE callbacks.
719 | Callbacks may not be called immediately but called later when
720 | associated process is exited."
721 | (cl-symbol-macrolet ((buffer (request-response--buffer response))
722 | (symbol-status (request-response-symbol-status response))
723 | (done-p (request-response-done-p response)))
724 | (let ((process (get-buffer-process buffer)))
725 | (unless symbol-status ; should I use done-p here?
726 | (setq symbol-status 'abort)
727 | (setq done-p t)
728 | (when (and
729 | (processp process) ; process can be nil when buffer is killed
730 | (request--process-live-p process))
731 | (funcall (request--choose-backend 'terminate-process) process))))))
732 |
733 |
734 | ;;; Backend: `url-retrieve'
735 |
736 | (cl-defun request--url-retrieve-preprocess-settings
737 | (&rest settings &key type data files headers &allow-other-keys)
738 | (when files
739 | (error "`url-retrieve' backend does not support FILES."))
740 | (when (and (equal type "POST")
741 | data
742 | (not (assoc-string "Content-Type" headers t)))
743 | (push '("Content-Type" . "application/x-www-form-urlencoded") headers)
744 | (setq settings (plist-put settings :headers headers)))
745 | settings)
746 |
747 | (cl-defun request--url-retrieve (url &rest settings
748 | &key type data timeout response
749 | &allow-other-keys
750 | &aux headers)
751 | (setq settings (apply #'request--url-retrieve-preprocess-settings settings))
752 | (setq headers (plist-get settings :headers))
753 | (let* ((url-request-extra-headers headers)
754 | (url-request-method type)
755 | (url-request-data data)
756 | (buffer (url-retrieve url #'request--url-retrieve-callback
757 | (nconc (list :response response) settings)))
758 | (proc (get-buffer-process buffer)))
759 | (setf (request-response--buffer response) buffer)
760 | (process-put proc :request-response response)
761 | (request-log 'debug "Start querying: %s" url)
762 | (set-process-query-on-exit-flag proc nil)))
763 |
764 | (cl-defun request--url-retrieve-callback (status &rest settings
765 | &key response url
766 | &allow-other-keys)
767 | (declare (special url-http-method
768 | url-http-response-status))
769 | (request-log 'debug "-URL-RETRIEVE-CALLBACK")
770 | (request-log 'debug "status = %S" status)
771 | (request-log 'debug "url-http-method = %s" url-http-method)
772 | (request-log 'debug "url-http-response-status = %s" url-http-response-status)
773 |
774 | (setf (request-response-status-code response) url-http-response-status)
775 | (let ((redirect (plist-get status :redirect)))
776 | (when redirect
777 | (setf (request-response-url response) redirect)))
778 | ;; Construct history slot
779 | (cl-loop for v in
780 | (cl-loop with first = t
781 | with l = nil
782 | for (k v) on status by 'cddr
783 | when (eq k :redirect)
784 | if first
785 | do (setq first nil)
786 | else
787 | do (push v l)
788 | finally do (cons url l))
789 | do (let ((r (make-request-response :-backend 'url-retrieve)))
790 | (setf (request-response-url r) v)
791 | (push r (request-response-history response))))
792 |
793 | (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response))
794 | (status-error (plist-get status :error)))
795 | (when (and error-thrown status-error)
796 | (request-log 'warn
797 | "Error %S thrown already but got another error %S from \
798 | `url-retrieve'. Ignoring it..." error-thrown status-error))
799 | (unless error-thrown
800 | (setq error-thrown status-error)))
801 |
802 | (apply #'request--callback (current-buffer) settings))
803 |
804 | (cl-defun request--url-retrieve-sync (url &rest settings
805 | &key type data timeout response
806 | &allow-other-keys
807 | &aux headers)
808 | (setq settings (apply #'request--url-retrieve-preprocess-settings settings))
809 | (setq headers (plist-get settings :headers))
810 | (let* ((url-request-extra-headers headers)
811 | (url-request-method type)
812 | (url-request-data data)
813 | (buffer (if timeout
814 | (with-timeout
815 | (timeout
816 | (setf (request-response-symbol-status response)
817 | 'timeout)
818 | (setf (request-response-done-p response) t)
819 | nil)
820 | (url-retrieve-synchronously url))
821 | (url-retrieve-synchronously url))))
822 | (setf (request-response--buffer response) buffer)
823 | ;; It seems there is no way to get redirects and URL here...
824 | (when buffer
825 | ;; Fetch HTTP response code
826 | (with-current-buffer buffer
827 | (goto-char (point-min))
828 | (cl-destructuring-bind (&key version code)
829 | (request--parse-response-at-point)
830 | (setf (request-response-status-code response) code)))
831 | ;; Parse response body, etc.
832 | (apply #'request--callback buffer settings)))
833 | response)
834 |
835 | (defun request--url-retrieve-get-cookies (host localpart secure)
836 | (mapcar
837 | (lambda (c) (cons (url-cookie-name c) (url-cookie-value c)))
838 | (url-cookie-retrieve host localpart secure)))
839 |
840 |
841 | ;;; Backend: curl
842 |
843 | (defvar request--curl-cookie-jar nil
844 | "Override what the function `request--curl-cookie-jar' returns.
845 | Currently it is used only for testing.")
846 |
847 | (defun request--curl-cookie-jar ()
848 | "Cookie storage for curl backend."
849 | (or request--curl-cookie-jar
850 | (expand-file-name "curl-cookie-jar" request-storage-directory)))
851 |
852 | (defconst request--curl-write-out-template
853 | (if (eq system-type 'windows-nt)
854 | "\\n(:num-redirects %{num_redirects} :url-effective %{url_effective})"
855 | "\\n(:num-redirects %{num_redirects} :url-effective \"%{url_effective}\")"))
856 |
857 | (defun request--curl-mkdir-for-cookie-jar ()
858 | (ignore-errors
859 | (make-directory (file-name-directory (request--curl-cookie-jar)) t)))
860 |
861 | (cl-defun request--curl-command
862 | (url &key type data headers timeout files*
863 | &allow-other-keys
864 | &aux
865 | (cookie-jar (convert-standard-filename
866 | (expand-file-name (request--curl-cookie-jar)))))
867 | (append
868 | (list request-curl "--silent" "--include"
869 | "--location"
870 | ;; FIXME: test automatic decompression
871 | "--compressed"
872 | ;; FIMXE: this way of using cookie might be problem when
873 | ;; running multiple requests.
874 | "--cookie" cookie-jar "--cookie-jar" cookie-jar
875 | "--write-out" request--curl-write-out-template)
876 | (cl-loop for (name filename path mime-type) in files*
877 | collect "--form"
878 | collect (format "%s=@%s;filename=%s%s" name path filename
879 | (if mime-type
880 | (format ";type=%s" mime-type)
881 | "")))
882 | (when data (list "--data-binary" "@-"))
883 | (when type (list "--request" type))
884 | (cl-loop for (k . v) in headers
885 | collect "--header"
886 | collect (format "%s: %s" k v))
887 | (list url)))
888 |
889 | (defun request--curl-normalize-files-1 (files get-temp-file)
890 | (cl-loop for (name . item) in files
891 | collect
892 | (cl-destructuring-bind
893 | (filename &key file buffer data mime-type)
894 | (cond
895 | ((stringp item) (list (file-name-nondirectory item) :file item))
896 | ((bufferp item) (list (buffer-name item) :buffer item))
897 | (t item))
898 | (unless (= (cl-loop for v in (list file buffer data) if v sum 1) 1)
899 | (error "Only one of :file/:buffer/:data must be given. Got: %S"
900 | (cons name item)))
901 | (cond
902 | (file
903 | (list name filename file mime-type))
904 | (buffer
905 | (let ((tf (funcall get-temp-file)))
906 | (with-current-buffer buffer
907 | (write-region (point-min) (point-max) tf nil 'silent))
908 | (list name filename tf mime-type)))
909 | (data
910 | (let ((tf (funcall get-temp-file)))
911 | (with-temp-buffer
912 | (erase-buffer)
913 | (insert data)
914 | (write-region (point-min) (point-max) tf nil 'silent))
915 | (list name filename tf mime-type)))))))
916 |
917 | (defun request--curl-normalize-files (files)
918 | "Change FILES into a list of (NAME FILENAME PATH MIME-TYPE).
919 | This is to make `request--curl-command' cleaner by converting
920 | FILES to a homogeneous list. It returns a list (FILES* TEMPFILES)
921 | where FILES* is a converted FILES and TEMPFILES is a list of
922 | temporary file paths."
923 | (let (tempfiles noerror)
924 | (unwind-protect
925 | (let* ((get-temp-file (lambda ()
926 | (let ((tf (make-temp-file "emacs-request-")))
927 | (push tf tempfiles)
928 | tf)))
929 | (files* (request--curl-normalize-files-1 files get-temp-file)))
930 | (setq noerror t)
931 | (list files* tempfiles))
932 | (unless noerror
933 | ;; Remove temporary files only when an error occurs
934 | (request--safe-delete-files tempfiles)))))
935 |
936 | (defun request--safe-delete-files (files)
937 | "Remove FILES but do not raise error when failed to do so."
938 | (mapc (lambda (f) (condition-case err
939 | (delete-file f)
940 | (error (request-log 'error
941 | "Failed delete file %s. Got: %S" f err))))
942 | files))
943 |
944 | (cl-defun request--curl (url &rest settings
945 | &key type data files headers timeout response
946 | &allow-other-keys)
947 | "cURL-based request backend.
948 |
949 | Redirection handling strategy
950 | -----------------------------
951 |
952 | curl follows redirection when --location is given. However,
953 | all headers are printed when it is used with --include option.
954 | Number of redirects is printed out sexp-based message using
955 | --write-out option (see `request--curl-write-out-template').
956 | This number is used for removing extra headers and parse
957 | location header from the last redirection header.
958 |
959 | Sexp at the end of buffer and extra headers for redirects are
960 | removed from the buffer before it is shown to the parser function.
961 | "
962 | (request--curl-mkdir-for-cookie-jar)
963 | (let* (;; Use pipe instead of pty. Otherwise, curl process hangs.
964 | (process-connection-type nil)
965 | ;; Avoid starting program in non-existing directory.
966 | (default-directory (expand-file-name "~/"))
967 | (buffer (generate-new-buffer " *request curl*"))
968 | (command (cl-destructuring-bind
969 | (files* tempfiles)
970 | (request--curl-normalize-files files)
971 | (setf (request-response--tempfiles response) tempfiles)
972 | (apply #'request--curl-command url :files* files*
973 | settings)))
974 | (proc (apply #'start-process "request curl" buffer command)))
975 | (request-log 'debug "Run: %s" (mapconcat 'identity command " "))
976 | (setf (request-response--buffer response) buffer)
977 | (process-put proc :request-response response)
978 | (set-process-coding-system proc 'binary 'binary)
979 | (set-process-query-on-exit-flag proc nil)
980 | (set-process-sentinel proc #'request--curl-callback)
981 | (when data
982 | (process-send-string proc data)
983 | (process-send-eof proc))))
984 |
985 | (defun request--curl-read-and-delete-tail-info ()
986 | "Read a sexp at the end of buffer and remove it and preceding character.
987 | This function moves the point at the end of buffer by side effect.
988 | See also `request--curl-write-out-template'."
989 | (let (forward-sexp-function)
990 | (goto-char (point-max))
991 | (forward-sexp -1)
992 | (let ((beg (1- (point))))
993 | (prog1
994 | (read (current-buffer))
995 | (delete-region beg (point-max))))))
996 |
997 | (defconst request--cookie-reserved-re
998 | (mapconcat
999 | (lambda (x) (concat "\\(^" x "\\'\\)"))
1000 | '("comment" "commenturl" "discard" "domain" "max-age" "path" "port"
1001 | "secure" "version" "expires")
1002 | "\\|")
1003 | "Uninterested keys in cookie.
1004 | See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt")
1005 |
1006 | (defun request--consume-100-continue ()
1007 | "Remove \"HTTP/* 100 Continue\" header at the point."
1008 | (cl-destructuring-bind (&key code &allow-other-keys)
1009 | (save-excursion (ignore-errors (request--parse-response-at-point)))
1010 | (when (equal code 100)
1011 | (delete-region (point) (progn (request--goto-next-body) (point)))
1012 | ;; FIXME: Does this make sense? Is it possible to have multiple 100?
1013 | (request--consume-100-continue))))
1014 |
1015 | (defun request--consume-200-connection-established ()
1016 | "Remove proxy header at the point.
1017 |
1018 | Some proxies return a header block before the server headers. Remove it."
1019 | ;; [RFC draft][1] & [Privoxy code][2] use "Connection established".
1020 | ;; But [polipo][] & [cow][] use "Tunnel established". I use `[^\r\n]` here for
1021 | ;; compatibility.
1022 | ;;
1023 | ;; [1]: https://tools.ietf.org/html/draft-luotonen-web-proxy-tunneling-01#section-3.2
1024 | ;; [2]: http://ijbswa.cvs.sourceforge.net/viewvc/ijbswa/current/jcc.c?view=markup
1025 | ;; [polipo]: https://github.com/jech/polipo/blob/master/tunnel.c#L302
1026 | ;; [cow]: https://github.com/cyfdecyf/cow/blob/master/proxy.go#L1160
1027 | (when (looking-at-p "HTTP/[0-9]+\\.[0-9]+ 2[0-9][0-9] [^\r\n]* established\r\n")
1028 | (delete-region (point) (progn (request--goto-next-body) (point)))))
1029 |
1030 | (defun request--curl-preprocess ()
1031 | "Pre-process current buffer before showing it to user."
1032 | (let (history)
1033 | (cl-destructuring-bind (&key num-redirects url-effective)
1034 | (request--curl-read-and-delete-tail-info)
1035 | (goto-char (point-min))
1036 | (request--consume-100-continue)
1037 | (request--consume-200-connection-established)
1038 | (when (> num-redirects 0)
1039 | (cl-loop with case-fold-search = t
1040 | repeat num-redirects
1041 | ;; Do not store code=100 headers:
1042 | do (request--consume-100-continue)
1043 | do (let ((response (make-request-response
1044 | :-buffer (current-buffer)
1045 | :-backend 'curl)))
1046 | (request--clean-header response)
1047 | (request--cut-header response)
1048 | (push response history))))
1049 |
1050 | (goto-char (point-min))
1051 | (nconc (list :num-redirects num-redirects :url-effective url-effective
1052 | :history (nreverse history))
1053 | (request--parse-response-at-point)))))
1054 |
1055 | (defun request--curl-absolutify-redirects (start-url redirects)
1056 | "Convert relative paths in REDIRECTS to absolute URLs.
1057 | START-URL is the URL requested."
1058 | (cl-loop for prev-url = start-url then url
1059 | for url in redirects
1060 | unless (string-match url-nonrelative-link url)
1061 | do (setq url (url-expand-file-name url prev-url))
1062 | collect url))
1063 |
1064 | (defun request--curl-absolutify-location-history (start-url history)
1065 | "Convert relative paths in HISTORY to absolute URLs.
1066 | START-URL is the URL requested."
1067 | (when history
1068 | (setf (request-response-url (car history)) start-url))
1069 | (cl-loop for url in (request--curl-absolutify-redirects
1070 | start-url
1071 | (mapcar (lambda (response)
1072 | (request-response-header response "location"))
1073 | history))
1074 | for response in (cdr history)
1075 | do (setf (request-response-url response) url)))
1076 |
1077 | (defun request--curl-callback (proc event)
1078 | (let* ((buffer (process-buffer proc))
1079 | (response (process-get proc :request-response))
1080 | (symbol-status (request-response-symbol-status response))
1081 | (settings (request-response-settings response)))
1082 | (request-log 'debug "REQUEST--CURL-CALLBACK event = %s" event)
1083 | (request-log 'debug "REQUEST--CURL-CALLBACK proc = %S" proc)
1084 | (request-log 'debug "REQUEST--CURL-CALLBACK buffer = %S" buffer)
1085 | (request-log 'debug "REQUEST--CURL-CALLBACK symbol-status = %S"
1086 | symbol-status)
1087 | (cond
1088 | ((and (memq (process-status proc) '(exit signal))
1089 | (/= (process-exit-status proc) 0))
1090 | (setf (request-response-error-thrown response) (cons 'error event))
1091 | (apply #'request--callback buffer settings))
1092 | ((equal event "finished\n")
1093 | (cl-destructuring-bind (&key version code num-redirects history error
1094 | url-effective)
1095 | (condition-case err
1096 | (with-current-buffer buffer
1097 | (request--curl-preprocess))
1098 | ((debug error)
1099 | (list :error err)))
1100 | (request--curl-absolutify-location-history (plist-get settings :url)
1101 | history)
1102 | (setf (request-response-status-code response) code)
1103 | (setf (request-response-url response) url-effective)
1104 | (setf (request-response-history response) history)
1105 | (setf (request-response-error-thrown response)
1106 | (or error (when (>= code 400) `(error . (http ,code)))))
1107 | (apply #'request--callback buffer settings))))))
1108 |
1109 | (cl-defun request--curl-sync (url &rest settings &key response &allow-other-keys)
1110 | ;; To make timeout work, use polling approach rather than using
1111 | ;; `call-process'.
1112 | (lexical-let (finished)
1113 | (prog1 (apply #'request--curl url
1114 | :complete (lambda (&rest _) (setq finished t))
1115 | settings)
1116 | (let ((proc (get-buffer-process (request-response--buffer response))))
1117 | (while (and (not finished) (request--process-live-p proc))
1118 | (accept-process-output proc))))))
1119 |
1120 | (defun request--curl-get-cookies (host localpart secure)
1121 | (request--netscape-get-cookies (request--curl-cookie-jar)
1122 | host localpart secure))
1123 |
1124 |
1125 | ;;; Netscape cookie.txt parser
1126 |
1127 | (defun request--netscape-cookie-parse ()
1128 | "Parse Netscape/Mozilla cookie format."
1129 | (goto-char (point-min))
1130 | (let ((tsv-re (concat "^\\="
1131 | (cl-loop repeat 6 concat "\\([^\t\n]+\\)\t")
1132 | "\\(.*\\)"))
1133 | cookies)
1134 | (while
1135 | (and
1136 | (cond
1137 | ((re-search-forward "^\\=#" nil t))
1138 | ((re-search-forward "^\\=$" nil t))
1139 | ((re-search-forward tsv-re)
1140 | (push (cl-loop for i from 1 to 7 collect (match-string i))
1141 | cookies)
1142 | t))
1143 | (= (forward-line 1) 0)
1144 | (not (= (point) (point-max)))))
1145 | (setq cookies (nreverse cookies))
1146 | (cl-loop for (domain flag path secure expiration name value) in cookies
1147 | collect (list domain
1148 | (equal flag "TRUE")
1149 | path
1150 | (equal secure "TRUE")
1151 | (string-to-number expiration)
1152 | name
1153 | value))))
1154 |
1155 | (defun request--netscape-filter-cookies (cookies host localpart secure)
1156 | (cl-loop for (domain flag path secure-1 expiration name value) in cookies
1157 | when (and (equal domain host)
1158 | (equal path localpart)
1159 | (or secure (not secure-1)))
1160 | collect (cons name value)))
1161 |
1162 | (defun request--netscape-get-cookies (filename host localpart secure)
1163 | (when (file-readable-p filename)
1164 | (with-temp-buffer
1165 | (erase-buffer)
1166 | (insert-file-contents filename)
1167 | (request--netscape-filter-cookies (request--netscape-cookie-parse)
1168 | host localpart secure))))
1169 |
1170 |
1171 | ;;; Monkey patches for url.el
1172 |
1173 | (defun request--url-default-expander (urlobj defobj)
1174 | "Adapted from lisp/url/url-expand.el.
1175 | FSF holds the copyright of this function:
1176 | Copyright (C) 1999, 2004-2012 Free Software Foundation, Inc."
1177 | ;; The default expansion routine - urlobj is modified by side effect!
1178 | (if (url-type urlobj)
1179 | ;; Well, they told us the scheme, let's just go with it.
1180 | nil
1181 | (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj)))
1182 | (setf (url-port urlobj) (or (url-portspec urlobj)
1183 | (and (string= (url-type urlobj)
1184 | (url-type defobj))
1185 | (url-port defobj))))
1186 | (if (not (string= "file" (url-type urlobj)))
1187 | (setf (url-host urlobj) (or (url-host urlobj) (url-host defobj))))
1188 | (if (string= "ftp" (url-type urlobj))
1189 | (setf (url-user urlobj) (or (url-user urlobj) (url-user defobj))))
1190 | (if (string= (url-filename urlobj) "")
1191 | (setf (url-filename urlobj) "/"))
1192 | ;; If the object we're expanding from is full, then we are now
1193 | ;; full.
1194 | (unless (url-fullness urlobj)
1195 | (setf (url-fullness urlobj) (url-fullness defobj)))
1196 | (if (string-match "^/" (url-filename urlobj))
1197 | nil
1198 | (let ((query nil)
1199 | (file nil)
1200 | (sepchar nil))
1201 | (if (string-match "[?#]" (url-filename urlobj))
1202 | (setq query (substring (url-filename urlobj) (match-end 0))
1203 | file (substring (url-filename urlobj) 0 (match-beginning 0))
1204 | sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0)))
1205 | (setq file (url-filename urlobj)))
1206 | ;; We use concat rather than expand-file-name to combine
1207 | ;; directory and file name, since urls do not follow the same
1208 | ;; rules as local files on all platforms.
1209 | (setq file (url-expander-remove-relative-links
1210 | (concat (url-file-directory (url-filename defobj)) file)))
1211 | (setf (url-filename urlobj)
1212 | (if query (concat file sepchar query) file))))))
1213 |
1214 | (defadvice url-default-expander
1215 | (around request-monkey-patch-url-default-expander (urlobj defobj))
1216 | "Monkey patch `url-default-expander' to fix bug #12374.
1217 | This patch is applied to Emacs trunk at revno 111291:
1218 | http://bzr.savannah.gnu.org/lh/emacs/trunk/revision/111291.
1219 | Without this patch, port number is not treated when using
1220 | `url-expand-file-name'.
1221 | See: http://thread.gmane.org/gmane.emacs.devel/155698"
1222 | (setq ad-return-value (request--url-default-expander urlobj defobj)))
1223 |
1224 | (unless (equal (url-expand-file-name "/path" "http://127.0.0.1:8000")
1225 | "http://127.0.0.1:8000/path")
1226 | (ad-enable-advice 'url-default-expander
1227 | 'around
1228 | 'request-monkey-patch-url-default-expander)
1229 | (ad-activate 'url-default-expander))
1230 |
1231 |
1232 | (eval-when-compile (require 'url-http)
1233 | (defvar url-http-no-retry)
1234 | (defvar url-http-extra-headers)
1235 | (defvar url-http-data)
1236 | (defvar url-callback-function)
1237 | (defvar url-callback-arguments))
1238 | (declare-function url-http-idle-sentinel "url-http")
1239 | (declare-function url-http-activate-callback "url-http")
1240 | (declare-function url-http "url-http")
1241 | (declare-function url-http-parse-headers "url-http")
1242 |
1243 | (defun request--url-http-end-of-document-sentinel (proc why)
1244 | "Adapted from lisp/url/url-http.el.
1245 | FSF holds the copyright of this function:
1246 | Copyright (C) 1999, 2001, 2004-2012 Free Software Foundation, Inc."
1247 | (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
1248 | (process-buffer proc))
1249 | (url-http-idle-sentinel proc why)
1250 | (when (buffer-name (process-buffer proc))
1251 | (with-current-buffer (process-buffer proc)
1252 | (goto-char (point-min))
1253 | (cond ((not (looking-at "HTTP/"))
1254 | (if url-http-no-retry
1255 | ;; HTTP/0.9 just gets passed back no matter what
1256 | (url-http-activate-callback)
1257 | ;; Call `url-http' again if our connection expired.
1258 | (erase-buffer)
1259 | (let ((url-request-method url-http-method)
1260 | (url-request-extra-headers url-http-extra-headers)
1261 | (url-request-data url-http-data))
1262 | (url-http url-current-object url-callback-function
1263 | url-callback-arguments (current-buffer)))))
1264 | ((url-http-parse-headers)
1265 | (url-http-activate-callback))))))
1266 |
1267 | (defadvice url-http-end-of-document-sentinel
1268 | (around request-monkey-patch-url-http-end-of-document-sentinel (proc why))
1269 | "Monkey patch `url-http-end-of-document-sentinel' to fix bug #11469.
1270 | This patch is applied to Emacs trunk at revno 111291:
1271 | http://bzr.savannah.gnu.org/lh/emacs/trunk/revision/111291.
1272 | Without this patch, PUT method fails every two times.
1273 | See: http://thread.gmane.org/gmane.emacs.devel/155697"
1274 | (setq ad-return-value (request--url-http-end-of-document-sentinel proc why)))
1275 |
1276 | (when (and (version< "24" emacs-version)
1277 | (version< emacs-version "24.3.50.1"))
1278 | (ad-enable-advice 'url-http-end-of-document-sentinel
1279 | 'around
1280 | 'request-monkey-patch-url-http-end-of-document-sentinel)
1281 | (ad-activate 'url-http-end-of-document-sentinel))
1282 |
1283 |
1284 | (provide 'request)
1285 |
1286 | ;;; request.el ends here
1287 |
--------------------------------------------------------------------------------
/tests/request-testing.el:
--------------------------------------------------------------------------------
1 | ;;; request-testing.el --- Testing framework for request.el
2 |
3 | ;; Copyright (C) 2012 Takafumi Arakaki
4 |
5 | ;; Author: Takafumi Arakaki
6 |
7 | ;; This file is NOT part of GNU Emacs.
8 |
9 | ;; request-testing.el is free software: you can redistribute it and/or
10 | ;; modify it under the terms of the GNU General Public License as
11 | ;; published by the Free Software Foundation, either version 3 of the
12 | ;; License, or (at your option) any later version.
13 |
14 | ;; request-testing.el 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 request-testing.el.
21 | ;; If not, see .
22 |
23 | ;;; Commentary:
24 |
25 | ;;
26 |
27 | ;;; Code:
28 |
29 | (eval-when-compile (require 'cl))
30 | (require 'ert)
31 | (require 'request-deferred)
32 |
33 |
34 | ;; Compatibility
35 |
36 | (defun request-testing-string-prefix-p (prefix str &optional ignore-case)
37 | (let ((case-fold-search ignore-case))
38 | (string-match-p (format "^%s" (regexp-quote prefix)) str)))
39 |
40 | (unless (fboundp 'string-prefix-p) ; not defined in Emacs 23.1
41 | (fset 'string-prefix-p (symbol-function 'request-testing-string-prefix-p)))
42 |
43 |
44 | ;;;
45 |
46 | (defvar request-testing-source-dir
47 | (file-name-directory (or load-file-name (buffer-file-name))))
48 |
49 | (defvar request-testing-timeout 3000)
50 |
51 | (defmacro request-testing-with-response-slots (response &rest body)
52 | "Destructure RESPONSE object and execute BODY.
53 | Following symbols are bound:
54 |
55 | response / status-code / history / data / error-thrown /
56 | symbol-status / url / done-p / settings / -buffer / -timer
57 |
58 | The symbols other than `response' is bound using `cl-symbol-macrolet'."
59 | (declare (indent 1))
60 | `(let ((response ,response))
61 | (cl-symbol-macrolet
62 | ,(cl-loop for slot in '(status-code
63 | history
64 | data
65 | error-thrown
66 | symbol-status
67 | url
68 | done-p
69 | settings
70 | -buffer
71 | -timer)
72 | for accessor = (intern (format "request-response-%s" slot))
73 | collect `(,slot (,accessor response)))
74 | ,@body)))
75 |
76 | (defvar request-testing-server--process nil)
77 | (defvar request-testing-server--port nil)
78 |
79 | (defun request-testing--wait-process-until (process output-regexp)
80 | "Wait until PROCESS outputs text which matches to OUTPUT-REGEXP."
81 | (loop with buffer = (process-buffer process)
82 | repeat 30
83 | do (accept-process-output process 0.1 nil t)
84 | for str = (with-current-buffer buffer (buffer-string))
85 | do (cond
86 | ((string-match output-regexp str)
87 | (return str))
88 | ((not (eq 'run (process-status process)))
89 | (error "Server startup error.")))
90 | finally do (error "Server timeout error.")))
91 |
92 | (defun request-testing-server ()
93 | "Get running test server and return its root URL."
94 | (interactive)
95 | (unless request-testing-server--port
96 | (let ((process (start-process "request-testing" " *request-testing*"
97 | "python"
98 | (expand-file-name
99 | "testserver.py"
100 | request-testing-source-dir))))
101 | (setq request-testing-server--process process)
102 | (setq request-testing-server--port
103 | (string-to-number
104 | (request-testing--wait-process-until process "^[0-9]+$")))
105 | (request-testing--wait-process-until process "Running on")))
106 | (request-testing-url))
107 |
108 | (defun request-testing-stop-server ()
109 | (interactive)
110 | (let ((process request-testing-server--process))
111 | (if (and (processp process) (request--process-live-p process))
112 | (quit-process process)
113 | (unless noninteractive
114 | (message "No server is running!"))))
115 | (setq request-testing-server--port nil)
116 | (setq request-testing-server--process nil))
117 | (add-hook 'kill-emacs-hook 'request-testing-stop-server)
118 |
119 | (defun request-testing-url (&rest path)
120 | (loop with url = (format "http://127.0.0.1:%s" request-testing-server--port)
121 | for p in path
122 | do (setq url (concat url "/" p))
123 | finally return url))
124 |
125 | (defun request-testing-async (url &rest args)
126 | (apply #'request (request-testing-url url) args))
127 |
128 | (defun request-testing-sync (url &rest args)
129 | (lexical-let (err timeout)
130 | (let ((result
131 | (deferred:sync!
132 | (deferred:timeout
133 | request-testing-timeout
134 | (setq timeout t)
135 | (deferred:try
136 | (apply #'request-deferred (request-testing-url url) args)
137 | :catch
138 | (lambda (x) (setq err x)))))))
139 | (if timeout
140 | (error "Timeout.")
141 | (or result err)))))
142 |
143 | (defun request-testing-sort-alist (alist)
144 | (sort alist (lambda (x y)
145 | (setq x (symbol-name (car x))
146 | y (symbol-name (car y)))
147 | (string-lessp x y))))
148 |
149 | (defun request-deftest--url-retrieve-isolate (body)
150 | "[Macro helper] Isolate execution of BODY from normal environment."
151 | `((let (url-cookie-storage
152 | url-cookie-secure-storage
153 | url-cookie-file
154 | url-cookies-changed-since-last-save)
155 | ,@body)))
156 |
157 | (defun request-deftest--tempfiles (tempfiles body)
158 | "[Macro helper] Execute BODY with TEMPFILES and then remove them."
159 | (let ((symbols (loop for f in tempfiles
160 | collect (make-symbol (format "%s*" f)))))
161 | `((let ,(loop for s in symbols
162 | collect `(,s (make-temp-file "emacs-request-")))
163 | (let ,(loop for f in tempfiles
164 | for s in symbols
165 | collect `(,f ,s))
166 | (unwind-protect
167 | (progn ,@body)
168 | ,@(loop for s in symbols
169 | collect `(ignore-errors (delete-file ,s)))))))))
170 |
171 | (defun request-deftest--backends (backends name body)
172 | "[Macro helper] Execute BODY only when `request-backend' is in BACKENDS."
173 | `((if (and ',backends (not (memq request-backend ',backends)))
174 | (message "REQUEST: Skip %s for backend %s."
175 | ',name request-backend)
176 | ,@body)))
177 |
178 | (defvar request-testing-capture-message t
179 | "Set this to nil to suppress message capturing during test case
180 | execution. If it is non-nil, messages are not shown in the terminal
181 | unless an error occurs.")
182 |
183 | (defun request-deftest--capture-message (body)
184 | (let ((orig-message (make-symbol "orig-message"))
185 | (messages (make-symbol "messages"))
186 | (noerror (make-symbol "noerror")))
187 | `((if (and noninteractive request-testing-capture-message)
188 | (let ((,orig-message (symbol-function 'message))
189 | ,messages
190 | ,noerror)
191 | (unwind-protect
192 | (progn
193 | (fset 'message (lambda (&rest args) (push args ,messages)))
194 | ,@body
195 | (setq ,noerror t))
196 | (fset 'message ,orig-message)
197 | (unless ,noerror
198 | (loop for m in (nreverse ,messages)
199 | do (apply #'message m)))))
200 | ,@body))))
201 |
202 | (defmacro* request-deftest (name () &body docstring-and-body)
203 | "`ert-deftest' for test requiring test server.
204 |
205 | Additional keyword arguments:
206 |
207 | BACKENDS
208 | If non-nil, indicate backends that can pass this test.
209 | Backend not listed here may fail this test.
210 |
211 | TEMPFILES
212 | A list of variables to be bound to paths of temporary files.
213 | The temporary files are cleaned automatically after the test.
214 | "
215 | (declare (debug (&define :name test
216 | name sexp [&optional stringp]
217 | [&rest keywordp sexp] def-body))
218 | (doc-string 3)
219 | (indent 2))
220 | (let ((docstring (car docstring-and-body))
221 | (body (cdr docstring-and-body))
222 | ert-keys
223 | req-keys)
224 |
225 | ;; If docstring is not given...
226 | (unless (stringp docstring)
227 | (setq docstring nil)
228 | (setq body docstring-and-body))
229 |
230 | ;; Handle keywords
231 | (let (key val)
232 | (while (progn
233 | (setq key (car body))
234 | (and (symbolp key) (symbol-name key)))
235 | (setq val (cadr body))
236 | (if (memq key '(:backends :tempfiles))
237 | (progn
238 | (push key req-keys)
239 | (push val req-keys))
240 | (push key ert-keys)
241 | (push val ert-keys))
242 | (setq body (cddr body)))
243 | (setq ert-keys (nreverse ert-keys))
244 | (setq req-keys (nreverse req-keys)))
245 |
246 | ;; "Decorate" BODY.
247 | (setq body (request-deftest--capture-message body))
248 | (setq body (request-deftest--url-retrieve-isolate body))
249 | (cl-destructuring-bind (&key backends tempfiles) req-keys
250 | (setq body (request-deftest--tempfiles tempfiles body))
251 | (setq body (request-deftest--backends backends name body)))
252 |
253 | ;; Finally, define test.
254 | `(ert-deftest ,name ()
255 | ,@(when docstring (list docstring))
256 | ,@ert-keys
257 | (request-testing-server)
258 | ,@body)))
259 |
260 | (provide 'request-testing)
261 |
262 | ;;; request-testing.el ends here
263 |
--------------------------------------------------------------------------------
/tests/test-request.el:
--------------------------------------------------------------------------------
1 | ;;; test-request.el --- Tests for request.el
2 |
3 | ;; Copyright (C) 2012 Takafumi Arakaki
4 |
5 | ;; Author: Takafumi Arakaki
6 |
7 | ;; This file is NOT part of GNU Emacs.
8 |
9 | ;; test-request.el is free software: you can redistribute it
10 | ;; and/or modify it under the terms of the GNU General Public License
11 | ;; as published by the Free Software Foundation, either version 3 of
12 | ;; the License, or (at your option) any later version.
13 |
14 | ;; test-request.el 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 test-request.el.
21 | ;; If not, see .
22 |
23 | ;;; Commentary:
24 |
25 | ;;
26 |
27 | ;;; Code:
28 |
29 | (eval-when-compile (require 'cl))
30 | (require 'json)
31 | (require 'request-testing)
32 |
33 | (let ((level (getenv "EL_REQUEST_MESSAGE_LEVEL")))
34 | (when (and level (not (equal level "")))
35 | (setq request-message-level (intern level))))
36 | (setq request-log-level request-message-level)
37 |
38 | (let ((backend (getenv "EL_REQUEST_BACKEND")))
39 | (when (and backend (not (equal backend "")))
40 | (setq request-backend (intern backend))
41 | (message "Using request-backend = %S" request-backend)))
42 |
43 | (let ((no-capture (getenv "EL_REQUEST_NO_CAPTURE_MESSAGE")))
44 | (when (and no-capture (not (equal no-capture "")))
45 | (setq request-testing-capture-message nil)))
46 |
47 | ;; Quick snippets for interactive testing:
48 | ;; (setq request-backend 'curl)
49 | ;; (setq request-backend 'url-retrieve)
50 | ;; (setq request-log-level 'blather)
51 | ;; (setq request-log-level -1)
52 |
53 |
54 |
55 | ;;; GET
56 |
57 | (request-deftest request-simple-get ()
58 | (request-testing-with-response-slots
59 | (request-testing-sync "report/some-path"
60 | :parser 'json-read)
61 | (should done-p)
62 | (should (equal status-code 200))
63 | (should (equal (assoc-default 'path data) "some-path"))
64 | (should (equal (assoc-default 'method data) "GET"))))
65 |
66 | (request-deftest request-get-with-args ()
67 | (request-testing-with-response-slots
68 | (request-testing-sync "report/some-path?a=1&b=2"
69 | :parser 'json-read)
70 | (should (equal status-code 200))
71 | (should (equal (request-testing-sort-alist (assoc-default 'args data))
72 | '((a . "1") (b . "2"))))
73 | (should (equal (assoc-default 'path data) "some-path"))))
74 |
75 | (defun request-testing-assert-redirected-to (response path)
76 | (request-testing-with-response-slots
77 | response
78 | (if (and noninteractive (eq request-backend 'url-retrieve))
79 | ;; See [#url-noninteractive]_
80 | (progn
81 | (should (string-prefix-p (request-testing-url "report" path) url))
82 | (should (string-prefix-p path (assoc-default 'path data))))
83 | (should (equal (request-testing-url "report" path) url))
84 | (should (equal (assoc-default 'path data) path)))
85 | (should (equal status-code 200))
86 | (should (equal (assoc-default 'method data) "GET"))))
87 | ;; .. [#url-noninteractive] `url-retrieve' adds %0D to redirection
88 | ;; path when the test is run in noninteractive environment.
89 | ;; probably it's a bug in `url-retrieve'...
90 |
91 | (request-deftest request-get-simple-redirection ()
92 | (request-testing-with-response-slots
93 | (request-testing-sync "redirect/redirect/report/some-path"
94 | :parser 'json-read)
95 | (request-testing-assert-redirected-to response "some-path")
96 | (let ((desired
97 | (list (request-testing-url "redirect/redirect/report/some-path")
98 | (request-testing-url "redirect/report/some-path")))
99 | (redirects (mapcar #'request-response-url history)))
100 | (if (and noninteractive (eq request-backend 'url-retrieve))
101 | ;; See [#url-noninteractive]_
102 | (loop for url in redirects
103 | for durl in desired
104 | do (should (string-prefix-p durl url)))
105 | (should (equal redirects desired))))))
106 |
107 | (request-deftest request-get-broken-redirection ()
108 | "Relative Location must be treated gracefully, even if it is not
109 | correct according to RFC 2616.
110 | See also:
111 | * RFC 2616 Section 14.30: http://tools.ietf.org/html/rfc2616#section-14.30
112 | * GNU bug report #12374: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12374
113 | "
114 | :backends (curl)
115 | (request-testing-with-response-slots
116 | (request-testing-sync "broken_redirect/report/some-path"
117 | :parser 'json-read)
118 | (request-testing-assert-redirected-to response "some-path")
119 | (let ((desired
120 | (list (request-testing-url "broken_redirect/report/some-path")))
121 | (redirects (mapcar #'request-response-url history)))
122 | (should (equal redirects desired)))))
123 |
124 | (request-deftest request-get-code-success ()
125 | (loop for code in (nconc (loop for c from 200 to 207 collect c)
126 | (list 226))
127 | do (request-testing-with-response-slots
128 | (request-testing-sync (format "code/%d" code)
129 | :parser 'ignore)
130 | (should-not error-thrown)
131 | (should (equal status-code code)))))
132 |
133 | (request-deftest request-get-code-client-error ()
134 | (loop for code in (loop for c from 400 to 418
135 | ;; 401: Unauthorized
136 | ;; `url-retrieve' pops prompt.
137 | ;; FIXME: find a way to test in a batch mode.
138 | ;; 402: Payment Required
139 | ;; "Reserved for future use."
140 | ;; So it's OK to ignore this code?
141 | ;; 407: Proxy Authentication Required
142 | ;; FIXME: how to support this?
143 | unless (member c '(401 402 407))
144 | collect c)
145 | do (request-testing-with-response-slots
146 | (request-testing-sync (format "code/%d" code)
147 | :parser 'ignore)
148 | (should (equal error-thrown `(error . (http ,code))))
149 | (should (equal status-code code)))))
150 |
151 | (request-deftest request-get-code-server-error ()
152 | (loop for code in (loop for c from 500 to 510
153 | ;; flask does not support them:
154 | unless (member c '(506 508 509))
155 | collect c)
156 | do (request-testing-with-response-slots
157 | (request-testing-sync (format "code/%d" code)
158 | :parser 'ignore)
159 | (should (equal error-thrown `(error . (http ,code))))
160 | (should (equal status-code code)))))
161 |
162 | (request-deftest request-get-timeout ()
163 | (request-testing-with-response-slots
164 | (request-testing-sync "sleep/1.0"
165 | :timeout 0.1
166 | :parser 'json-read)
167 | (should (equal symbol-status 'timeout))
168 | (should error-thrown)
169 | (should done-p)))
170 |
171 | (request-deftest request-get-parse-header-when-400 ()
172 | (request-testing-with-response-slots
173 | (request-testing-sync "code/400")
174 | (should (equal error-thrown '(error . (http 400))))
175 | (should (equal status-code 400))
176 | ;; Header should be parse-able:
177 | (should (request-response-header response "server"))))
178 |
179 | (request-deftest request-get-sync ()
180 | (request-testing-with-response-slots
181 | (request (request-testing-url "report/some-path")
182 | :sync t :parser 'json-read)
183 | (should done-p)
184 | (should (equal status-code 200))
185 | (should (equal (assoc-default 'path data) "some-path"))
186 | (should (equal (assoc-default 'method data) "GET"))))
187 |
188 |
189 | ;;; POST
190 |
191 | (request-deftest request-simple-post ()
192 | (request-testing-with-response-slots
193 | (request-testing-sync "report/some-path"
194 | :type "POST" :data "key=value"
195 | :parser 'json-read)
196 | (should (equal status-code 200))
197 | (should (equal (assoc-default 'path data) "some-path"))
198 | (should (equal (assoc-default 'method data) "POST"))
199 | (should (equal (assoc-default 'form data) '((key . "value"))))))
200 |
201 | (request-deftest request-post-multibytes ()
202 | (request-testing-with-response-slots
203 | (request-testing-sync "report/some-path"
204 | :type "POST"
205 | :data '(("鍵" . "値"))
206 | :parser (lambda ()
207 | (let ((json-key-type 'string))
208 | (json-read))))
209 | (should (equal status-code 200))
210 | (should-not error-thrown)
211 | (should (equal (assoc-default "path" data) "some-path"))
212 | (should (equal (assoc-default "method" data) "POST"))
213 | (should (equal (assoc-default "form" data) '(("鍵" . "値"))))))
214 |
215 | (request-deftest request-post-files/simple-buffer ()
216 | :backends (curl)
217 | (with-current-buffer (get-buffer-create " *request-test-temp*")
218 | (erase-buffer)
219 | (insert "BUFFER CONTENTS"))
220 | (request-testing-with-response-slots
221 | (request-testing-sync
222 | "report/some-path"
223 | :type "POST"
224 | :files `(("name" . ,(get-buffer-create " *request-test-temp*")))
225 | :parser 'json-read)
226 | (should (equal status-code 200))
227 | (should (equal (assoc-default 'path data) "some-path"))
228 | (should (equal (assoc-default 'method data) "POST"))
229 | (should (= (length (assoc-default 'files data)) 1))
230 | (should (equal
231 | (request-testing-sort-alist (elt (assoc-default 'files data) 0))
232 | '((data . "BUFFER CONTENTS")
233 | (filename . " *request-test-temp*")
234 | (name . "name"))))))
235 |
236 | (request-deftest request-post-files/simple-file ()
237 | :backends (curl)
238 | :tempfiles (tf)
239 | (with-temp-buffer
240 | (erase-buffer)
241 | (insert "BUFFER CONTENTS")
242 | (write-region (point-min) (point-max) tf nil 'silent))
243 | (request-testing-with-response-slots
244 | (request-testing-sync
245 | "report/some-path"
246 | :type "POST"
247 | :files `(("name" . ,tf))
248 | :parser 'json-read)
249 | (should (equal status-code 200))
250 | (should (equal (assoc-default 'path data) "some-path"))
251 | (should (equal (assoc-default 'method data) "POST"))
252 | (should (= (length (assoc-default 'files data)) 1))
253 | (should (equal
254 | (request-testing-sort-alist (elt (assoc-default 'files data) 0))
255 | `((data . "BUFFER CONTENTS")
256 | (filename . ,(file-name-nondirectory tf))
257 | (name . "name"))))))
258 |
259 | (request-deftest request-post-files/standard-buffer ()
260 | :backends (curl)
261 | (with-current-buffer (get-buffer-create " *request-test-temp*")
262 | (erase-buffer)
263 | (insert "BUFFER CONTENTS"))
264 | (request-testing-with-response-slots
265 | (request-testing-sync
266 | "report/some-path"
267 | :type "POST"
268 | :files `(("name" .
269 | ("filename"
270 | :buffer ,(get-buffer-create " *request-test-temp*"))))
271 | :parser 'json-read)
272 | (should (equal status-code 200))
273 | (should (equal (assoc-default 'path data) "some-path"))
274 | (should (equal (assoc-default 'method data) "POST"))
275 | (should (= (length (assoc-default 'files data)) 1))
276 | (should (equal
277 | (request-testing-sort-alist (elt (assoc-default 'files data) 0))
278 | '((data . "BUFFER CONTENTS")
279 | (filename . "filename")
280 | (name . "name"))))))
281 |
282 | (request-deftest request-post-files/standard-file ()
283 | :backends (curl)
284 | :tempfiles (tf)
285 | (with-temp-buffer
286 | (erase-buffer)
287 | (insert "BUFFER CONTENTS")
288 | (write-region (point-min) (point-max) tf nil 'silent))
289 | (request-testing-with-response-slots
290 | (request-testing-sync
291 | "report/some-path"
292 | :type "POST"
293 | :files `(("name" . ("filename" :file ,tf)))
294 | :parser 'json-read)
295 | (should (equal status-code 200))
296 | (should (equal (assoc-default 'path data) "some-path"))
297 | (should (equal (assoc-default 'method data) "POST"))
298 | (should (= (length (assoc-default 'files data)) 1))
299 | (should (equal
300 | (request-testing-sort-alist (elt (assoc-default 'files data) 0))
301 | '((data . "BUFFER CONTENTS")
302 | (filename . "filename")
303 | (name . "name"))))))
304 |
305 | (request-deftest request-post-files/standard-data ()
306 | :backends (curl)
307 | (request-testing-with-response-slots
308 | (request-testing-sync
309 | "report/some-path"
310 | :type "POST"
311 | :files '(("name" . ("data.csv" :data "1,2,3\n4,5,6\n")))
312 | :parser 'json-read)
313 | (should (equal status-code 200))
314 | (should (equal (assoc-default 'path data) "some-path"))
315 | (should (equal (assoc-default 'method data) "POST"))
316 | (should (= (length (assoc-default 'files data)) 1))
317 | (should (equal
318 | (request-testing-sort-alist (elt (assoc-default 'files data) 0))
319 | '((data . "1,2,3\n4,5,6\n")
320 | (filename . "data.csv")
321 | (name . "name"))))))
322 |
323 |
324 | ;;; PUT
325 |
326 | (defun request-testing-put-simple-1 ()
327 | (request-testing-with-response-slots
328 | (request-testing-sync "report/some-path"
329 | :type "PUT" :data "dummy-data"
330 | :headers '(("Content-Type" . "text/plain"))
331 | :parser 'json-read)
332 | (should (equal status-code 200))
333 | (should (equal (assoc-default 'path data) "some-path"))
334 | (should (equal (assoc-default 'method data) "PUT"))
335 | (should (equal (assoc-default 'data data) "dummy-data"))))
336 |
337 | (request-deftest request-put-simple ()
338 | (request-testing-put-simple-1))
339 |
340 | (request-deftest request-put-twice ()
341 | "Check that GNU bug report #11469 is fixed.
342 | See: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11469
343 |
344 | It seems that this bug occurs only when using HTTP/1.1 protocol.
345 | To check that, run test with:
346 | export EL_REQUEST_TEST_SERVER=tornado"
347 | (request-testing-put-simple-1)
348 | (request-testing-put-simple-1))
349 |
350 | (request-deftest request-simple-put-json ()
351 | (request-testing-with-response-slots
352 | (request-testing-sync "report/some-path"
353 | :type "PUT" :data "{\"a\": 1, \"b\": 2, \"c\": 3}"
354 | :headers '(("Content-Type" . "application/json"))
355 | :parser 'json-read)
356 | (should (equal status-code 200))
357 | (should (equal (assoc-default 'path data) "some-path"))
358 | (should (equal (assoc-default 'method data) "PUT"))
359 | (should (equal (request-testing-sort-alist (assoc-default 'json data))
360 | '((a . 1) (b . 2) (c . 3))))))
361 |
362 |
363 | ;;; DELETE
364 |
365 | (request-deftest request-simple-delete ()
366 | (request-testing-with-response-slots
367 | (request-testing-sync "report/some-path"
368 | :type "DELETE"
369 | :parser 'json-read)
370 | (should (equal status-code 200))
371 | (should (equal (assoc-default 'path data) "some-path"))
372 | (should (equal (assoc-default 'method data) "DELETE"))))
373 |
374 |
375 | ;;; Abort
376 |
377 | (request-deftest request-abort-simple ()
378 | (let (called)
379 | (request-testing-with-response-slots
380 | (request-testing-async "sleep/0.5"
381 | :complete (lambda (&rest args)
382 | (push args called))
383 | :parser 'json-read)
384 | (let ((process (get-buffer-process -buffer)))
385 | (loop repeat 30
386 | when (request--process-live-p process) return nil
387 | do (sleep-for 0.1)
388 | finally (error "Timeout: failed to check process is started."))
389 |
390 | (should-not symbol-status)
391 | (should-not done-p)
392 | (should (request--process-live-p process))
393 |
394 | (request-abort response)
395 | (loop repeat 30
396 | when called return nil
397 | do (sleep-for 0.1)
398 | finally (error "Timeout: failed to check process is aborted."))
399 |
400 | (should (equal symbol-status 'abort))
401 | (should done-p)
402 | (should-not (request--process-live-p process))))
403 |
404 | (should (= (length called) 1))
405 | (cl-destructuring-bind (&key data symbol-status error-thrown response)
406 | (car called)
407 | (should-not data)
408 | (should (eq symbol-status 'abort))
409 | (should error-thrown)
410 | (should response))))
411 |
412 |
413 | ;;; Parse error
414 |
415 | (request-deftest request-parse-error-simple ()
416 | (request-testing-with-response-slots
417 | (request-testing-sync "report/some-path"
418 | :parser (lambda () (error "Bad parser!")))
419 | (should done-p)
420 | (should (equal symbol-status 'parse-error))
421 | (should (equal error-thrown '(error . ("Bad parser!"))))))
422 |
423 |
424 | ;;; Cookie
425 |
426 | (request-deftest request-simple-cookie ()
427 | :tempfiles (request--curl-cookie-jar)
428 | (request-testing-with-response-slots
429 | (request-testing-sync "cookies/set"
430 | :params '((cookie-name . "cookie-value"))
431 | :parser 'json-read)
432 | (should (equal status-code 200))
433 | (unless (and noninteractive (eq request-backend 'url-retrieve))
434 | ;; *Sometimes* it fails. As from-cookies\r is returned,
435 | ;; it looks like url.el fails to clean tailing \r in the
436 | ;; header fields.
437 | (should (equal (assoc-default 'path data) "from-cookies"))
438 | (should (equal (assoc-default 'cookie-name (assoc-default 'cookies data))
439 | "cookie-value"))
440 | (should (equal (request-cookie-string "127.0.0.1" "/")
441 | "cookie-name=cookie-value")))
442 | (should (equal (assoc-default 'method data) "GET"))))
443 |
444 | (request-deftest request-multiple-cookies ()
445 | :tempfiles (request--curl-cookie-jar)
446 | (request-testing-with-response-slots
447 | (request-testing-sync "cookies/set"
448 | :params '(("a" . "1") ("b" . "2"))
449 | :parser 'json-read)
450 | (should (equal status-code 200))
451 | (unless (and noninteractive (eq request-backend 'url-retrieve))
452 | ;; See `request-simple-cookie'.
453 | (should (equal (assoc-default 'path data) "from-cookies"))
454 | (should (equal (request-testing-sort-alist (assoc-default 'cookies data))
455 | '((a . "1") (b . "2"))))
456 | (should (member (request-cookie-string "127.0.0.1" "/") '("a=1; b=2"
457 | "b=2; a=1"))))
458 | (should (equal (assoc-default 'method data) "GET"))))
459 |
460 | (defun request-testing-assert-username-is (username)
461 | (request-testing-with-response-slots
462 | (request-testing-sync "report/some-path"
463 | :parser 'json-read)
464 | (should (equal status-code 200))
465 | (should (equal (assoc-default 'path data) "some-path"))
466 | (should (equal (assoc-default 'username data) username))
467 | (should (equal (assoc-default 'method data) "GET"))))
468 |
469 | (request-deftest request-session-cookie ()
470 | :backends (curl)
471 | :tempfiles (request--curl-cookie-jar)
472 | (request-testing-assert-username-is nil)
473 | ;; login
474 | (request-testing-with-response-slots
475 | (request-testing-sync "login"
476 | :data "username=gooduser&password=goodpass"
477 | :type "POST"
478 | :parser 'json-read)
479 | (should (equal status-code 200))
480 | (should (equal (assoc-default 'path data) "from-login"))
481 | (should (equal (assoc-default 'username data) "gooduser"))
482 | (should (equal (assoc-default 'method data) "POST")))
483 | ;; check login state
484 | (request-testing-assert-username-is "gooduser")
485 | ;; logout
486 | (request-testing-with-response-slots
487 | (request-testing-sync "logout"
488 | :parser 'json-read)
489 | (should (equal status-code 200))
490 | (should (equal (assoc-default 'path data) "from-logout"))
491 | (should (equal (assoc-default 'username data) nil))
492 | (should (equal (assoc-default 'method data) "GET")))
493 | ;; check login state
494 | (request-testing-assert-username-is nil))
495 |
496 |
497 | ;;; Misc
498 |
499 | (request-deftest request-invoke-in-non-existing-directory ()
500 | "Running request in non-existing directory should work.
501 | Calling `start-process' in non-existing directory fails. Command
502 | based backends (e.g., `curl') should avoid this problem."
503 | (let* ((prefix (expand-file-name "non-existing-" temporary-file-directory))
504 | (default-directory (file-name-as-directory (make-temp-name prefix))))
505 | (should-not (file-exists-p default-directory))
506 | ;; Should not faile:
507 | (request-testing-sync "report/some-path" :parser 'json-read)))
508 |
509 |
510 | ;;; Testing framework
511 |
512 | (defvar request-testing-server-name
513 | (let ((server (getenv "EL_REQUEST_TEST_SERVER")))
514 | (if (member server '(nil "" "flask"))
515 | "werkzeug"
516 | server)))
517 |
518 | (message "Using test server: %s" request-testing-server-name)
519 |
520 | (request-deftest request-tfw-server ()
521 | (let* ((response (request-testing-sync "report/some-path"))
522 | (server (request-response-header response "server")))
523 | (should (string-prefix-p request-testing-server-name (downcase server)))))
524 |
525 |
526 | ;;; `request-backend'-independent tests
527 |
528 | ;; Following tests does not depend on the value of `request-backend'.
529 | ;; Move them to another file when this test suite get bigger.
530 |
531 | (ert-deftest request--urlencode-alist/simple ()
532 | (should (equal (request--urlencode-alist '((a . "1") (b . "2")))
533 | "a=1&b=2")))
534 |
535 | (ert-deftest request--urlencode-alist/hexified ()
536 | ;; Down-case string so that the test passes in Emacs 24.2.
537 | ;; In Emacs 24.2 hexadecimal digits were lower case while it's
538 | ;; upper case in 24.3.
539 | ;; See: http://bzr.savannah.gnu.org/lh/emacs/trunk/revision/108173
540 | (should (equal (downcase
541 | (request--urlencode-alist
542 | '(("key with space" . "*evil* !values!"))))
543 | "key%20with%20space=%2aevil%2a%20%21values%21")))
544 |
545 | (ert-deftest request--curl-preprocess/no-redirects ()
546 | (with-temp-buffer
547 | (erase-buffer)
548 | (insert "\
549 | HTTP/1.0 200 OK\r
550 | Content-Type: application/json\r
551 | Content-Length: 88\r
552 | Server: Werkzeug/0.8.1 Python/2.7.2+\r
553 | Date: Sat, 15 Dec 2012 23:04:26 GMT\r
554 | \r
555 | RESPONSE-BODY")
556 | (insert "\n(:num-redirects 0 :url-effective \"DUMMY-URL\")")
557 | (let ((info (request--curl-preprocess)))
558 | (should (equal (buffer-string)
559 | "\
560 | HTTP/1.0 200 OK\r
561 | Content-Type: application/json\r
562 | Content-Length: 88\r
563 | Server: Werkzeug/0.8.1 Python/2.7.2+\r
564 | Date: Sat, 15 Dec 2012 23:04:26 GMT\r
565 | \r
566 | RESPONSE-BODY"))
567 | (should (equal info
568 | (list :num-redirects 0
569 | :url-effective "DUMMY-URL"
570 | :history nil
571 | :version "1.0" :code 200))))))
572 |
573 | (ert-deftest request--curl-preprocess/two-redirects ()
574 | (with-temp-buffer
575 | (erase-buffer)
576 | (insert "\
577 | HTTP/1.0 302 FOUND\r
578 | Content-Type: text/html; charset=utf-8\r
579 | Content-Length: 257\r
580 | Location: http://example.com/redirect/a/b\r
581 | Server: Werkzeug/0.8.1 Python/2.7.2+\r
582 | Date: Sat, 15 Dec 2012 23:04:26 GMT\r
583 | \r
584 | HTTP/1.0 302 FOUND\r
585 | Content-Type: text/html; charset=utf-8\r
586 | Content-Length: 239\r
587 | Location: http://example.com/a/b\r
588 | Server: Werkzeug/0.8.1 Python/2.7.2+\r
589 | Date: Sat, 15 Dec 2012 23:04:26 GMT\r
590 | \r
591 | HTTP/1.0 200 OK\r
592 | Content-Type: application/json\r
593 | Content-Length: 88\r
594 | Server: Werkzeug/0.8.1 Python/2.7.2+\r
595 | Date: Sat, 15 Dec 2012 23:04:26 GMT\r
596 | \r
597 | RESPONSE-BODY")
598 | (insert "\n(:num-redirects 2 :url-effective \"DUMMY-URL\")")
599 | (let ((info (request--curl-preprocess))
600 | (history (list (make-request-response
601 | ;; :url "http://example.com/a/b"
602 | :-buffer (current-buffer)
603 | :-backend 'curl
604 | :-raw-header "\
605 | HTTP/1.0 302 FOUND
606 | Content-Type: text/html; charset=utf-8
607 | Content-Length: 257
608 | Location: http://example.com/redirect/a/b
609 | Server: Werkzeug/0.8.1 Python/2.7.2+
610 | Date: Sat, 15 Dec 2012 23:04:26 GMT
611 | ")
612 | (make-request-response
613 | ;; :url "http://example.com/redirect/a/b"
614 | :-buffer (current-buffer)
615 | :-backend 'curl
616 | :-raw-header "\
617 | HTTP/1.0 302 FOUND
618 | Content-Type: text/html; charset=utf-8
619 | Content-Length: 239
620 | Location: http://example.com/a/b
621 | Server: Werkzeug/0.8.1 Python/2.7.2+
622 | Date: Sat, 15 Dec 2012 23:04:26 GMT
623 | "))))
624 | (should (equal (buffer-string)
625 | "\
626 | HTTP/1.0 200 OK\r
627 | Content-Type: application/json\r
628 | Content-Length: 88\r
629 | Server: Werkzeug/0.8.1 Python/2.7.2+\r
630 | Date: Sat, 15 Dec 2012 23:04:26 GMT\r
631 | \r
632 | RESPONSE-BODY"))
633 | (should (equal info
634 | (list :num-redirects 2
635 | :url-effective "DUMMY-URL"
636 | :history history
637 | :version "1.0" :code 200))))))
638 |
639 | (ert-deftest request--curl-preprocess/100 ()
640 | (with-temp-buffer
641 | (erase-buffer)
642 | (insert "\
643 | HTTP/1.1 100 Continue\r
644 | \r
645 | HTTP/1.1 200 OK\r
646 | Content-Type: application/json\r
647 | Date: Wed, 19 Dec 2012 16:51:53 GMT\r
648 | Server: gunicorn/0.13.4\r
649 | Content-Length: 492\r
650 | Connection: keep-alive\r
651 | \r
652 | RESPONSE-BODY")
653 | (insert "\n(:num-redirects 0 :url-effective \"DUMMY-URL\")")
654 | (let ((info (request--curl-preprocess)))
655 | (should (equal (buffer-string)
656 | "\
657 | HTTP/1.1 200 OK\r
658 | Content-Type: application/json\r
659 | Date: Wed, 19 Dec 2012 16:51:53 GMT\r
660 | Server: gunicorn/0.13.4\r
661 | Content-Length: 492\r
662 | Connection: keep-alive\r
663 | \r
664 | RESPONSE-BODY"))
665 | (should (equal info
666 | (list :num-redirects 0
667 | :url-effective "DUMMY-URL"
668 | :history nil
669 | :version "1.1" :code 200))))))
670 |
671 | (ert-deftest request--curl-preprocess/200-proxy-connection-established ()
672 | (with-temp-buffer
673 | (erase-buffer)
674 | (insert "\
675 | HTTP/1.0 200 Connection established\r
676 | \r
677 | HTTP/1.1 200 OK\r
678 | Content-Type: application/json\r
679 | Date: Wed, 19 Dec 2012 16:51:53 GMT\r
680 | Server: gunicorn/0.13.4\r
681 | Content-Length: 492\r
682 | Connection: keep-alive\r
683 | \r
684 | RESPONSE-BODY")
685 | (insert "\n(:num-redirects 0 :url-effective \"DUMMY-URL\")")
686 | (let ((info (request--curl-preprocess)))
687 | (should (equal (buffer-string)
688 | "\
689 | HTTP/1.1 200 OK\r
690 | Content-Type: application/json\r
691 | Date: Wed, 19 Dec 2012 16:51:53 GMT\r
692 | Server: gunicorn/0.13.4\r
693 | Content-Length: 492\r
694 | Connection: keep-alive\r
695 | \r
696 | RESPONSE-BODY"))
697 | (should (equal info
698 | (list :num-redirects 0
699 | :url-effective "DUMMY-URL"
700 | :history nil
701 | :version "1.1" :code 200))))))
702 |
703 | (ert-deftest request--curl-preprocess/200-proxy-tunnel-established ()
704 | (with-temp-buffer
705 | (erase-buffer)
706 | (insert "\
707 | HTTP/1.1 200 Tunnel established\r
708 | \r
709 | HTTP/1.1 200 OK\r
710 | Content-Type: application/json\r
711 | Date: Wed, 19 Dec 2012 16:51:53 GMT\r
712 | Server: gunicorn/0.13.4\r
713 | Content-Length: 492\r
714 | Connection: keep-alive\r
715 | \r
716 | RESPONSE-BODY")
717 | (insert "\n(:num-redirects 0 :url-effective \"DUMMY-URL\")")
718 | (let ((info (request--curl-preprocess)))
719 | (should (equal (buffer-string)
720 | "\
721 | HTTP/1.1 200 OK\r
722 | Content-Type: application/json\r
723 | Date: Wed, 19 Dec 2012 16:51:53 GMT\r
724 | Server: gunicorn/0.13.4\r
725 | Content-Length: 492\r
726 | Connection: keep-alive\r
727 | \r
728 | RESPONSE-BODY"))
729 | (should (equal info
730 | (list :num-redirects 0
731 | :url-effective "DUMMY-URL"
732 | :history nil
733 | :version "1.1" :code 200))))))
734 |
735 | (ert-deftest request--curl-absolutify-redirects/simple ()
736 | (should (equal (request--curl-absolutify-redirects
737 | "http://localhost"
738 | '("/a" "/b"))
739 | '("http://localhost/a" "http://localhost/b"))))
740 |
741 | (ert-deftest request--curl-absolutify-redirects/complex ()
742 | (should (equal (request--curl-absolutify-redirects
743 | "http://localhost"
744 | '("http://spam" "/a" "http://egg" "/b"))
745 | '("http://spam"
746 | "http://spam/a"
747 | "http://egg"
748 | "http://egg/b"))))
749 |
750 | (ert-deftest request--curl-absolutify-redirects/with-port ()
751 | (should (equal (request--curl-absolutify-redirects
752 | "http://localhost:8000"
753 | '("/a" "/b"))
754 | '("http://localhost:8000/a" "http://localhost:8000/b"))))
755 |
756 | (ert-deftest request-abort-killed-buffer ()
757 | (request-testing-with-response-slots
758 | (make-request-response
759 | :-buffer (with-temp-buffer (current-buffer)))
760 | (should-not (buffer-live-p -buffer))
761 | (request-abort response)
762 | (should done-p)))
763 |
764 | (ert-deftest request--netscape-cookie-parse ()
765 | (with-temp-buffer
766 | (erase-buffer)
767 | (insert "\
768 | # Netscape HTTP Cookie File
769 | # http://curl.haxx.se/rfc/cookie_spec.html
770 | # This file was generated by libcurl! Edit at your own risk.
771 |
772 | #HttpOnly_127.0.0.1 FALSE / FALSE 0 session \"Jm7AXQMIE\"
773 | 127.0.0.1 FALSE / FALSE 0 key1 value1
774 | 127.0.0.1 FALSE / FALSE 0 key2 value2
775 | ")
776 | (should (equal (request--netscape-cookie-parse)
777 | '(("127.0.0.1" nil "/" nil 0 "key1" "value1")
778 | ("127.0.0.1" nil "/" nil 0 "key2" "value2"))))))
779 |
780 | (provide 'test-request)
781 |
782 | ;;; test-request.el ends here
783 |
--------------------------------------------------------------------------------
/tests/testserver.py:
--------------------------------------------------------------------------------
1 | import os
2 |
3 | from flask import (
4 | Flask, request, session, redirect, abort, jsonify)
5 | from werkzeug.http import HTTP_STATUS_CODES
6 |
7 | app = Flask(__name__)
8 | app.secret_key = 'SECRET-KEY-FOR-EMACS-REQUEST-DEVELOPMENT'
9 |
10 | all_methods = ['GET', 'POST', 'PUT', 'DELETE']
11 |
12 |
13 | # View functions
14 |
15 |
16 | @app.route('/report/', methods=all_methods)
17 | def page_report(path):
18 | """
19 | Report back path, input data, parameter, etc. as JSON.
20 | """
21 | # see: http://flask.pocoo.org/docs/api/#incoming-request-data
22 | return jsonify(dict(
23 | path=path,
24 | data=request.data,
25 | form=request.form,
26 | files=[dict(name=k, filename=f.filename, data=f.read())
27 | for (k, f) in request.files.items()],
28 | args=request.args,
29 | cookies=request.cookies,
30 | method=request.method,
31 | json=request.json,
32 | username=session.get('username'),
33 | ))
34 |
35 |
36 | @app.route('/redirect/', methods=all_methods)
37 | def page_redirect(path):
38 | return redirect(path)
39 |
40 |
41 | @app.route('/broken_redirect/', methods=all_methods)
42 | def page_broken_redirect(path):
43 | """
44 | A pathological redirection. Location does not contain the scheme part.
45 | """
46 | response = redirect(path)
47 | response.headers['Location'] = '/' + path # URL w/o scheme part
48 | response.autocorrect_location_header = False
49 | return response
50 |
51 |
52 | @app.route('/code/')
53 | def page_code(code):
54 | try:
55 | return abort(code)
56 | except LookupError:
57 | return HTTP_STATUS_CODES[code], code
58 |
59 |
60 | @app.route('/sleep/')
61 | def page_sleep(sleep):
62 | import time
63 | time.sleep(sleep)
64 | return redirect('report/from-sleep')
65 |
66 |
67 | @app.route('/login', methods=['GET', 'POST'])
68 | def page_login():
69 | error = 'Not logged-in'
70 | if request.method == 'POST':
71 | username = request.form['username']
72 | if 'invalid' in username:
73 | error = 'Invalid username'
74 | elif 'invalid' in request.form['password']:
75 | error = 'Invalid password'
76 | else:
77 | session['username'] = username
78 | return redirect('report/from-login')
79 | return error
80 |
81 |
82 | @app.route('/logout')
83 | def page_logout():
84 | session.pop('username', None)
85 | return redirect('report/from-logout')
86 |
87 |
88 | @app.route('/cookies/set')
89 | def page_set_cookies():
90 | # see: http://flask.pocoo.org/docs/quickstart/#cookies
91 | resp = redirect('report/from-cookies')
92 | for (name, value) in request.args.items():
93 | resp.set_cookie(name, value)
94 | return resp
95 |
96 |
97 | # Runner
98 |
99 |
100 | def get_open_port():
101 | import socket
102 | s = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
103 | s.bind(("", 0))
104 | s.listen(1)
105 | port = s.getsockname()[1]
106 | s.close()
107 | return port
108 |
109 |
110 | def run(port, server, **kwds):
111 | import sys
112 | port = port or get_open_port()
113 | # Pass port number to child process via envvar. This is required
114 | # when using Flask's reloader.
115 | os.environ['EL_REQUEST_TEST_PORT'] = str(port)
116 | print port
117 | sys.stdout.flush()
118 |
119 | if server == 'flask':
120 | app.run(port=port, **kwds)
121 | else:
122 | app.debug = True
123 | from tornado.wsgi import WSGIContainer
124 | from tornado.httpserver import HTTPServer
125 | from tornado.ioloop import IOLoop
126 | http_server = HTTPServer(WSGIContainer(app))
127 | http_server.listen(port)
128 | print " * Running on", port
129 | IOLoop.instance().start()
130 |
131 |
132 | def main(args=None):
133 | import argparse
134 | default_port = int(os.environ.get('EL_REQUEST_TEST_PORT', '0'))
135 | default_server = os.environ.get('EL_REQUEST_TEST_SERVER') or 'flask'
136 | parser = argparse.ArgumentParser(description=__doc__)
137 | parser.add_argument('--port', default=default_port, type=int)
138 | parser.add_argument('--use-reloader', default=False, action='store_true')
139 | parser.add_argument('--server', default=default_server,
140 | choices=['flask', 'tornado'])
141 | ns = parser.parse_args(args)
142 | run(**vars(ns))
143 |
144 |
145 | if __name__ == '__main__':
146 | main()
147 |
--------------------------------------------------------------------------------