├── .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 | --------------------------------------------------------------------------------