pax_global_header00006660000000000000000000000064134060340720014511gustar00rootroot0000000000000052 comment=48b58c22b3afe9237aa224c2852b6d8d82eca28e ocaml-http-0.1.6/000077500000000000000000000000001340603407200135655ustar00rootroot00000000000000ocaml-http-0.1.6/.depend000066400000000000000000000053341340603407200150320ustar00rootroot00000000000000cookie_lexer.cmo: cookie_lexer.cmi cookie_lexer.cmx: cookie_lexer.cmi http_common.cmo: http_types.cmi http_constants.cmi http_common.cmi http_common.cmx: http_types.cmx http_constants.cmx http_common.cmi http_constants.cmo: http_constants.cmi http_constants.cmx: http_constants.cmi http_daemon.cmo: http_types.cmi http_tcp_server.cmi http_request.cmi \ http_parser_sanity.cmi http_parser.cmi http_misc.cmi http_constants.cmi \ http_common.cmi http_daemon.cmi http_daemon.cmx: http_types.cmx http_tcp_server.cmx http_request.cmx \ http_parser_sanity.cmx http_parser.cmx http_misc.cmx http_constants.cmx \ http_common.cmx http_daemon.cmi http_message.cmo: http_types.cmi http_parser_sanity.cmi http_misc.cmi \ http_constants.cmi http_common.cmi http_message.cmi http_message.cmx: http_types.cmx http_parser_sanity.cmx http_misc.cmx \ http_constants.cmx http_common.cmx http_message.cmi http_misc.cmo: http_types.cmi http_misc.cmi http_misc.cmx: http_types.cmx http_misc.cmi http_parser.cmo: http_types.cmi http_parser_sanity.cmi http_constants.cmi \ http_common.cmi cookie_lexer.cmi http_parser.cmi http_parser.cmx: http_types.cmx http_parser_sanity.cmx http_constants.cmx \ http_common.cmx cookie_lexer.cmx http_parser.cmi http_parser_sanity.cmo: http_types.cmi http_constants.cmi \ http_parser_sanity.cmi http_parser_sanity.cmx: http_types.cmx http_constants.cmx \ http_parser_sanity.cmi http_request.cmo: http_types.cmi http_parser.cmi http_misc.cmi \ http_message.cmi http_common.cmi http_request.cmi http_request.cmx: http_types.cmx http_parser.cmx http_misc.cmx \ http_message.cmx http_common.cmx http_request.cmi http_response.cmo: http_types.cmi http_misc.cmi http_message.cmi \ http_daemon.cmi http_constants.cmi http_common.cmi http_response.cmi http_response.cmx: http_types.cmx http_misc.cmx http_message.cmx \ http_daemon.cmx http_constants.cmx http_common.cmx http_response.cmi http_tcp_server.cmo: http_threaded_tcp_server.cmi http_tcp_server.cmi http_tcp_server.cmx: http_threaded_tcp_server.cmi http_tcp_server.cmi http_types.cmo: http_types.cmi http_types.cmx: http_types.cmi http_user_agent.cmo: http_parser.cmi http_misc.cmi http_common.cmi \ http_user_agent.cmi http_user_agent.cmx: http_parser.cmx http_misc.cmx http_common.cmx \ http_user_agent.cmi cookie_lexer.cmi: http_common.cmi: http_types.cmi http_constants.cmi: http_types.cmi http_daemon.cmi: http_types.cmi http_message.cmi: http_types.cmi http_misc.cmi: http_parser.cmi: http_types.cmi http_parser_sanity.cmi: http_request.cmi: http_types.cmi http_response.cmi: http_types.cmi http_tcp_server.cmi: http_types.cmi http_threaded_tcp_server.cmi: http_types.cmi: http_user_agent.cmi: http_types.cmi ocaml-http-0.1.6/.gitignore000066400000000000000000000000531340603407200155530ustar00rootroot00000000000000doc *.cma *.cmo *.cmi ocamlinit-stamp META ocaml-http-0.1.6/.ocamlinit000066400000000000000000000001371340603407200155460ustar00rootroot00000000000000#use "topfind";; #require "unix";; #require "pcre";; #require "netstring";; #load "http.cma";; ocaml-http-0.1.6/INSTALL000066400000000000000000000015311340603407200146160ustar00rootroot00000000000000 In order to build ocaml-http you will need: - the ocaml compiler [ http://caml.inria.fr ] - findlib [ http://www.ocaml-programming.de/packages/documentation/findlib/ ] - ocamlnet [ http://sourceforge.net/projects/ocamlnet ] - pcre-ocaml [ http://www.ai.univie.ac.at/~markus/home/ocaml_sources.html ] To build the bytecode library: $ make all To build the nativecode library (only if you have an ocaml native code compiler): $ make opt To install the built stuff in the OCaml standard library directory (as root): # make install To install the built stuff in another directory: $ make install DESTDIR=another_directory To build a debian package of the library (please note that to build a debian package you will also need some additional stuff like debhelper, fakeroot, ...): $ fakeroot debian/rules binary ocaml-http-0.1.6/LICENSE000066400000000000000000000613061340603407200146000ustar00rootroot00000000000000 GNU LIBRARY GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the library GPL. It is numbered 2 because it goes with version 2 of the ordinary GPL.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Library General Public License, applies to some specially designated Free Software Foundation software, and to any other libraries whose authors decide to use it. You can use it for your libraries, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library, or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link a program with the library, you must provide complete object files to the recipients so that they can relink them with the library, after making changes to the library and recompiling it. And you must show them these terms so they know their rights. Our method of protecting your rights has two steps: (1) copyright the library, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the library. Also, for each distributor's protection, we want to make certain that everyone understands that there is no warranty for this free library. If the library is modified by someone else and passed on, we want its recipients to know that what they have is not the original version, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that companies distributing free software will individually obtain patent licenses, thus in effect transforming the program into proprietary software. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License, which was designed for utility programs. This license, the GNU Library General Public License, applies to certain designated libraries. This license is quite different from the ordinary one; be sure to read it in full, and don't assume that anything in it is the same as in the ordinary license. The reason we have a separate public license for some libraries is that they blur the distinction we usually make between modifying or adding to a program and simply using it. Linking a program with a library, without changing the library, is in some sense simply using the library, and is analogous to running a utility program or application program. However, in a textual and legal sense, the linked executable is a combined work, a derivative of the original library, and the ordinary General Public License treats it as such. Because of this blurred distinction, using the ordinary General Public License for libraries did not effectively promote software sharing, because most developers did not use the libraries. We concluded that weaker conditions might promote sharing better. However, unrestricted linking of non-free programs would deprive the users of those programs of all benefit from the free status of the libraries themselves. This Library General Public License is intended to permit developers of non-free programs to use free libraries, while preserving your freedom as a user of such programs to change the free libraries that are incorporated in them. (We have not seen how to achieve this as regards changes in header files, but we have achieved it as regards changes in the actual functions of the Library.) The hope is that this will lead to faster development of free libraries. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, while the latter only works together with the library. Note that it is possible for a library to be covered by the ordinary General Public License rather than by this special one. GNU LIBRARY GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Library General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also compile or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. c) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. d) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Library General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! ocaml-http-0.1.6/META.in000066400000000000000000000004201340603407200146370ustar00rootroot00000000000000description = "OCaml HTTP daemon library" version = "@DISTVERSION@" requires = "unix,pcre,netstring" requires(mt) = "unix,pcre,netstring,threads" archive(byte) = "http.cma" archive(native) = "http.cmxa" archive(mt,byte) = "http_mt.cma" archive(mt,native) = "http_mt.cmxa" ocaml-http-0.1.6/Makefile000066400000000000000000000104061340603407200152260ustar00rootroot00000000000000include Makefile.defs export SHELL=/bin/bash MODULES = \ http_constants \ http_types \ http_parser_sanity \ http_misc \ http_common \ http_tcp_server \ cookie_lexer \ http_parser \ http_message \ http_request \ http_daemon \ http_response \ http_user_agent \ $(NULL) THREADED_SRV = http_threaded_tcp_server MODULES_MT = $(patsubst http_tcp_server, mt/$(THREADED_SRV) http_tcp_server, $(MODULES)) MODULES_NON_MT = $(patsubst http_tcp_server, non_mt/$(THREADED_SRV) http_tcp_server, $(MODULES)) PUBLIC_MODULES = \ http_types \ http_common \ http_message \ http_request \ http_daemon \ http_response \ http_user_agent OCAMLDOC_STUFF = *.mli DOCDIR = doc/html DOTDIR = doc/dot TEXDIR = doc/latex DESTDIR = $(shell $(OCAMLFIND) printconf destdir) all: all_non_mt all_mt opt: opt_non_mt opt_mt all_non_mt: http.cma opt_non_mt: http.cmxa all_mt: http_mt.cma opt_mt: http_mt.cmxa world: all opt doc: all $(DOCDIR)/index.html $(DOTDIR)/ocaml-http.ps $(TEXDIR)/ocaml-http.ps $(OCAMLDOC_STUFF) $(DOCDIR)/index.html: $(OCAMLDOC) -html -d $(DOCDIR) $(OCAMLDOC_STUFF) $(TEXDIR)/ocaml-http.tex: $(OCAMLDOC_STUFF) $(OCAMLDOC) -latex -o $@ $^ $(TEXDIR)/ocaml-http.ps: $(TEXDIR)/ocaml-http.tex cd $(TEXDIR); \ latex ocaml-http; \ latex ocaml-http; \ dvips ocaml-http $(DOTDIR)/ocaml-http.ps: $(DOTDIR)/ocaml-http.dot $(DOT) -Tps $< > $@ $(DOTDIR)/ocaml-http.dot: *.ml *.mli $(OCAMLDOC) -dot -o $(DOTDIR)/ocaml-http.dot *.ml *.mli examples: $(MAKE) -C examples/ examples.opt: $(MAKE) -C examples/ opt include .depend depend: $(OCAMLDEP) *.ml *.mli > .depend %.ml: %.mll $(OCAMLLEX) $< %.cmi: %.mli $(OCAMLC) -c $< %.cmo: %.ml %.cmi $(OCAMLC) -c $< %.cmx: %.ml %.cmi $(OCAMLOPT) -c $< non_mt/$(THREADED_SRV).cmo: non_mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi cp $(THREADED_SRV).{cmi,mli} non_mt/ $(OCAMLC) -c $< non_mt/$(THREADED_SRV).cmx: non_mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi cp $(THREADED_SRV).{cmi,mli} non_mt/ $(OCAMLOPT) -c $< mt/$(THREADED_SRV).cmo: mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi cp $(THREADED_SRV).{cmi,mli} mt/ $(OCAMLC) $(THREADS_FLAGS) -c $< mt/$(THREADED_SRV).cmx: mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi cp $(THREADED_SRV).{cmi,mli} mt/ $(OCAMLOPT) $(THREADS_FLAGS) -c $< http.cma: $(patsubst %,%.cmo,$(MODULES_NON_MT)) $(OCAMLC) -a -o $@ $^ http.cmxa: $(patsubst %,%.cmx,$(MODULES_NON_MT)) $(OCAMLOPT) -a -o $@ $^ http_mt.cma: $(patsubst %,%.cmo,$(MODULES_MT)) $(OCAMLC) -a -o $@ $^ http_mt.cmxa: $(patsubst %,%.cmx,$(MODULES_MT)) $(OCAMLOPT) -a -o $@ $^ meta: META META: META.in cat META.in | sed -e 's/@DISTVERSION@/$(DISTVERSION)/' > META clean: $(MAKE) -C examples/ clean for d in . mt non_mt; do \ rm -f $$d/*.cm[ioax] $$d/*.cmxa $$d/*.[ao] $$d/test{,.opt}; \ done rm -f {mt,non_mt}/$(THREADED_SRV).mli docclean: -rm -f \ $(DOCDIR)/*.html $(DOCDIR)/*.css \ $(DOTDIR)/*.dot $(DOTDIR)/*.ps \ $(TEXDIR)/*.{dvi,ps,ps.gz,pdf,aux,log,out,toc,tmp,haux,sty,tex} distclean: clean $(MAKE) -C examples/ distclean rm -f META dist: distreal distrm distdoc: all doc if [ -d $(DISTDIR) ]; then rm -rf $(DISTDIR); else true; fi mkdir -p $(DISTDIR)/doc/ cp -r doc/html/ $(DISTDIR)/doc/ cp doc/dot/ocaml-http.ps $(DISTDIR)/doc/modules.ps cp doc/latex/ocaml-http.ps $(DISTDIR)/doc/ distreal: distdoc distclean depend for f in \ $(patsubst %, %.ml, $(MODULES)) \ $(patsubst %, %.mli, $(MODULES) $(THREADED_SRV)) \ mt/ non_mt/ $(EXTRA_DIST) examples/ debian/; \ do \ cp -r $$f $(DISTDIR)/; \ done -find $(DISTDIR)/ -type d -name .svn -exec rm -rf {} \; tar cvzf $(DISTDIR).tar.gz $(DISTDIR)/ distrm: rm -rf $(DISTDIR)/ deb: docclean distreal (cd $(DISTDIR)/ && debuild) rm -rf $(DISTDIR)/ install: META $(OCAMLFIND) install -destdir $(DESTDIR) $(PKGNAME) \ $(patsubst %, %.mli, $(PUBLIC_MODULES)) \ $(patsubst %, %.cmi, $(PUBLIC_MODULES)) \ $(wildcard *.cma *.cmxa *.a) META .PHONY: \ all opt world all_non_mt all_mt opt_non_mt opt_mt \ examples examples.opt depend clean distclean dist \ install meta doc deb distreal distrm VERSION = 0.1.6 release: git tag -a v$(VERSION) -m "Version $(VERSION)." git push origin v$(VERSION) opam publish #opam publish prepare $(NAME_VERSION) $(ARCHIVE) #cp -t $(NAME_VERSION) descr #grep -Ev '^(name|version):' opam >$(NAME_VERSION)/opam #opam publish submit $(NAME_VERSION) #rm -rf $(NAME_VERSION) ocaml-http-0.1.6/Makefile.defs000066400000000000000000000014231340603407200161450ustar00rootroot00000000000000PKGNAME = http DISTVERSION = $(shell dpkg-parsechangelog | egrep '^Version: ' | sed 's/^Version: //' | sed 's/-.*//') DEBUG_FLAGS = REQUIRES = unix str pcre netstring COMMON_FLAGS = $(DEBUG_FLAGS) -package "$(REQUIRES)" THREADS_FLAGS = -package threads -thread OCAMLFIND = ocamlfind OCAMLC = $(OCAMLFIND) ocamlc $(COMMON_FLAGS) OCAMLOPT = $(OCAMLFIND) ocamlopt $(COMMON_FLAGS) OCAMLDEP = $(OCAMLFIND) ocamldep $(COMMON_FLAGS) OCAMLLEX = ocamllex OCAMLDOC := \ ocamldoc -stars \ $(shell $(OCAMLFIND) query -i-format unix) \ $(shell $(OCAMLFIND) query -i-format pcre) \ $(shell $(OCAMLFIND) query -i-format netstring) DOT = dot DISTNAME = ocaml-http DISTDIR = $(DISTNAME)-$(DISTVERSION) EXTRA_DIST = \ INSTALL LICENSE README META.in Makefile Makefile.defs \ .depend ocaml-http-0.1.6/README.md000066400000000000000000000041361340603407200150500ustar00rootroot00000000000000OCaml HTTP ========== do it yourself (OCaml) HTTP daemon ---------------------------------- OCaml HTTP is an OCaml library freely inspired from Perl's HTTP::Daemon module that permits you to write simple HTTP daemons in OCaml. The main API let you define a HTTP daemon specification, which contains, among other parameters, a callback function that is invoked each time a request is received. The callback function will be invoked with an instance of an object representing the received HTTP request and an out_channel connected to the remote HTTP client socket. Then you can start your HTTP daemon invoking the main function passing your specification. Each time a client connect to the TCP port bound by your daemon, OCaml HTTP will parse the request and instantiate the request object. If all goes well your callback will be invoked, otherwise appropriate error messages will be sent back to the client without disturbing your callback. You can use a lot of facility functions in your callback that permits you to send easily headers, error responses, file, or abstract HTTP response objects. Otherwise you can also choose the 'hard way' and send data directly to the out_channel (expecially useful for sending data incrementally to the client). You can also mix the two approaches. Daemon specifications are used also to specify other parameters governing daemon behaviour like: TCP port and address to bind, way of handling incoming requests (handle all of them in a single process, fork a new process or spawn a new thread for each incoming request), timeout, authentication requirements (username and password for HTTP basic authentication). OCaml HTTP contains also a tiny implementation of a HTTP client which can be used to retrieve resources via GET HTTP method and to iter on them (useful for huge resources which can't be kept in memory). OCaml HTTP is freely distributed under the GNU Library General Public License (GPL) and is available here for download: official Debian packages are available: libhttp-ocaml-dev To build OCaml HTTP from sources you will need: * the OCaml compiler * findlib * ocamlnet * pcre-ocaml ocaml-http-0.1.6/cookie_lexer.mli000066400000000000000000000017111340603407200167400ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2010> Stefano Zacchiroli <2010> Arlen Cuss This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type cookie_token = [ `SEP | `ASSIGNMENT of string * string | `EOF ] val token : Lexing.lexbuf -> cookie_token ocaml-http-0.1.6/cookie_lexer.mll000066400000000000000000000032371340603407200167500ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2010> Stefano Zacchiroli <2010> Arlen Cuss This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { let quoted_RE = Pcre.regexp "\\\\\"" type cookie_token = [ `SEP (* cookie separator (i.e. ";") *) | `ASSIGNMENT of string * string (* assignment x=y *) | `EOF (* end of file *) ] } rule token = parse | [' ' '\t' '\n' '\r'] { token lexbuf } | ([^ ' ' '\t' '\n' '\r' '' ''-'' '\'' '=' ';']+ as name) '=' ([^ '\n' '\r' '' ''-'' ';']* as value) { let val_len = String.length value in let value = if val_len>2 && (value.[0]='"' && value.[val_len-1]='"') then let without_quotes = String.sub value 1 (val_len - 2) in Pcre.replace ~rex:quoted_RE ~templ:"\"" without_quotes else value in `ASSIGNMENT (name,value) } | ';' { `SEP } | eof { `EOF } ocaml-http-0.1.6/debian/000077500000000000000000000000001340603407200150075ustar00rootroot00000000000000ocaml-http-0.1.6/debian/.gitignore000066400000000000000000000000571340603407200170010ustar00rootroot00000000000000dirs files libhttp-ocaml-dev* stamp-makefile-* ocaml-http-0.1.6/debian/changelog000066400000000000000000000231751340603407200166710ustar00rootroot00000000000000ocaml-http (0.1.6-1) unstable; urgency=low * ported to ocaml > 3.10 -- Claudio Sacerdoti Coen Mon, 17 Dec 2018 21:47:55 +1100 ocaml-http (0.1.5-1) unstable; urgency=low * better cookie parsing (as seen in real life!) * auto-close connections by default * don't die on empty query strings -- Arlen Cuss Fri, 31 Dec 2010 12:58:55 +1100 ocaml-http (0.1.4-3) unstable; urgency=low * rebuild with OCaml 3.11 * debian/control - refresh build-dependencies for the transition - add Vcs-* fields pointing to HELM's repository and browser - add missing ${misc:Depends}, thanks lintian! - set package section to "ocaml" - add Homepage field * debian/rules: use ocaml.mk as a CDBS "rules" snippet * debian/*.in: use more abstract substitution variable to avoid hard-coding assumption on stdlib location -- Stefano Zacchiroli Thu, 19 Mar 2009 11:06:12 +0100 ocaml-http (0.1.4-2) unstable; urgency=low * change how the ocamldoc API reference is generated: no longer use upstream Makefile, but rather rely on CDBS * debian/control - remove build-dep on texlive stuff and graphviz since now we only ship HTML version of the API reference * debian/docs, debian/doc-base - file removed, the latter will be now automatically generated, the former would only contain README and CDBS is smart enough to guess it -- Stefano Zacchiroli Sun, 09 Sep 2007 12:34:07 +0200 ocaml-http (0.1.4-1) experimental; urgency=low * rebuild against OCaml 3.10 and ocamlnet 2.2 * send internally generated headers as lowercase strings, for consistency with headers generated via setXXX methods * add preliminary support for cookies (new "cookies" method added to an http_request, cookies are parsed upon request creation if a "Cookie:" header has been received) * debian/rules - use ocaml.mk CDBS class * debian/rules - build ocamldoc documentation at package build time * debian/control - add build-dep on camlp4, which is now in a separate package - add build-dep for doc generation: graphviz, texlive-latex-recommended, texlive-base-bin, texlive-latex-extra * debian/svn-deblayout - add repository layout information - bump debhelper dep and compatibility level to 5 -- Stefano Zacchiroli Mon, 16 Jul 2007 16:19:48 +0200 ocaml-http (0.1.3-2) unstable; urgency=low * debian/control.in - file removed, no longer needed * debian/control - bumped dependencies on pcre-ocaml and ocamlnet * debian/rules - binNMU safe substitution of variables in .in files * debian/dirs - file removed, will be generated at build time -- Stefano Zacchiroli Fri, 15 Sep 2006 00:29:56 +0200 ocaml-http (0.1.3-1) unstable; urgency=low * force bash as SHELL in Makefile, since we rely on bashisms (closes: bug#381915) * removed Http_daemon.{start,start'}, they have been deprecated a while ago in favour of Http_daemon.main * added 'auto_close' to daemon specifications. When set to true (defaults to false), makes ocaml-http close every connection with client just after having executed a callback, no matter if that callback succeeds or fails with an exception -- Stefano Zacchiroli Sun, 20 Aug 2006 18:07:41 +0200 ocaml-http (0.1.2-4) unstable; urgency=low * Rebuilt against ocaml 3.09.2, bumped deps accordingly. * debian/control - Bumped Standards-Version to 3.7.2 (no changes needed) -- Stefano Zacchiroli Wed, 17 May 2006 05:18:32 +0000 ocaml-http (0.1.2-3) unstable; urgency=low * Rebuilt against OCaml 3.09.1, bumped deps accordingly. -- Stefano Zacchiroli Sun, 8 Jan 2006 13:13:07 +0100 ocaml-http (0.1.2-2) unstable; urgency=low * rebuilt with ocaml 3.09 * debian/* - no more hardcoding of ocaml abi version anywhere * debian/rules - use cdbs -- Stefano Zacchiroli Sat, 26 Nov 2005 20:28:26 +0100 ocaml-http (0.1.2-1) unstable; urgency=low * avoid exceptions for closing connection twice during finaliztion of connection objects (thanks to Eric Strokes for the patch) -- Stefano Zacchiroli Wed, 14 Sep 2005 18:03:40 +0200 ocaml-http (0.1.1-1) unstable; urgency=low * added ?default parameter to "param" method * fixed bug in response status line parsing * integrated patch for HTTP/1.1 persistent connections from Eric Cooper : - added support for persistent connections to http_daemon.ml: server now loops until End_of_file (or any exception) occurs when trying to parse the next request * debian/control - bumped pcre and ocamlnet dependencies - bumped standards-version to 3.6.2 -- Stefano Zacchiroli Wed, 16 Mar 2005 09:24:07 +0100 ocaml-http (0.1.0-2) unstable; urgency=low * rebuilt against ocaml 3.08.3 -- Stefano Zacchiroli Tue, 29 Mar 2005 11:39:24 +0200 ocaml-http (0.1.0-1) unstable; urgency=low * first debian official package -- Stefano Zacchiroli Tue, 8 Feb 2005 22:45:54 +0100 ocaml-http (0.1.0) unstable; urgency=low * added "daemon specifications": a unified way of specifying daemons behaviour including old parameters of Http_daemon.start together with authentication requirements and exception handling * added new way of building daemons starting from specifications, old ways (e.g. Http_daemon.start) are now deprecated * added sigpipe handling to avoid daemons dying for uncaught signals * added exception handler (as part of a daemon specification), it can be used to ensure that some code is execute before a process/thread die for uncaught exception (e.g. unlocking a global mutex) * added authentication requirements (as part of a daemon specification): an handy way to specify required user name and password for HTTP basic authentication * added head_callback to Http_user_agent in order to have access to response status and headers in HTTP requests * changed license from GPL to LGPL * improved ocamldoc documentation and debian packaging -- Stefano Zacchiroli Thu, 3 Feb 2005 23:08:14 +0100 ocaml-http (0.0.10) unstable; urgency=low * renamed Http_client module to Http_user_agent to avoid compatibility issues with Netclient. Renamed that module functions removing "http_" prefix (e.g., summarizing, Http_client.http_get -> Http_user_agent.get) * ported to ocaml 3.08 * debian/control - bumped standards version to 3.6.1.1 - changed deps to ocaml 3.08 and -nox -- Stefano Zacchiroli Thu, 5 Aug 2004 15:06:49 +0200 ocaml-http (0.0.9) unstable; urgency=low * Added support for HTTP Basic authentication * Restyled Http_daemon API so that correct invocations of them are statically typechecked * Added support for HEAD requests to Http_client * ~addr parameter now support not only ip addresses but also hostnames * debian/control - bumped Standards-Version to 3.6.1.0 * debian/rules - moved debhelper compatibility level to debian/compat -- Stefano Zacchiroli Tue, 16 Dec 2003 18:01:41 +0100 ocaml-http (0.0.8) unstable; urgency=low * Added support for "ancient" HTTP requests which specify no HTTP version - 'version' method on message now has type 'version option' * Http_daemon now use debugging prints from Http_common like other modules * Added debugging print of requests parse error * Shutdown server socket on abnormal exit (actually: uncaught exceptions or SIGTERM received) * Added a lot of ocamldoc documentation * Added minimal HTTP 1.0/1.1 client support -- Stefano Zacchiroli Fri, 10 Jan 2003 10:36:53 +0100 ocaml-http (0.0.7) unstable; urgency=low * Added support for POST requests * Implemented a commont 'message' class from which 'request' and 'response' inherit * Changed constructor of 'request' objects, requests are now buildable directly (and only) from an input channel * Added client IP address information to Http_request.request class * Added OO daemon interfaces ("daemon" and "connection" classes) * Use Pcre to perform sanity test on headers instead of home made parsing * Callback functions can raise Http_types.Quit to have main daemon quit * Case-insensitive handling of header names -- Stefano Zacchiroli Wed, 25 Dec 2002 16:22:31 +0100 ocaml-http (0.0.6) unstable; urgency=low * Ship multithreaded and non multithreaded cm{x,}aS * Added support for multiple binding of the same parameter in request objects (new method 'paramAll') * Added support for 'empty' bindings in query arguments (e.g. "/foo?b=" or "/foo?b") * Added some sanity checks * Bumped Standards-Version to 3.5.8 * Use versioned dependencies lib{pcre,ocamlnet}-ocaml-dev- * Added 'Provides libhttp-ocaml-dev-' * Removed GPL from debian/copyright, added reference to /usr/share/common-licenses/GPL -- Stefano Zacchiroli Mon, 25 Nov 2002 11:04:49 +0100 ocaml-http (0.0.5) unstable; urgency=low * Fixed bug for HTTP encoded GET parameters which contain '?' or '&' characters * Added support for chdir in a given document root before starting * Added support for multi threaded daemons * Added a generic 'Http_daemon.respond' function * Added 'toString' method to response objects -- Stefano Zacchiroli Fri, 22 Nov 2002 11:29:37 +0100 ocaml-http (0.0.3) unstable; urgency=low * First release. -- Stefano Zacchiroli Sun, 17 Nov 2002 17:41:41 +0100 ocaml-http-0.1.6/debian/compat000066400000000000000000000000021340603407200162050ustar00rootroot000000000000005 ocaml-http-0.1.6/debian/control000066400000000000000000000024011340603407200164070ustar00rootroot00000000000000Source: ocaml-http Section: ocaml Priority: optional Maintainer: Arlen Cuss Build-Depends: debhelper (>> 5.0.0), cdbs, dh-ocaml, ocaml-nox, camlp4, ocaml-findlib, libpcre-ocaml-dev, libocamlnet-ocaml-dev (>= 2.2.9-6) Standards-Version: 3.7.2 Vcs-Git: git://ssh.ocamlcore.org/gitroot/ocaml-http/ocaml-http.git Vcs-Browser: http://git.ocamlcore.org/cgi-bin/gitweb.cgi?p=ocaml-http/ocaml-http.git;a=summary Homepage: http://ocaml-http.forge.ocamlcore.org/ Package: libhttp-ocaml-dev Architecture: any Depends: ocaml-nox-${F:OCamlABI}, libpcre-ocaml-dev, libocamlnet-ocaml-dev, ${misc:Depends} Description: OCaml library for writing HTTP servers OCaml HTTP is a library for the Objective Caml programming language, used to build simple HTTP servers, largely inspired by Perl's HTTP::Daemon module. . In order to implement an HTTP server, the programmer has to provide a daemon specification which contains, among other parameters, a callback function invoked by OCaml HTTP on well-formed HTTP requests received. HTTP responses can be sent over an out_channel connected with client socket, accessible from the callback. . The library contains also facility functions that helps in creating well-formed HTTP responses and a tiny HTTP client. ocaml-http-0.1.6/debian/copyright000066400000000000000000000007411340603407200167440ustar00rootroot00000000000000 Authors: Stefano Zacchiroli Arlen Cuss Copyright: OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2010> Stefano Zacchiroli Copyright (C) <2010> Arlen Cuss OCaml HTTP is distributed under the term of the GNU Library General Public License version 2, on Debian systems you can find a copy of the license in: /usr/share/common-licenses/LGPL-2 ocaml-http-0.1.6/debian/dirs.in000066400000000000000000000000211340603407200162710ustar00rootroot00000000000000@OCamlStdlibDir@ ocaml-http-0.1.6/debian/examples000066400000000000000000000000161340603407200165450ustar00rootroot00000000000000examples/*.ml ocaml-http-0.1.6/debian/rules000077500000000000000000000006371340603407200160750ustar00rootroot00000000000000#!/usr/bin/make -f include /usr/share/cdbs/1/class/makefile.mk include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/rules/ocaml.mk PKGNAME = libhttp-ocaml-dev OCAML_OCAMLDOC_PACKAGES = $(OCAML_LIBDEV_PACKAGES) DEB_MAKE_BUILD_TARGET = all ifeq ($(OCAML_HAVE_OCAMLOPT),yes) DEB_MAKE_BUILD_TARGET += opt endif DEB_MAKE_INSTALL_TARGET = install DESTDIR=$(CURDIR)/debian/$(PKGNAME)$(OCAML_STDLIB_DIR) ocaml-http-0.1.6/debian/source/000077500000000000000000000000001340603407200163075ustar00rootroot00000000000000ocaml-http-0.1.6/debian/source/format000066400000000000000000000000141340603407200175150ustar00rootroot000000000000003.0 (quilt) ocaml-http-0.1.6/examples/000077500000000000000000000000001340603407200154035ustar00rootroot00000000000000ocaml-http-0.1.6/examples/Makefile000066400000000000000000000022411340603407200170420ustar00rootroot00000000000000include ../Makefile.defs OBJS_NON_MT = ../http.cma OBJS_NON_MT_OPT = ../http.cmxa OBJS_MT = ../http_mt.cma OBJS_MT_OPT = ../http_mt.cmxa EXAMPLES_FLAGS = -I .. -linkpkg EXAMPLES := \ always_ok_daemon.ml \ basic_auth.ml \ chdir.ml \ client_address.ml \ damned_recursion.ml \ dump_args.ml \ highlander.ml \ oo_daemon.ml \ threads.ml \ timeout.ml \ webfsd.ml EXAMPLES := $(patsubst %.ml,%,$(EXAMPLES)) all: $(EXAMPLES) opt: $(patsubst %,%.opt,$(EXAMPLES)) %: %.ml $(OBJS_NON_MT) $(OCAMLC) $(EXAMPLES_FLAGS) $(OBJS_NON_MT) -o $@ $< %.opt: %.ml $(OBJS_NON_MT_OPT) $(OCAMLOPT) $(EXAMPLES_FLAGS) $(OBJS_NON_MT_OPT) -o $@ $< threads: threads.ml $(OBJS_MT) $(OCAMLC) $(EXAMPLES_FLAGS) $(OBJS_MT) $(THREADS_FLAGS) -o $@ $< threads.opt: threads.ml $(OBJS_MT_OPT) $(OCAMLOPT) $(EXAMPLES_FLAGS) $(OBJS_MT_OPT) $(THREADS_FLAGS) -o $@ $< damned_recursion: damned_recursion.ml $(OBJS_MT) $(OCAMLC) $(EXAMPLES_FLAGS) $(OBJS_MT) $(THREADS_FLAGS) -o $@ $< damned_recursion.opt: damned_recursion.ml $(OBJS_MT_OPT) $(OCAMLOPT) $(EXAMPLES_FLAGS) $(OBJS_MT_OPT) $(THREADS_FLAGS) -o $@ $< distclean: clean clean: -rm -f *.cm[ioax] *.o $(EXAMPLES) $(patsubst %,%.opt,$(EXAMPLES)) ocaml-http-0.1.6/examples/always_ok_daemon.ml000066400000000000000000000021221340603407200212460ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types (* start an http daemon that alway respond with a 200 status code and an empty content *) let spec = { Http_daemon.default_spec with callback = (fun _ outchan -> Http_daemon.respond outchan); port = 9999; } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/basic_auth.ml000066400000000000000000000031721340603407200200420ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types (* the easy way: specify authentication requirements within a daemon_spec *) let spec = { Http_daemon.default_spec with (* requires basic authentication, username "foo", password "bar" *) auth = Some ("my realm", `Basic ("foo", "bar")); callback = (fun _ outchan -> Http_daemon.respond ~body:"secret" outchan); port = 9999; } (* (* the hard^Wother way: manual handling of authorization *) let callback req outchan = match req#authorization with | Some (`Basic (username, password)) when username = "foo" && password = "bar" -> Http_daemon.respond ~code:(`Code 200) ~body:"secret" outchan | _ -> raise (Unauthorized "my secret site") let spec = { Http_daemon.default_spec with callback = callback; port = 9999; } *) let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/chdir.ml000066400000000000000000000021151340603407200170250ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_types let spec = { Http_daemon.default_spec with callback = (fun _ outchan -> Http_daemon.respond ~body:(sprintf "%s\n" (Sys.getcwd ())) outchan); port = 9999; root_dir = Some "/etc"; } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/client_address.ml000066400000000000000000000023431340603407200207220ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_types let callback req outchan = let body = sprintf "Hi, this is your personal assistant, you are connected from %s:%d\n" req#clientAddr req#clientPort in let res = new Http_response.response ~body () in Http_daemon.respond_with res outchan let spec = { Http_daemon.default_spec with callback = callback; port = 9999 } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/damned_recursion.ml000066400000000000000000000027031340603407200212600ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_types let port = 9999 let callback (req: Http_types.request) outchan = let i = int_of_string (req#param "x") in let body = match i with | 0 -> "0" | x when x > 0 -> let data = Http_user_agent.get (sprintf "http://127.0.0.1:%d/foo?x=%d" port (x - 1)) in sprintf "%s %d" data x | _ -> assert false in Http_daemon.respond ~code:(`Code 200) ~body outchan; close_out outchan (* Http_user_agent relies on EOF, not Content-Length *) let spec = { Http_daemon.default_spec with callback = callback; port = port; mode = `Thread; } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/dump_args.ml000066400000000000000000000037421340603407200177240ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2007> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_types let callback req outchan = let str = (sprintf "request path = %s\n" req#path) ^ (sprintf "request GET params = %s\n" (String.concat ";" (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_GET))) ^ (sprintf "request POST params = %s\n" (String.concat ";" (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_POST))) ^ (sprintf "request ALL params = %s\n" (String.concat ";" (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params))) ^ (sprintf "cookies = %s\n" (match req#cookies with | None -> "NO COOKIES " ^ (if req#hasHeader ~name:"cookie" then "('Cookie:' header was '" ^ req#header ~name:"cookie" ^ "')" else "(No 'Cookie:' header received)") | Some cookies -> (String.concat ";" (List.map (fun (n,v) -> String.concat "=" [n;v]) cookies)))) ^ (sprintf "request BODY = '%s'\n\n" req#body) in Http_daemon.respond ~code:(`Code 200) ~body: str outchan let spec = { Http_daemon.default_spec with callback = callback; port = 9999; } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/highlander.ml000066400000000000000000000023061340603407200200430ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* test for fast rebinding of the tcp port *) open Printf open Http_types let spec = { Http_daemon.default_spec with callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan); port = 9999; mode = `Single; } let _ = Sys.catch_break true; while true do try Http_daemon.main spec; with Sys.Break -> prerr_endline "RESURRECTION!!!!" done ocaml-http-0.1.6/examples/oo_daemon.ml000066400000000000000000000027041340603407200177000ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_daemon open Http_response (* the simple way *) let d = new daemon ~addr:"127.0.0.1" ~port:9999 () let _ = while true do let (req, conn) = d#getRequest in (* wait for valid request *) conn#respond_with (new response ~body:"foo\n" ()); conn#close done (* (* the hard^Wother way *) let d = new daemon ~addr:"127.0.0.1" ~port:9999 () in let _ = while true do let conn = d#accept in (* wait for client connection *) (match conn#getRequest with | None -> () (* invalid request received *) | Some req -> conn#respond_with (new response ~body:"foo\n" ())); conn#close (* close socket *) done *) ocaml-http-0.1.6/examples/threads.ml000066400000000000000000000041001340603407200173620ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types let m = Mutex.create () let m_locked = ref true let critical f = Mutex.lock m; m_locked := true; Lazy.force f; m_locked := false; Mutex.unlock m (** ocaml's Thread.unlock suspend the invoking process if the mutex is already * unlocked, therefore we unlock it only if we know that it's currently locked *) let safe_unlock _ _ = if !m_locked then Mutex.unlock m let i = ref 10 let dump_i outchan = Http_daemon.respond ~body:(Printf.sprintf "i = %d\n" !i) outchan let callback req outchan = match req#path with | "/incr" -> critical (lazy (incr i; dump_i outchan; Unix.sleep 5)) | "/decr" -> critical (lazy (decr i; dump_i outchan; Unix.sleep 5)) | "/get" -> critical (lazy (dump_i outchan)) | bad_request -> Http_daemon.respond_error outchan let spec = { Http_daemon.default_spec with port = 9999; mode = `Thread; callback = callback; exn_handler = Some safe_unlock; (** ocaml-http's default exn_handler is Pervasives.ignore. This means * that threads holding the "m" mutex above may die without unlocking it. * Using safe_unlock as an exception handler we ensure that "m" mutex is * unlocked in case of exceptions (e.g. SIGPIPE) *) } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/timeout.ml000066400000000000000000000020061340603407200174210ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types let spec = { Http_daemon.default_spec with callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan); timeout = Some 10; } let _ = Http_daemon.main spec ocaml-http-0.1.6/examples/webfsd.ml000066400000000000000000000027751340603407200172220ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2004> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types let def_port = 80 let def_addr = "0.0.0.0" let def_root = Sys.getcwd () let port = ref def_port let addr = ref def_addr let root = ref def_root let argspec = [ "-p", Arg.Int (fun p -> port := p), "TCP port on which listen, default: " ^ string_of_int !port; "-a", Arg.String (fun a -> addr := a), "IP address on which listen, default: " ^ !addr; "-r", Arg.String (fun r -> root := r), "DocumentRoot, default: current working directory"; ] let _ = Arg.parse argspec (fun _ -> ()) ""; let spec = { Http_daemon.default_spec with address = !addr; port = !port; root_dir = Some !root } in Http_daemon.Trivial.main spec ocaml-http-0.1.6/http_common.ml000066400000000000000000000143441340603407200164540ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types;; open Printf;; let debug = ref false let debug_print s = if !debug then prerr_endline (sprintf "[OCaml HTTP] DEBUG: %s" s) let http_version = Http_constants.version let server_string = Http_constants.server_string let string_of_version = function | `HTTP_1_0 -> "HTTP/1.0" | `HTTP_1_1 -> "HTTP/1.1" let version_of_string = function | "HTTP/1.0" -> `HTTP_1_0 | "HTTP/1.1" -> `HTTP_1_1 | invalid_version -> raise (Invalid_HTTP_version invalid_version) let string_of_method = function | `GET -> "GET" | `POST -> "POST" | `HEAD -> "HEAD" | `PUT -> "PUT" | `DELETE -> "DELETE" | `OPTIONS -> "OPTIONS" | `TRACE -> "TRACE" let method_of_string = function | "GET" -> `GET | "POST" -> `POST | "HEAD" -> `HEAD | "PUT" -> `PUT | "DELETE" -> `DELETE | "OPTIONS" -> `OPTIONS | "TRACE" -> `TRACE | invalid_method -> raise (Invalid_HTTP_method invalid_method) let string_of_request req = let buffer = Buffer.create 1024 in Buffer.add_string buffer (string_of_method req#meth); Buffer.add_char buffer ' '; Buffer.add_string buffer req#uri; Buffer.add_char buffer ' '; (match req#version with | Some v -> Buffer.add_string buffer (string_of_version v) | None -> ()); Buffer.add_string buffer "\r\n"; List.iter (fun (param_name, param_value) -> Buffer.add_string buffer param_name; Buffer.add_string buffer ": "; Buffer.add_string buffer param_value; Buffer.add_string buffer "\r\n"; ) req#headers; Buffer.add_string buffer "\r\n"; Buffer.add_string buffer req#body; Buffer.contents buffer let status_of_code = function | 100 -> `Informational `Continue | 101 -> `Informational `Switching_protocols | 200 -> `Success `OK | 201 -> `Success `Created | 202 -> `Success `Accepted | 203 -> `Success `Non_authoritative_information | 204 -> `Success `No_content | 205 -> `Success `Reset_content | 206 -> `Success `Partial_content | 300 -> `Redirection `Multiple_choices | 301 -> `Redirection `Moved_permanently | 302 -> `Redirection `Found | 303 -> `Redirection `See_other | 304 -> `Redirection `Not_modified | 305 -> `Redirection `Use_proxy | 307 -> `Redirection `Temporary_redirect | 400 -> `Client_error `Bad_request | 401 -> `Client_error `Unauthorized | 402 -> `Client_error `Payment_required | 403 -> `Client_error `Forbidden | 404 -> `Client_error `Not_found | 405 -> `Client_error `Method_not_allowed | 406 -> `Client_error `Not_acceptable | 407 -> `Client_error `Proxy_authentication_required | 408 -> `Client_error `Request_time_out | 409 -> `Client_error `Conflict | 410 -> `Client_error `Gone | 411 -> `Client_error `Length_required | 412 -> `Client_error `Precondition_failed | 413 -> `Client_error `Request_entity_too_large | 414 -> `Client_error `Request_URI_too_large | 415 -> `Client_error `Unsupported_media_type | 416 -> `Client_error `Requested_range_not_satisfiable | 417 -> `Client_error `Expectation_failed | 500 -> `Server_error `Internal_server_error | 501 -> `Server_error `Not_implemented | 502 -> `Server_error `Bad_gateway | 503 -> `Server_error `Service_unavailable | 504 -> `Server_error `Gateway_time_out | 505 -> `Server_error `HTTP_version_not_supported | invalid_code -> raise (Invalid_code invalid_code) let code_of_status = function | `Informational `Continue -> 100 | `Informational `Switching_protocols -> 101 | `Success `OK -> 200 | `Success `Created -> 201 | `Success `Accepted -> 202 | `Success `Non_authoritative_information -> 203 | `Success `No_content -> 204 | `Success `Reset_content -> 205 | `Success `Partial_content -> 206 | `Redirection `Multiple_choices -> 300 | `Redirection `Moved_permanently -> 301 | `Redirection `Found -> 302 | `Redirection `See_other -> 303 | `Redirection `Not_modified -> 304 | `Redirection `Use_proxy -> 305 | `Redirection `Temporary_redirect -> 307 | `Client_error `Bad_request -> 400 | `Client_error `Unauthorized -> 401 | `Client_error `Payment_required -> 402 | `Client_error `Forbidden -> 403 | `Client_error `Not_found -> 404 | `Client_error `Method_not_allowed -> 405 | `Client_error `Not_acceptable -> 406 | `Client_error `Proxy_authentication_required -> 407 | `Client_error `Request_time_out -> 408 | `Client_error `Conflict -> 409 | `Client_error `Gone -> 410 | `Client_error `Length_required -> 411 | `Client_error `Precondition_failed -> 412 | `Client_error `Request_entity_too_large -> 413 | `Client_error `Request_URI_too_large -> 414 | `Client_error `Unsupported_media_type -> 415 | `Client_error `Requested_range_not_satisfiable -> 416 | `Client_error `Expectation_failed -> 417 | `Server_error `Internal_server_error -> 500 | `Server_error `Not_implemented -> 501 | `Server_error `Bad_gateway -> 502 | `Server_error `Service_unavailable -> 503 | `Server_error `Gateway_time_out -> 504 | `Server_error `HTTP_version_not_supported -> 505 let is_informational code = match status_of_code code with | `Informational _ -> true | _ -> false let is_success code = match status_of_code code with | `Success _ -> true | _ -> false let is_redirection code = match status_of_code code with | `Redirection _ -> true | _ -> false let is_client_error code = match status_of_code code with | `Client_error _ -> true | _ -> false let is_server_error code = match status_of_code code with | `Server_error _ -> true | _ -> false let is_error code = is_client_error code || is_server_error code ocaml-http-0.1.6/http_common.mli000066400000000000000000000052401340603407200166200ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Common functionalities shared by other OCaml HTTP modules *) open Http_types;; (** whether debugging messages are enabled or not, can be changed at runtime *) val debug: bool ref (** print a string on stderr only if debugging is enabled *) val debug_print: string -> unit (** see {!Http_constants.version} *) val http_version: version (** see {!Http_constants.server_string} *) val server_string: string (** pretty print an HTTP version *) val string_of_version: version -> string (** parse an HTTP version from a string @raise Invalid_HTTP_version if given string doesn't represent a supported HTTP version *) val version_of_string: string -> version (** pretty print an HTTP method *) val string_of_method: meth -> string (** parse an HTTP method from a string @raise Invalid_HTTP_method if given string doesn't represent a supported method *) val method_of_string: string -> meth (** pretty print an HTTP request *) val string_of_request: Http_types.request -> string (** converts an integer HTTP status to the corresponding status value @raise Invalid_code if given integer isn't a valid HTTP status code *) val status_of_code: int -> status (** converts an HTTP status to the corresponding integer value *) val code_of_status: [< status] -> int (** @return true on "informational" status codes, false elsewhere *) val is_informational: int -> bool (** @return true on "success" status codes, false elsewhere *) val is_success: int -> bool (** @return true on "redirection" status codes, false elsewhere *) val is_redirection: int -> bool (** @return true on "client error" status codes, false elsewhere *) val is_client_error: int -> bool (** @return true on "server error" status codes, false elsewhere *) val is_server_error: int -> bool (** @return true on "client error" and "server error" status code, false elsewhere *) val is_error: int -> bool ocaml-http-0.1.6/http_constants.ml000066400000000000000000000022171340603407200171740ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let version = `HTTP_1_1 ;; let server_string = "OCaml HTTP Daemon" ;; let crlf = "\r\n" ;; let default_addr = "0.0.0.0" let default_auth = None let default_auto_close = true let default_callback = fun _ _ -> () let default_mode = `Fork let default_port = 80 let default_root_dir = None let default_exn_handler = Some (fun exn outchan -> ()) let default_timeout = Some 300 ocaml-http-0.1.6/http_constants.mli000066400000000000000000000026001340603407200173410ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Constants *) (** default HTTP version *) val version: Http_types.version (** string returned as value of "Server:" response header *) val server_string: string (** "\r\n" string *) val crlf: string (** {2 daemon default values} *) val default_addr: string val default_auth: (string * Http_types.auth_info) option val default_auto_close: bool val default_callback: Http_types.request -> out_channel -> unit val default_mode: Http_types.daemon_mode val default_port: int val default_root_dir: string option val default_exn_handler: (exn -> out_channel -> unit) option val default_timeout: int option ocaml-http-0.1.6/http_daemon.ml000066400000000000000000000402331340603407200164230ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_common open Http_types open Http_constants open Http_parser exception Http_daemon_failure of string (** send raw data on outchan, flushing it afterwards *) let send_raw ~data outchan = output_string outchan data; flush outchan let send_CRLF = send_raw ~data:crlf let send_header ~header ~value = let header = String.lowercase_ascii header in Http_parser_sanity.heal_header (header, value); send_raw ~data:(header ^ ": " ^ value ^ crlf) let send_headers ~headers outchan = List.iter (fun (header, value) -> send_header ~header ~value outchan) headers (** internal: low level for send_status_line *) let send_status_line' ~version code = let status_line = String.concat " " [ string_of_version version; string_of_int code; Http_misc.reason_phrase_of_code code ] in send_raw ~data:(status_line ^ crlf) let int_of_code = function | `Code code -> code | `Status status -> code_of_status status let send_status_line ?(version = http_version) ~(code: status_code) outchan = send_status_line' ~version (int_of_code code) outchan let get_basic_headers () = ["Date", Http_misc.date_822 (); "Server", server_string; "Connection", "close"] let send_basic_headers ?(version = http_version) ~(code: status_code) outchan = send_status_line' ~version (int_of_code code) outchan; send_headers ~headers:(get_basic_headers ()) outchan (** internal: given a status code and an additional body return a string representing an HTML document that explains the meaning of given status code. Additional data can be added to the body via 'body' argument *) let foo_body code body = let reason_phrase = Http_misc.reason_phrase_of_code code in sprintf " %d %s

%d - %s

%s " code reason_phrase code reason_phrase body (** internal: send a fooish body explaining in HTML form the 'reason phrase' of an HTTP response; body, if given, will be appended to the body *) let send_foo_body code body = send_raw ~data:(foo_body code body) (* Warning: keep default values in sync with Http_response.response class *) let respond_head ?content_length ?(headers = []) ?version ?(code = `Code 200) outchan = send_basic_headers ?version ~code outchan; send_headers ~headers outchan; (match content_length with | None -> () | Some amount -> send_header "Content-Length" (string_of_int amount) outchan); send_CRLF outchan (* Warning: keep default values in sync with Http_response.response class *) let respond ?(body = "") ?(headers = []) ?version ?(code = `Code 200) outchan = send_basic_headers ?version ~code outchan; send_headers ~headers outchan; send_header "Content-Length" (string_of_int (String.length body)) outchan; send_CRLF outchan; send_raw ~data:body outchan let respond_trace ?req ?(headers = []) ?version ?(code = `Code 200) outchan = let body = match req with | Some r -> string_of_request r | None -> "" in respond ~body ~headers ?version ~code outchan (** internal: low level for respond_redirect, respond_error, ... This function send a status line corresponding to a given code, some basic headers, the additional headers (if given) and an HTML page containing the reason phrase; if body is given it will be included in the body of the HTML page *) let send_empty_response func_name ?(is_valid_status = fun _ -> true) ?(headers=[]) ?(body="") () = fun ?version code outchan -> if not (is_valid_status (int_of_code code)) then failwith (sprintf "'%d' isn't a valid status code for %s" (int_of_code code) func_name) else begin (* status code suitable for answering *) let headers = [ "Content-Type", "text/html; charset=iso-8859-1" ] @ headers in let body = (foo_body (int_of_code code) body) ^ body in respond ?version ~code ~headers ~body outchan end let respond_redirect ~location ?body ?version ?(code = `Code 301) outchan = send_empty_response "Daemon.respond_redirect" ~is_valid_status:is_redirection ~headers:["Location", location] ?body () ?version code outchan let respond_error ?body ?version ?(code = `Code 400) outchan = send_empty_response "Daemon.respond_error" ~is_valid_status:is_error ?body () ?version code outchan let respond_not_found ~url ?version outchan = send_empty_response "Daemon.respond_not_found" () ?version (`Code 404) outchan let respond_forbidden ~url ?version outchan = send_empty_response "Daemon.respond_permission_denied" () ?version (`Code 403) outchan let respond_unauthorized ?version ?(realm = server_string) outchan = let body = sprintf "401 - Unauthorized - Authentication failed for realm \"%s\"" realm in respond ~headers:["WWW-Authenticate", sprintf "Basic realm=\"%s\"" realm] ~code:(`Code 401) ~body outchan let send_file ~src outchan = let buflen = 1024 in let buf = Bytes.make buflen ' ' in let (file, cleanup) = match src with | FileSrc fname -> (* if we open the file, we close it before returning *) let f = open_in fname in f, (fun () -> close_in f) | InChanSrc inchan -> inchan, ignore in try while true do let bytes = input file buf 0 buflen in if bytes = 0 then raise End_of_file else output outchan buf 0 bytes done; assert false with End_of_file -> begin flush outchan; cleanup () end (* TODO interface is too ugly to advertise this function in .mli *) (** create a minimal HTML directory listing of a given directory and send it over an out_channel, directory is passed as a dir_handle; name is the directory name, used for pretty printing purposes; path is the opened dir path, used to test its contents with stat *) let send_dir_listing ~dir ~name ~path outchan = fprintf outchan "\n%s\n\n" name; let (dirs, files) = List.partition (fun e -> Http_misc.is_directory (path ^ e)) (Http_misc.ls dir) in List.iter (fun d -> fprintf outchan "%s/
\n" d d) (List.sort compare dirs); List.iter (fun f -> fprintf outchan "%s
\n" f f) (List.sort compare files); fprintf outchan "\n"; flush outchan let respond_file ~fname ?(version = http_version) outchan = (** ASSUMPTION: 'fname' doesn't begin with a "/"; it's relative to the current document root (usually the daemon's cwd) *) let droot = Sys.getcwd () in (* document root *) let path = droot ^ "/" ^ fname in (* full path to the desired file *) if not (Sys.file_exists path) then (* file not found *) respond_not_found ~url:fname outchan else begin try if Http_misc.is_directory path then begin (* file found, is a dir *) let dir = Unix.opendir path in send_basic_headers ~version ~code:(`Code 200) outchan; send_header "Content-Type" "text/html" outchan; send_CRLF outchan; send_dir_listing ~dir ~name:fname ~path outchan; Unix.closedir dir end else begin (* file found, is something else *) let file = open_in fname in send_basic_headers ~version ~code:(`Code 200) outchan; send_header ~header:"Content-Length" ~value:(string_of_int (Http_misc.filesize fname)) outchan; send_CRLF outchan; send_file ~src:(InChanSrc file) outchan; close_in file end with | Unix.Unix_error (Unix.EACCES, _, _) | Sys_error _ -> respond_forbidden ~url:fname ~version outchan end let respond_with (res: Http_types.response) outchan = res#serialize outchan; flush outchan (** internal: this exception is raised after a malformed request has been read by a serving process to signal main server (or itself if mode = `Single) to skip to next request *) exception Again;; let pp_parse_exc e = sprintf "HTTP request parse error: %s" (Printexc.to_string e) (* given a Http_parser.parse_request like function, wrap it in a function that do the same and additionally catch parsing exception sending HTTP error messages back to client as needed. Returned function raises Again when it encounter a parse error (name 'Again' is intended for future versions that will support http keep alive signaling that a new request has to be parsed from client) *) let rec wrap_parse_request_w_safety parse_function inchan outchan = (try parse_function inchan with | (Malformed_request req) as e -> debug_print (pp_parse_exc e); respond_error ~code:(`Code 400) ~body:("request 1st line format should be: " ^ "'<method> <url> <version>'" ^ "
\nwhile received request 1st line was:
\n" ^ req) outchan; raise Again | (Invalid_HTTP_method meth) as e -> debug_print (pp_parse_exc e); respond_error ~code:(`Code 501) ~body:("Method '" ^ meth ^ "' isn't supported (yet)") outchan; raise Again | (Malformed_request_URI uri) as e -> debug_print (pp_parse_exc e); respond_error ~code:(`Code 400) ~body:("Malformed URL: '" ^ uri ^ "'") outchan; raise Again | (Invalid_HTTP_version version) as e -> debug_print (pp_parse_exc e); respond_error ~code:(`Code 505) ~body:("HTTP version '" ^ version ^ "' isn't supported (yet)") outchan; raise Again | (Malformed_query query) as e -> debug_print (pp_parse_exc e); respond_error ~code:(`Code 400) ~body:(sprintf "Malformed query string '%s'" query) outchan; raise Again | (Malformed_query_part (binding, query)) as e -> debug_print (pp_parse_exc e); respond_error ~code:(`Code 400) ~body:(sprintf "Malformed query part '%s' in query '%s'" binding query) outchan; raise Again) (* wrapper around Http_parser.parse_request which catch parsing exceptions and return error messages to client as needed @param inchan in_channel from which read incoming requests @param outchan out_channl on which respond with error messages if needed *) let safe_parse_request = wrap_parse_request_w_safety parse_request (* as above but for OO version (Http_parser.parse_request') *) let safe_parse_request' = wrap_parse_request_w_safety (new Http_request.request) let chdir_to_document_root = function (* chdir to document root *) | Some dir -> Sys.chdir dir | None -> () let server_of_mode = function | `Single -> Http_tcp_server.simple | `Fork -> Http_tcp_server.fork | `Thread -> Http_tcp_server.thread (* TODO what happens when a Quit exception is raised by a callback? Do other callbacks keep on living until the end or are them all killed immediatly? The right semantics should obviously be the first one *) (** - handle HTTP authentication * - handle automatic closures of client connections *) let invoke_callback req spec outchan = let callback req outchan = if spec.auto_close then Http_misc.finally (fun () -> try close_out outchan with Sys_error _ -> ()) (fun () -> spec.callback req outchan) () else spec.callback req outchan in try (match (spec.auth, req#authorization) with | None, _ -> callback req outchan (* no auth required *) | Some (realm, `Basic (spec_username, spec_password)), Some (`Basic (username, password)) when (username = spec_username) && (password = spec_password) -> (* auth ok *) callback req outchan | Some (realm, _), _ -> raise (Unauthorized realm)) (* auth failure *) with | Unauthorized realm -> respond_unauthorized ~realm outchan | Again -> () let main spec = chdir_to_document_root spec.root_dir; let sockaddr = Http_misc.build_sockaddr (spec.address, spec.port) in let daemon_callback inchan outchan = let next_req () = try Some (safe_parse_request' inchan outchan) with _ -> None in let rec loop n = match next_req () with | Some req -> debug_print (sprintf "request #%d" n); invoke_callback req spec outchan; flush outchan; loop (n + 1) | None -> debug_print "server exiting"; () in debug_print "server starting"; try loop 1 with exn -> debug_print (sprintf "uncaught exception: %s" (Printexc.to_string exn)); (match spec.exn_handler with | Some f -> debug_print "executing handler"; f exn outchan | None -> debug_print "no handler given: re-raising"; raise exn) in try (server_of_mode spec.mode) ~sockaddr ~timeout:spec.timeout daemon_callback with Quit -> () module Trivial = struct let heading_slash_RE = Pcre.regexp "^/" let trivial_callback req outchan = let path = req#path in if not (Pcre.pmatch ~rex:heading_slash_RE path) then respond_error ~code:(`Code 400) outchan else respond_file ~fname:(Http_misc.strip_heading_slash path) outchan let callback = trivial_callback let main spec = main { spec with callback = trivial_callback } end (** @param inchan input channel connected to client @param outchan output channel connected to client @param sockaddr client socket address *) class connection inchan outchan sockaddr = (* ASSUMPTION: inchan and outchan are channels built on top of the same Unix.file_descr thus closing one of them will close also the other *) let close' o = try o#close with Http_daemon_failure _ -> () in object (self) initializer Gc.finalise close' self val mutable closed = false method private assertNotClosed = if closed then raise (Http_daemon_failure "Http_daemon.connection: connection is closed") method getRequest = self#assertNotClosed; try Some (safe_parse_request' inchan outchan) with _ -> None method respond_with res = self#assertNotClosed; respond_with res outchan method close = self#assertNotClosed; close_in inchan; (* this close also outchan *) closed <- true end class daemon ?(addr = "0.0.0.0") ?(port = 80) () = object (self) val suck = Http_tcp_server.init_socket (Http_misc.build_sockaddr (addr, port)) method accept = let (cli_suck, cli_sockaddr) = Unix.accept suck in (* may block *) let (inchan, outchan) = (Unix.in_channel_of_descr cli_suck, Unix.out_channel_of_descr cli_suck) in new connection inchan outchan cli_sockaddr method getRequest = let conn = self#accept in match conn#getRequest with | None -> conn#close; self#getRequest | Some req -> (req, conn) end open Http_constants let default_spec = { address = default_addr; auth = default_auth; auto_close = default_auto_close; callback = default_callback; mode = default_mode; port = default_port; root_dir = default_root_dir; exn_handler = default_exn_handler; timeout = default_timeout; } let daemon_spec ?(address = default_addr) ?(auth = default_auth) ?(auto_close = default_auto_close) ?(callback = default_callback) ?(mode = default_mode) ?(port = default_port) ?(root_dir = default_root_dir) ?(exn_handler = default_exn_handler) ?(timeout = default_timeout) () = { address = address; auth = auth; auto_close = auto_close; callback = callback; mode = mode; port = port; root_dir = root_dir; exn_handler = exn_handler; timeout = timeout; } ocaml-http-0.1.6/http_daemon.mli000066400000000000000000000177751340603407200166130ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Main OCaml HTTP module. Here you can find two set of functions: - functions which let you start an HTTP Daemon (start* functions) - facility functions which let you sent responses back to clients *) (** send a CRLF sequence on the given output channel, this is mandatory after the last header was sent and before start sending the response body *) val send_CRLF: out_channel -> unit (** send response status line, version is the http version used in response, either code or status must be given (not both, not none) which represent the HTTP response code, outchan is the output channel to which send status line *) val send_status_line: ?version:Http_types.version -> code:Http_types.status_code -> out_channel -> unit (** returns the basic headers "Date", "Server" and "Connection" used in send_basic_headers *) val get_basic_headers: unit -> (string * string) list (** like send_status_line but additionally will also send "Date", "Server" and "Connection" standard headers *) val send_basic_headers: ?version: Http_types.version -> code:Http_types.status_code -> out_channel -> unit (** send an HTTP header on outchan *) val send_header: header: string -> value: string -> out_channel -> unit (** as send_header, but for a list of pairs *) val send_headers: headers:(string * string) list -> out_channel -> unit (* (** send a file through an out_channel, file can be passed as an in_channel (if 'file' is given) or as a file name (if 'name' is given) *) val send_file: ?name:string -> ?file:in_channel -> out_channel -> unit *) (** send a file through an out_channel *) val send_file: src:Http_types.file_source -> out_channel -> unit (** high level response function, specific to HEAD responses, respond on outchan sending: basic headers, headers provided via 'headers' argument, Content-length if provided. Default response status is 200, default response HTTP version is Http_common.http_version *) val respond_head: ?content_length:int -> ?headers:(string * string) list -> ?version:Http_types.version -> ?code:Http_types.status_code -> out_channel -> unit (** high level response function, respond on outchan sending: basic headers (including Content-Length computed using 'body' argument), headers probided via 'headers' argument, body given via 'body' argument. Default response status is 200, default response HTTP version is Http_common.http_version *) val respond: ?body:string -> ?headers:(string * string) list -> ?version:Http_types.version -> ?code:Http_types.status_code -> out_channel -> unit (** high level response function, specific to TRACE responses, respond on outchan sending: basic headers, headers provided via 'headers' argument, body given via 'req' argument. The supplied request will be sent back to the client. Default response status is 200, default response HTTP version is Http_common.http_version *) val respond_trace: ?req:Http_types.request -> ?headers:(string * string) list -> ?version:Http_types.version -> ?code:Http_types.status_code -> out_channel -> unit (** send a 404 (not found) HTTP response *) val respond_not_found: url:string -> ?version: Http_types.version -> out_channel -> unit (** send a 403 (forbidden) HTTP response *) val respond_forbidden: url:string -> ?version: Http_types.version -> out_channel -> unit (** send a "redirection" class response, optional body argument contains data that will be displayed in the body of the response, default response status is 301 (moved permanently), only redirection status are accepted by this function, other values will raise Failure *) val respond_redirect: location:string -> ?body:string -> ?version: Http_types.version -> ?code:Http_types.status_code -> out_channel -> unit (** respond with a 401 (Unauthorized) response asking for authentication * against given realm (default is the server name) *) val respond_unauthorized: ?version: Http_types.version -> ?realm:string -> out_channel -> unit (** send an "error" response (i.e. 400 <= status < 600), optional body argument as per send_redirect, default response status is 400 (bad request), only error status are accepted by this function, other values will raise Failure *) val respond_error: ?body:string -> ?version: Http_types.version -> ?code:Http_types.status_code -> out_channel -> unit (** tipical static pages http daemon behaviour, if requested url is a file, return it, it it is a directory return a directory listing of it *) val respond_file: fname:string -> ?version: Http_types.version -> out_channel -> unit (** respond using a prebuilt Http_types.response object *) val respond_with: Http_types.response -> out_channel -> unit (** start an HTTP daemon * @param spec specification of daemon behaviour *) val main: Http_types.daemon_spec -> unit (** default daemon specification: * - listen on 0.0.0.0, port 80 * - "always ok" callback (return an empty response, response code 200) * - fork a child for each request * - do not change to a root directory (i.e. keep cwd) * - 300 seconds timeout * - ignores exceptions * - no authentication required * - do not automatically close client connections after callback *) val default_spec: Http_types.daemon_spec (** currified daemon_spec constructor. Each parameter of this function * corresponds to one field of Http_types.daemon_spec and defaults to the * corresponding field of Http_daemon.default_spec *) val daemon_spec: ?address:string -> ?auth:(string * Http_types.auth_info) option -> ?auto_close:bool -> ?callback:(Http_types.request -> out_channel -> unit) -> ?mode:(Http_types.daemon_mode) -> ?port:int -> ?root_dir:string option -> ?exn_handler:(exn -> out_channel -> unit) option -> ?timeout:int option -> unit -> Http_types.daemon_spec (* (** XXX * This function has been deprecated for a while. Now it has been removed! *) val start: ?addr: string -> ?port: int -> ?timeout: int option -> ?mode: Http_types.daemon_mode -> ?root: string -> (string -> (string * string) list -> out_channel -> unit) -> unit *) (* (** XXX * This function has been deprecated for a while. Now it has been removed! *) val start': ?addr: string -> ?port: int -> ?timeout: int option -> ?mode: Http_types.daemon_mode -> ?root: string -> (Http_types.request -> out_channel -> unit) -> unit *) (** Object oriented interface to HTTP daemons. * @param addr address on which daemon will listen for connections * @param port port which daemon will bind * see {!Http_types.daemon} *) class daemon: ?addr: string -> ?port: int -> unit -> Http_types.daemon (** Trivial static pages HTTP daemon. * Daemons created using this module will serve directory indexes and files * found starting from the working directory *) module Trivial : sig (** callback function, exposed if you like to use it as a basis to define a more powerful daemon *) val callback : Http_types.request -> out_channel -> unit (** start the "trivial" HTTP daemon * @param spec trivial HTTP daemon specification, "callback" field is * ignored and set to the callback above *) val main : Http_types.daemon_spec -> unit end ocaml-http-0.1.6/http_message.ml000066400000000000000000000074501340603407200166100ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_common;; open Http_constants;; open Http_types;; open Printf;; (* remove all bindings of 'name' from hashtbl 'tbl' *) let rec hashtbl_remove_all tbl name = if not (Hashtbl.mem tbl name) then raise (Header_not_found name); Hashtbl.remove tbl name; if Hashtbl.mem tbl name then hashtbl_remove_all tbl name ;; class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = let ((cliaddr, cliport), (srvaddr, srvport)) = (Http_misc.explode_sockaddr clisockaddr, Http_misc.explode_sockaddr srvsockaddr) in object (self) val _contentsBuf = Buffer.create 1024 val _headers = Hashtbl.create 11 val mutable _version: version option = version initializer self#setBody body; self#addHeaders headers method version = _version method setVersion v = _version <- Some v method body = Buffer.contents _contentsBuf method setBody c = Buffer.clear _contentsBuf; Buffer.add_string _contentsBuf c method bodyBuf = _contentsBuf method setBodyBuf b = Buffer.clear _contentsBuf; Buffer.add_buffer _contentsBuf b method addBody s = Buffer.add_string _contentsBuf s method addBodyBuf b = Buffer.add_buffer _contentsBuf b method addHeader ~name ~value = let name = String.lowercase_ascii name in Http_parser_sanity.heal_header (name, value); Hashtbl.add _headers name value method addHeaders = List.iter (fun (name, value) -> self#addHeader ~name ~value) method replaceHeader ~name ~value = let name = String.lowercase_ascii name in Http_parser_sanity.heal_header (name, value); Hashtbl.replace _headers name value method replaceHeaders = List.iter (fun (name, value) -> self#replaceHeader ~name ~value) method removeHeader ~name = let name = String.lowercase_ascii name in hashtbl_remove_all _headers name method hasHeader ~name = let name = String.lowercase_ascii name in Hashtbl.mem _headers name method header ~name = if not (self#hasHeader name) then raise (Header_not_found name); let name = String.lowercase_ascii name in String.concat ", " (List.rev (Hashtbl.find_all _headers name)) method headers = List.rev (Hashtbl.fold (fun name _ headers -> (name, self#header ~name)::headers) _headers []) method clientSockaddr = clisockaddr method clientAddr = cliaddr method clientPort = cliport method serverSockaddr = srvsockaddr method serverAddr = srvaddr method serverPort = srvport method private virtual fstLineToString: string method toString = self#fstLineToString ^ (* {request,status} line *) crlf ^ (String.concat (* headers, crlf terminated *) "" (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers)) ^ (sprintf "Content-Length: %d" (String.length self#body)) ^ crlf ^ crlf ^ self#body (* body *) method serialize outchan = output_string outchan self#toString; flush outchan end ocaml-http-0.1.6/http_message.mli000066400000000000000000000110241340603407200167510ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Object Oriented representation of HTTP messages *) open Http_types;; (** OO representation of an HTTP message @param entity body included in the message @param headers message headers shipped with the message *) class virtual message: body: string -> headers: (string * string) list -> version: version option -> clisockaddr: Unix.sockaddr -> srvsockaddr: Unix.sockaddr -> object (** @return message HTTP version, it can be None because older version of the HTTP protocol don't require HTTP version to be told between message source and destination *) method version: version option (** set message HTTP version *) method setVersion: version -> unit (** @return message body *) method body: string (** set message body *) method setBody: string -> unit (** @return a Buffer.t connected to message body (Warning: changing this buffer will change message body too) *) method bodyBuf: Buffer.t (** set a new Buffer.t used to keep message body *) method setBodyBuf: Buffer.t -> unit (** append a string to message body *) method addBody: string -> unit (** append a whole buffer to message body *) method addBodyBuf: Buffer.t -> unit (** {i header name comparison are performed in a case-insensitive manner as required by RFC2616, actually the implementation works converting all header names in lowercase} *) (** add an HTTP header @param name header's name @param value header's value *) method addHeader: name:string -> value:string -> unit (** add a list of HTTP headers @param headers a list of pairs: header_name, header_value *) method addHeaders: (string * string) list -> unit (** like addHeader but replace previous definition of the same header *) method replaceHeader: name:string -> value:string -> unit (** like addHeaders but replace previous definition of headers that were already defined *) method replaceHeaders: (string * string) list -> unit (** remove _all_ occurences of an HTTP header from the message @param name name of the header to be removed *) method removeHeader: name:string -> unit (** @return true if given header exists in message, false otherwise *) method hasHeader: name:string -> bool (** @return value associated to a given header @param name name of the header to lookup @raise Header_not_found if given header wasn't defined in message *) method header: name:string -> string (** @return the full set of headers defined for this message, the value returned is an association list from headers name to headers value, an header may occurs more that once in the list *) method headers: (string * string) list (** @return client Unix.sockaddr *) method clientSockaddr: Unix.sockaddr (** @return client address pretty printed *) method clientAddr: string (** @return client port *) method clientPort: int (** @return server Unix.sockaddr *) method serverSockaddr: Unix.sockaddr (** @return server address pretty printed *) method serverAddr: string (** @return server port *) method serverPort: int (** @return for requests first request line, for responses first response line. User by derived requests and responses to implement toString method *) method private virtual fstLineToString: string (** @return a string representation of the message *) method toString: string (** serialize the message over an output channel *) method serialize: out_channel -> unit end ocaml-http-0.1.6/http_misc.ml000066400000000000000000000110571340603407200161150ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_types let date_822 () = Netdate.mk_mail_date ~zone:Netdate.localzone (Unix.time ()) let is_directory name = match Unix.lstat name with | { Unix.st_kind = Unix.S_DIR } -> true | _ -> false let filesize fname = (Unix.stat fname).Unix.st_size let strip_trailing_slash = let rex = Pcre.regexp "/$" in fun s -> Pcre.replace ~rex ~templ:"" s let strip_heading_slash = let rex = Pcre.regexp "^/" in fun s -> Pcre.replace ~rex ~templ:"" s let ls dir = let rec ls' entries = try ls' ((Unix.readdir dir)::entries) with End_of_file -> entries in ls' [] let string_explode s = let rec string_explode' acc = function | "" -> acc | s -> string_explode' (s.[0] :: acc) (String.sub s 1 (String.length s - 1)) in List.rev (string_explode' [] s) let string_implode = List.fold_left (fun s c -> s ^ (String.make 1 c)) "" let reason_phrase_of_code = function | 100 -> "Continue" | 101 -> "Switching protocols" | 200 -> "OK" | 201 -> "Created" | 202 -> "Accepted" | 203 -> "Non authoritative information" | 204 -> "No content" | 205 -> "Reset content" | 206 -> "Partial content" | 300 -> "Multiple choices" | 301 -> "Moved permanently" | 302 -> "Found" | 303 -> "See other" | 304 -> "Not modified" | 305 -> "Use proxy" | 307 -> "Temporary redirect" | 400 -> "Bad request" | 401 -> "Unauthorized" | 402 -> "Payment required" | 403 -> "Forbidden" | 404 -> "Not found" | 405 -> "Method not allowed" | 406 -> "Not acceptable" | 407 -> "Proxy authentication required" | 408 -> "Request time out" | 409 -> "Conflict" | 410 -> "Gone" | 411 -> "Length required" | 412 -> "Precondition failed" | 413 -> "Request entity too large" | 414 -> "Request URI too large" | 415 -> "Unsupported media type" | 416 -> "Requested range not satisfiable" | 417 -> "Expectation failed" | 500 -> "Internal server error" | 501 -> "Not implemented" | 502 -> "Bad gateway" | 503 -> "Service unavailable" | 504 -> "Gateway time out" | 505 -> "HTTP version not supported" | invalid_code -> raise (Invalid_code invalid_code) let build_sockaddr (addr, port) = try Unix.ADDR_INET ((Unix.gethostbyname addr).Unix.h_addr_list.(0), port) with Not_found -> failwith ("OCaml-HTTP, can't resolve hostname: " ^ addr) let explode_sockaddr = function | Unix.ADDR_INET (addr, port) -> (Unix.string_of_inet_addr addr, port) | _ -> assert false (* can explode only inet address *) let peername_of_out_channel outchan = Unix.getpeername (Unix.descr_of_out_channel outchan) let peername_of_in_channel inchan = Unix.getpeername (Unix.descr_of_in_channel inchan) let sockname_of_out_channel outchan = Unix.getsockname (Unix.descr_of_out_channel outchan) let sockname_of_in_channel inchan = Unix.getsockname (Unix.descr_of_in_channel inchan) let buf_of_inchan ?limit ic = let buf = Buffer.create 10240 in let tmp = Bytes.make 1024 '\000' in let rec buf_of_inchan' limit = (match limit with | None -> let bytes = input ic tmp 0 1024 in if bytes > 0 then begin Buffer.add_subbytes buf tmp 0 bytes; buf_of_inchan' None end | Some lim -> (* TODO what about using a single really_input call? *) let bytes = input ic tmp 0 (min lim 1024) in if bytes > 0 then begin Buffer.add_subbytes buf tmp 0 bytes; buf_of_inchan' (Some (lim - bytes)) end) in (try buf_of_inchan' limit with End_of_file -> ()); buf let list_assoc_all key pairs = snd (List.split (List.filter (fun (k, v) -> k = key) pairs)) let warn msg = prerr_endline (sprintf "ocaml-http WARNING: %s" msg) let error msg = prerr_endline (sprintf "ocaml-http ERROR: %s" msg) let finally at_end f arg = let res = try f arg with exn -> at_end (); raise exn in at_end (); res ocaml-http-0.1.6/http_misc.mli000066400000000000000000000070151340603407200162650ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Helpers and other not better classified functions which should not be exposed in the final API *) (** @return the current date compliant to RFC 1123, which updates RFC 822 zone info are retrieved from UTC *) val date_822: unit -> string (** @return true if 'name' is a directory on the file system, false otherwise *) val is_directory: string -> bool (** @return the filesize of fname *) val filesize: string -> int (** strip trailing '/', if any, from a string and @return the new string *) val strip_trailing_slash: string -> string (** strip heading '/', if any, from a string and @return the new string *) val strip_heading_slash: string -> string (** given a dir handle @return a list of entries contained *) val ls: Unix.dir_handle -> string list (** explode a string in a char list *) val string_explode: string -> char list (** implode a char list in a string *) val string_implode: char list -> string (** given an HTTP response code return the corresponding reason phrase *) val reason_phrase_of_code: int -> string (** build a Unix.sockaddr inet address from a string representation of an IP address and a port number *) val build_sockaddr: string * int -> Unix.sockaddr (** explode an _inet_ Unix.sockaddr address in a string representation of an IP address and a port number *) val explode_sockaddr: Unix.sockaddr -> string * int (** given an out_channel build on top of a socket, return peername related to that socket *) val peername_of_out_channel: out_channel -> Unix.sockaddr (** as above but works on in_channels *) val peername_of_in_channel: in_channel -> Unix.sockaddr (** given an out_channel build on top of a socket, return sockname related to that socket *) val sockname_of_out_channel: out_channel -> Unix.sockaddr (** as above but works on in_channels *) val sockname_of_in_channel: in_channel -> Unix.sockaddr (* TODO replace with Buffer.add_channel which does almost the same :-((( *) (** reads from an input channel till it End_of_file and returns what has been read; if limit is given returned buffer will contains at most first 'limit' bytes read from input channel *) val buf_of_inchan: ?limit: int -> in_channel -> Buffer.t (** like List.assoc but return all bindings of a given key instead of the leftmost one only *) val list_assoc_all: 'a -> ('a * 'b) list -> 'b list val warn: string -> unit (** print a warning msg to stderr. Adds trailing \n *) val error: string -> unit (** print an error msg to stderr. Adds trailing \n *) (** @param finalizer finalization function (execution both in case of success * and in case of raised exception * @param f function to be invoked * @param arg argument to be passed to function *) val finally: (unit -> unit) -> ('a -> 'b) -> 'a -> 'b ocaml-http-0.1.6/http_parser.ml000066400000000000000000000145121340603407200164550ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2010> Stefano Zacchiroli <2010> Arlen Cuss This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf;; open Http_common;; open Http_types;; open Http_constants;; let (bindings_sep, binding_sep, pieces_sep, header_sep) = (Pcre.regexp "&", Pcre.regexp "=", Pcre.regexp " ", Pcre.regexp ":") let header_RE = Pcre.regexp "([^:]*):(.*)" let url_decode url = Netencoding.Url.decode ~plus:true url let split_query_params query = let bindings = Pcre.split ~rex:bindings_sep query in match bindings with | [] -> [] | bindings -> List.map (fun binding -> match Pcre.split ~rex:binding_sep binding with | [ ""; b ] -> (* '=b' *) raise (Malformed_query_part (binding, query)) | [ a; b ] -> (* 'a=b' *) (url_decode a, url_decode b) | [ a ] -> (* 'a=' || 'a' *) (url_decode a, "") | _ -> raise (Malformed_query_part (binding, query))) bindings (** internal, used by generic_input_line *) exception Line_completed;; (** given an input channel and a separator @return a line read from it (like Pervasives.input_line) line is returned only after reading a separator string; separator string isn't included in the returned value TODO what about efficiency?, input is performed char-by-char *) let generic_input_line ~sep ~ic = let sep_len = String.length sep in if sep_len < 1 then failwith ("Separator '" ^ sep ^ "' is too short!") else (* valid separator *) let line = ref "" in let sep_pointer = ref 0 in try while true do if !sep_pointer >= String.length sep then (* line completed *) raise Line_completed else begin (* incomplete line: need to read more *) let ch = input_char ic in if ch = String.get sep !sep_pointer then (* next piece of sep *) incr sep_pointer else begin (* useful char *) for i = 0 to !sep_pointer - 1 do line := !line ^ (String.make 1 (String.get sep i)) done; sep_pointer := 0; line := !line ^ (String.make 1 ch) end end done; assert false (* unreacheable statement *) with Line_completed -> !line let patch_empty_path = function "" -> "/" | s -> s let debug_dump_request path params = debug_print (sprintf "recevied request; path: %s; params: %s" path (String.concat ", " (List.map (fun (n, v) -> n ^ "=" ^ v) params))) let parse_request_fst_line ic = let request_line = generic_input_line ~sep:crlf ~ic in debug_print (sprintf "HTTP request line (not yet parsed): %s" request_line); try (match Pcre.split ~rex:pieces_sep request_line with | [ meth_raw; uri_raw ] -> (* ancient HTTP request line *) (method_of_string meth_raw, (* method *) Http_parser_sanity.url_of_string uri_raw, (* uri *) None) (* no version given *) | [ meth_raw; uri_raw; http_version_raw ] -> (* HTTP 1.{0,1} *) (method_of_string meth_raw, (* method *) Http_parser_sanity.url_of_string uri_raw, (* uri *) Some (version_of_string http_version_raw)) (* version *) | _ -> raise (Malformed_request request_line)) with Malformed_URL url -> raise (Malformed_request_URI url) let parse_response_fst_line ic = let response_line = generic_input_line ~sep:crlf ~ic in debug_print (sprintf "HTTP response line (not yet parsed): %s" response_line); try (match Pcre.split ~rex:pieces_sep response_line with | version_raw :: code_raw :: _ -> (version_of_string version_raw, (* method *) status_of_code (int_of_string code_raw)) (* status *) | _ -> raise (Malformed_response response_line)) with | Malformed_URL _ | Invalid_code _ | Failure "int_of_string" -> raise (Malformed_response response_line) let parse_path uri = patch_empty_path (String.concat "/" (Neturl.url_path uri)) let parse_query_get_params uri = try (* act on HTTP encoded URIs *) split_query_params (Neturl.url_query ~encoded:true uri) with Not_found -> [] let parse_headers ic = (* consume also trailing "^\r\n$" line *) let rec parse_headers' headers = match generic_input_line ~sep:crlf ~ic with | "" -> List.rev headers | line -> (let subs = try Pcre.extract ~rex:header_RE line with Not_found -> raise (Invalid_header line) in let header = try subs.(1) with Invalid_argument "Array.get" -> raise (Invalid_header line) in let value = try Http_parser_sanity.normalize_header_value subs.(2) with Invalid_argument "Array.get" -> "" in Http_parser_sanity.heal_header (header, value); parse_headers' ((header, value) :: headers)) in parse_headers' [] let parse_cookies raw_cookies = let tokens = let lexbuf = Lexing.from_string raw_cookies in let rec aux acc = match Cookie_lexer.token lexbuf with | `EOF -> acc | token -> aux (token :: acc) in List.rev (aux []) in let rec aux = function | [ `ASSIGNMENT (n,v) ] -> [ (n,v) ] | `ASSIGNMENT (n,v) :: `SEP :: tl -> (n,v) :: aux tl | _ -> prerr_endline ("failed to read raw cookies: '" ^ raw_cookies ^ "'"); raise (Malformed_cookies raw_cookies) in aux tokens let parse_request ic = let (meth, uri, version) = parse_request_fst_line ic in let path = parse_path uri in let query_get_params = parse_query_get_params uri in debug_dump_request path query_get_params; (path, query_get_params) ocaml-http-0.1.6/http_parser.mli000066400000000000000000000063331340603407200166300ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** HTTP messages parsing *) open Http_types;; (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...") @return a list of pairs [("name1", "value1"); ("name2", "value2")] @raise Malformed_query if the string isn't a valid query string @raise Malformed_query_part if some piece of the query isn't valid *) val split_query_params: string -> (string * string) list (** parse 1st line of an HTTP request @param inchan input channel from which parse request @return a triple meth * url * version, meth is the HTTP method invoked, url is the requested url, version is the HTTP version specified or None if no version was specified @raise Malformed_request if request 1st linst isn't well formed @raise Malformed_request_URI if requested URI isn't well formed *) val parse_request_fst_line: in_channel -> meth * Neturl.url * version option (** parse 1st line of an HTTP response * @param inchan input channel from which parse response * @raise Malformed_response if first line isn't well formed *) val parse_response_fst_line: in_channel -> version * status (** parse HTTP GET parameters from an URL; paramater which were passed with no value (like 'x' in "/foo.cgi?a=10&x=&c=9") are returned associated with the empty ("") string. @return a list of pairs param_name * param_value *) val parse_query_get_params: Neturl.url -> (string * string) list (** parse the base path (removing query string, fragment, ....) from an URL *) val parse_path: Neturl.url -> string (** parse HTTP headers. Consumes also trailing CRLF at the end of header list @param inchan input channel from which parse headers @return a list of pairs header_name * header_value @raise Invalid_header if a not well formed header is encountered *) val parse_headers: in_channel -> (string * string) list (** parse a Cookie header, extracting an associative list . See RFC 2965 * @param raw_cookies: value of a "Cookies:" header * @return a list of pairs cookie_name * cookie_value * @raise Malformed_cookies if raw_cookies does not conform to RFC 2965 *) val parse_cookies: string -> (string * string) list (** given an input channel, reads from it a GET HTTP request and @return a pair where path is a string representing the requested path and query_params is a list of pairs (the GET parameters) *) val parse_request: in_channel -> string * (string * string) list ocaml-http-0.1.6/http_parser_sanity.ml000066400000000000000000000073001340603407200200410ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_types open Http_constants (* type url_syntax_option = Url_part_not_recognized | Url_part_allowed | Url_part_required * (1) scheme://user:password@host:port/path;params?query#fragment *) let request_uri_syntax = { Neturl.url_enable_scheme = Neturl.Url_part_not_recognized; url_enable_user = Neturl.Url_part_not_recognized; url_enable_user_param = Neturl.Url_part_not_recognized; url_enable_password = Neturl.Url_part_not_recognized; url_enable_host = Neturl.Url_part_not_recognized; url_enable_port = Neturl.Url_part_not_recognized; url_enable_path = Neturl.Url_part_required; url_enable_param = Neturl.Url_part_not_recognized; url_enable_query = Neturl.Url_part_allowed; url_enable_fragment = Neturl.Url_part_not_recognized; url_enable_other = Neturl.Url_part_not_recognized; url_accepts_8bits = false; url_enable_relative = true; url_is_valid = (fun _ -> true); } (* convention: foo_RE_raw is the uncompiled regexp matching foo foo_RE is the compiled regexp matching foo is_foo is the predicate over string matching foo *) let separators_RE_raw = "()<>@,;:\\\\\"/\\[\\]?={} \t" let ctls_RE_raw = "\\x00-\\x1F\\x7F" let token_RE_raw = "[^" ^ separators_RE_raw ^ ctls_RE_raw ^ "]+" let lws_RE_raw = "(\r\n)?[ \t]" let quoted_string_RE_raw = "\"(([^\"])|(\\\\\"))*\"" let text_RE_raw = "(([^" ^ ctls_RE_raw ^ "])|(" ^ lws_RE_raw ^ "))+" let field_content_RE_raw = sprintf "^(((%s)|(%s)|(%s))|(%s))*$" token_RE_raw separators_RE_raw quoted_string_RE_raw text_RE_raw (* (* following RFC 2616 specifications *) let field_value_RE_raw = "((" ^ field_content_RE_raw ^ ")|(" ^ lws_RE_raw^ "))*" *) (* smarter implementation: TEXT production is included in the regexp below *) let field_value_RE_raw = sprintf "^((%s)|(%s)|(%s)|(%s))*$" token_RE_raw separators_RE_raw quoted_string_RE_raw lws_RE_raw let token_RE = Pcre.regexp ("^" ^ token_RE_raw ^ "$") let field_value_RE = Pcre.regexp ("^" ^ field_value_RE_raw ^ "$") let heading_lws_RE = Pcre.regexp (sprintf "^%s*" lws_RE_raw) let trailing_lws_RE = Pcre.regexp (sprintf "%s*$" lws_RE_raw) let is_token s = Pcre.pmatch ~rex:token_RE s let is_field_name = is_token let is_field_value s = Pcre.pmatch ~rex:field_value_RE s let heal_header_name s = if not (is_field_name s) then raise (Invalid_header_name s) else () let heal_header_value s = if not (is_field_value s) then raise (Invalid_header_value s) else () let normalize_header_value s = Pcre.replace ~rex:trailing_lws_RE (Pcre.replace ~rex:heading_lws_RE s) let heal_header (name, value) = heal_header_name name; heal_header_value name let url_of_string s = try Neturl.url_of_string request_uri_syntax s with Neturl.Malformed_URL -> raise (Malformed_URL s) let string_of_url = Neturl.string_of_url ocaml-http-0.1.6/http_parser_sanity.mli000066400000000000000000000032571340603407200202210ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Sanity test functions related to HTTP message parsing *) (** @param name an HTTP header name @raise Invalid_header_name if name isn't a valid HTTP header name *) val heal_header_name: string -> unit (** @param value an HTTP header value @raise Invalid_header_value if value isn't a valid HTTP header value *) val heal_header_value: string -> unit (** @param header a pair header_name * header_value @raise Invalid_header_name if name isn't a valid HTTP header name @raise Invalid_header_value if value isn't a valid HTTP header value *) val heal_header: string * string -> unit (** remove heading and/or trailing LWS sequences as per RFC2616 *) val normalize_header_value: string -> string (** parse an URL from a string. @raise Malformed_URL if an invalid URL is encountered *) val url_of_string: string -> Neturl.url (** pretty print an URL *) val string_of_url: Neturl.url -> string ocaml-http-0.1.6/http_request.ml000066400000000000000000000141761340603407200166570ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2007> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf;; open Http_common;; open Http_types;; let debug_dump_request path params = debug_print ("request path = " ^ path); debug_print ( sprintf"request params = %s" (String.concat ";" (List.map (fun (h,v) -> String.concat "=" [h;v]) params))) let auth_sep_RE = Pcre.regexp ":" let basic_auth_RE = Pcre.regexp "^Basic\\s+" exception Fallback;; (* used internally by request class *) class request ic = let (meth, uri, version) = Http_parser.parse_request_fst_line ic in let uri_str = Neturl.string_of_url uri in let path = Http_parser.parse_path uri in let query_get_params = Http_parser.parse_query_get_params uri in let (headers, body) = (match version with | None -> [], "" (* No version given, use request's 1st line only *) | Some version -> (* Version specified, parse also headers and body *) let headers = List.map (* lowercase header names to ease lookups before having a request object *) (fun (h,v) -> (String.lowercase_ascii h, v)) (Http_parser.parse_headers ic) (* trailing \r\n consumed! *) in let body = (* TODO fallback on size defined in Transfer-Encoding if Content-Length isn't defined *) match meth with | `POST | `PUT | `TRACE -> Buffer.contents (try (* read only Content-Length bytes *) let limit_raw = (try List.assoc "content-length" headers with Not_found -> raise Fallback) in let limit = (try (* TODO supports only a maximum content-length of 1Gb *) int_of_string limit_raw with Failure "int_of_string" -> raise (Invalid_header ("content-length: " ^ limit_raw))) in Http_misc.buf_of_inchan ~limit ic with Fallback -> Http_misc.buf_of_inchan ic) (* read until EOF *) | _ -> "" in (headers, body)) in let cookies = try let _hdr, raw_cookies = List.find (fun (hdr, _cookie) -> String.lowercase_ascii hdr = "cookie") headers in Some (Http_parser.parse_cookies raw_cookies) with | Not_found -> None | Malformed_cookies _ -> None in let query_post_params = match meth with | `POST -> let ct = try List.assoc "content-type" headers with Not_found -> "" in if ct = "application/x-www-form-urlencoded" then Http_parser.split_query_params body else [] | _ -> [] in let params = query_post_params @ query_get_params in (* prefers POST params *) let _ = debug_dump_request path params in let (clisockaddr, srvsockaddr) = (Http_misc.peername_of_in_channel ic, Http_misc.sockname_of_in_channel ic) in object (self) inherit Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr val params_tbl = let tbl = Hashtbl.create (List.length params) in List.iter (fun (n,v) -> Hashtbl.add tbl n v) params; tbl method meth = meth method uri = uri_str method path = path method param ?(meth: meth option) ?(default: string option) name = try (match meth with | None -> Hashtbl.find params_tbl name | Some `GET -> List.assoc name query_get_params | Some `HEAD -> List.assoc name query_get_params | Some `PUT -> List.assoc name query_get_params | Some `DELETE -> List.assoc name query_get_params | Some `OPTIONS -> List.assoc name query_get_params | Some `TRACE -> List.assoc name query_get_params | Some `POST -> List.assoc name query_post_params) with Not_found -> (match default with | None -> raise (Param_not_found name) | Some value -> value) method paramAll ?meth name = (match (meth: meth option) with | None -> List.rev (Hashtbl.find_all params_tbl name) | Some `GET -> Http_misc.list_assoc_all name query_get_params | Some `HEAD -> Http_misc.list_assoc_all name query_get_params | Some `PUT -> Http_misc.list_assoc_all name query_get_params | Some `DELETE -> Http_misc.list_assoc_all name query_get_params | Some `OPTIONS -> Http_misc.list_assoc_all name query_get_params | Some `TRACE -> Http_misc.list_assoc_all name query_get_params | Some `POST -> Http_misc.list_assoc_all name query_post_params) method params = params method params_GET = query_get_params method params_POST = query_post_params method cookies = cookies method private fstLineToString = let method_string = string_of_method self#meth in match self#version with | Some version -> sprintf "%s %s %s" method_string self#uri (string_of_version version) | None -> sprintf "%s %s" method_string self#uri method authorization: auth_info option = try let credentials = Netencoding.Base64.decode (Pcre.replace ~rex:basic_auth_RE (self#header "authorization")) in debug_print ("HTTP Basic auth credentials: " ^ credentials); (match Pcre.split ~rex:auth_sep_RE credentials with | [username; password] -> Some (`Basic (username, password)) | l -> raise Exit) with Header_not_found _ | Invalid_argument _ | Exit -> None end ocaml-http-0.1.6/http_request.mli000066400000000000000000000020001340603407200170070ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2007> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Object Oriented representation of HTTP requests *) open Http_types;; (** OO representation of an HTTP request @param inchan input channel from which parse an HTTP request *) class request: in_channel -> Http_types.request ocaml-http-0.1.6/http_response.ml000066400000000000000000000101041340603407200170100ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Http_types;; open Http_constants;; open Http_common;; open Http_daemon;; open Printf;; let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" let anyize = function | Some addr -> addr | None -> Unix.ADDR_INET (Unix.inet_addr_any, -1) class response (* Warning: keep default values in sync with Http_daemon.respond function *) ?(body = "") ?(headers = []) ?(version = http_version) ?clisockaddr ?srvsockaddr (* optional because response have to be easily buildable in callback functions *) ?(code = 200) ?status () = (** if no address were supplied for client and/or server, use a foo address instead *) let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in (* "version code reason_phrase" *) object (self) (* note that response objects can't be created with a None version *) inherit Http_message.message ~body ~headers ~version:(Some version) ~clisockaddr ~srvsockaddr val mutable _code = match status with | None -> code | Some (s: Http_types.status) -> code_of_status s val mutable _reason: string option = None method private getRealVersion = match self#version with | None -> failwith ("Http_response.fstLineToString: " ^ "can't serialize an HTTP response with no HTTP version defined") | Some v -> string_of_version v method code = _code method setCode c = ignore (status_of_code c); (* sanity check on c *) _code <- c method status = status_of_code _code method setStatus (s: Http_types.status) = _code <- code_of_status s method reason = match _reason with | None -> Http_misc.reason_phrase_of_code _code | Some r -> r method setReason r = _reason <- Some r method statusLine = String.concat " " [self#getRealVersion; string_of_int self#code; self#reason] method setStatusLine s = try let subs = Pcre.extract ~rex:status_line_RE s in self#setVersion (version_of_string subs.(1)); self#setCode (int_of_string subs.(2)); self#setReason subs.(3) with Not_found -> raise (Invalid_status_line s) method isInformational = is_informational _code method isSuccess = is_success _code method isRedirection = is_redirection _code method isClientError = is_client_error _code method isServerError = is_server_error _code method isError = is_error _code method addBasicHeaders = List.iter (fun (n,v) -> self#addHeader n v) (get_basic_headers ()) method contentType = self#header "Content-Type" method setContentType t = self#replaceHeader "Content-Type" t method contentEncoding = self#header "Content-Encoding" method setContentEncoding e = self#replaceHeader "Content-Encoding" e method date = self#header "Date" method setDate d = self#replaceHeader "Date" d method expires = self#header "Expires" method setExpires t = self#replaceHeader "Expires" t method server = self#header "Server" method setServer s = self#replaceHeader "Server" s method connection = self#header "Connection" method setConnection s = self#replaceHeader "Connection" s method private fstLineToString = sprintf "%s %d %s" self#getRealVersion self#code self#reason end ocaml-http-0.1.6/http_response.mli000066400000000000000000000021751340603407200171720ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Object Oriented representation of HTTP responses *) open Http_types;; (** OO representation of an HTTP response. *) class response: ?body:string -> ?headers:(string * string) list -> ?version: version -> ?clisockaddr: Unix.sockaddr -> ?srvsockaddr: Unix.sockaddr -> ?code:int -> ?status:Http_types.status -> unit -> Http_types.response ocaml-http-0.1.6/http_tcp_server.ml000066400000000000000000000134471340603407200173430ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** raised when a client timeouts *) exception Timeout let backlog = 10 (** if timeout is given (Some _) @return a new callback which establish timeout_callback as callback for signal Sys.sigalrm and register an alarm (expiring after timeout seconds) before invoking the real callback given. If timeout is None, callback is returned unchanged. *) let wrap_callback_w_timeout ~callback ~timeout ~timeout_callback = match timeout with | None -> callback | Some timeout -> (* wrap callback setting an handler for ALRM signal and an alarm that ring after timeout seconds *) (fun inchan outchan -> ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_callback)); ignore (Unix.alarm timeout); callback inchan outchan) (* try to close nicely a socket *) let shutdown_socket suck = try Unix.shutdown suck Unix.SHUTDOWN_ALL with Unix.Unix_error(_, "shutdown", "") -> () let nice_unix_accept suck = try Unix.accept suck with e -> (* clean up socket before exit *) shutdown_socket suck; raise e let init_socket sockaddr = let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in (* shutdown socket on SIGTERM *) ignore (Sys.signal Sys.sigterm (Sys.Signal_handle (fun _ -> shutdown_socket suck; exit 17))); Unix.setsockopt suck Unix.SO_REUSEADDR true; Unix.bind suck sockaddr; Unix.listen suck backlog; suck let init_callback callback timeout = let timeout_callback signo = if signo = Sys.sigalrm then raise Timeout in wrap_callback_w_timeout ~callback ~timeout ~timeout_callback (** try to close an outchannel connected to a socket, ignore Sys_error since * this probably means that socket is already closed (e.g. on sigpipe) *) let try_close_out ch = try close_out ch with Sys_error _ -> () (** like Unix.establish_server, but shutdown sockets when receiving SIGTERM and before exiting for an uncaught exception *) let my_establish_server server_fun sockaddr = let suck = init_socket sockaddr in while true do let (s, caller) = nice_unix_accept suck in (** "double fork" trick, see {!Unix.establish_server} implementation *) match Unix.fork() with | 0 -> (* parent *) (try if Unix.fork () <> 0 then exit 0; (* The son exits, the grandson works *) let inchan = Unix.in_channel_of_descr s in let outchan = Unix.out_channel_of_descr s in server_fun inchan outchan; try_close_out outchan; (* closes also inchan: socket is the same *) exit 0 with e -> shutdown_socket suck; (* clean up socket before exit *) raise e) | child when (child > 0) -> (* child *) Unix.close s; ignore (Unix.waitpid [] child) (* Reclaim the son *) | _ (* < 0 *) -> failwith "Can't fork" done (** tcp_server which forks a new process for each request *) let fork ~sockaddr ~timeout callback = let timeout_callback signo = if signo = Sys.sigalrm then exit 2 in my_establish_server (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback) sockaddr (** tcp_server which doesn't fork, requests are server sequentially and in the same address space of the calling process *) let simple ~sockaddr ~timeout callback = let suck = init_socket sockaddr in let callback = init_callback callback timeout in try while true do let (client, _) = Unix.accept suck in (* client is now connected *) let (inchan, outchan) = (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client) in (try callback inchan outchan; ignore (Unix.alarm 0) (* reset alarm *) with Timeout -> ()); try_close_out outchan (* this close also inchan: socket is the same *) done with e -> (* clean up socket before exit *) shutdown_socket suck; raise e (** tcp_server which creates a new thread for each request to be served *) let thread ~sockaddr ~timeout callback = let suck = init_socket sockaddr in let callback = init_callback callback timeout in let callback (i, o) = (try callback i o with | Timeout -> () | e -> try_close_out o; raise e); try_close_out o in while true do let (client, _) = nice_unix_accept suck in (* client is now connected *) let (inchan, outchan) = (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client) in Http_threaded_tcp_server.serve callback (inchan, outchan) done (** @param server an Http_types.tcp_server * @return an Http_types.tcp_server which takes care of ignoring SIGPIPE during * server execution and restoring previous handler when (if ever) the server * returns *) let handle_sigpipe server = fun ~sockaddr ~timeout callback -> let old_sigpipe_behavior = Sys.signal Sys.sigpipe Sys.Signal_ignore in server ~sockaddr ~timeout callback; ignore (Sys.signal Sys.sigpipe old_sigpipe_behavior) let simple = handle_sigpipe simple let thread = handle_sigpipe thread let fork = handle_sigpipe fork ocaml-http-0.1.6/http_tcp_server.mli000066400000000000000000000023351340603407200175060ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** TCP servers used as low-levels for HTTP daemons *) (** {2 servers} *) (** single process server *) val simple: Http_types.tcp_server (** multi threaded server *) val thread: Http_types.tcp_server (** multi process server *) val fork: Http_types.tcp_server (** {2 low level functions} *) (** initialize a passive socket listening on given Unix.sockaddr *) val init_socket: Unix.sockaddr -> Unix.file_descr ocaml-http-0.1.6/http_threaded_tcp_server.mli000066400000000000000000000016531340603407200213500ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Multithreaded part of Http_tcp_server *) (** serve an HTTP request for a multi threaded TCP server *) val serve : ('a -> 'b) -> 'a -> unit ocaml-http-0.1.6/http_types.ml000066400000000000000000000144501340603407200163260ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2007> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Type definitions *) type version = [ `HTTP_1_0 | `HTTP_1_1 ] type meth = [ `GET | `POST | `HEAD | `PUT | `DELETE | `OPTIONS | `TRACE] type daemon_mode = [ `Single | `Fork | `Thread ] type tcp_server = sockaddr:Unix.sockaddr -> timeout:int option -> (in_channel -> out_channel -> unit) -> unit type auth_info = [ `Basic of string * string (* username, password *) ] type informational_substatus = [ `Continue | `Switching_protocols ] type success_substatus = [ `OK | `Created | `Accepted | `Non_authoritative_information | `No_content | `Reset_content | `Partial_content ] type redirection_substatus = [ `Multiple_choices | `Moved_permanently | `Found | `See_other | `Not_modified | `Use_proxy | `Temporary_redirect ] type client_error_substatus = [ `Bad_request | `Unauthorized | `Payment_required | `Forbidden | `Not_found | `Method_not_allowed | `Not_acceptable | `Proxy_authentication_required | `Request_time_out | `Conflict | `Gone | `Length_required | `Precondition_failed | `Request_entity_too_large | `Request_URI_too_large | `Unsupported_media_type | `Requested_range_not_satisfiable | `Expectation_failed ] type server_error_substatus = [ `Internal_server_error | `Not_implemented | `Bad_gateway | `Service_unavailable | `Gateway_time_out | `HTTP_version_not_supported ] type informational_status = [ `Informational of informational_substatus ] type success_status = [ `Success of success_substatus ] type redirection_status = [ `Redirection of redirection_substatus ] type client_error_status = [ `Client_error of client_error_substatus ] type server_error_status = [ `Server_error of server_error_substatus ] type error_status = [ client_error_status | server_error_status ] type status = [ informational_status | success_status | redirection_status | client_error_status | server_error_status ] type status_code = [ `Code of int | `Status of status ] type file_source = | FileSrc of string | InChanSrc of in_channel exception Invalid_header of string exception Invalid_header_name of string exception Invalid_header_value of string exception Invalid_HTTP_version of string exception Invalid_HTTP_method of string exception Invalid_code of int exception Malformed_URL of string exception Malformed_query of string exception Malformed_query_part of string * string exception Malformed_request_URI of string exception Malformed_cookies of string exception Malformed_request of string exception Malformed_response of string exception Param_not_found of string exception Invalid_status_line of string exception Header_not_found of string exception Quit exception Unauthorized of string class type message = object method version: version option method setVersion: version -> unit method body: string method setBody: string -> unit method bodyBuf: Buffer.t method setBodyBuf: Buffer.t -> unit method addBody: string -> unit method addBodyBuf: Buffer.t -> unit method addHeader: name:string -> value:string -> unit method addHeaders: (string * string) list -> unit method replaceHeader: name:string -> value:string -> unit method replaceHeaders: (string * string) list -> unit method removeHeader: name:string -> unit method hasHeader: name:string -> bool method header: name:string -> string method headers: (string * string) list method clientSockaddr: Unix.sockaddr method clientAddr: string method clientPort: int method serverSockaddr: Unix.sockaddr method serverAddr: string method serverPort: int method toString: string method serialize: out_channel -> unit end class type request = object inherit message method meth: meth method uri: string method path: string method param: ?meth:meth -> ?default:string -> string -> string method paramAll: ?meth:meth -> string -> string list method params: (string * string) list method params_GET: (string * string) list method params_POST: (string * string) list method cookies: (string * string) list option method authorization: auth_info option end class type response = object inherit message method code: int method setCode: int -> unit method status: status method setStatus: status -> unit method reason: string method setReason: string -> unit method statusLine: string method setStatusLine: string -> unit method isInformational: bool method isSuccess: bool method isRedirection: bool method isClientError: bool method isServerError: bool method isError: bool method addBasicHeaders: unit method contentType: string method setContentType: string -> unit method contentEncoding: string method setContentEncoding: string -> unit method date: string method setDate: string -> unit method expires: string method setExpires: string -> unit method server: string method setServer: string -> unit method connection: string method setConnection: string -> unit end class type connection = object method getRequest: request option method respond_with: response -> unit method close: unit end class type daemon = object method accept: connection method getRequest: request * connection end type daemon_spec = { address: string; auth: (string * auth_info) option; callback: request -> out_channel -> unit; mode: daemon_mode; port: int; root_dir: string option; exn_handler: (exn -> out_channel -> unit) option; timeout: int option; auto_close: bool; } ocaml-http-0.1.6/http_types.mli000066400000000000000000000356751340603407200165130ustar00rootroot00000000000000(* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2007> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Type definitions *) (** HTTP version, actually only 1.0 and 1.1 are supported. Note that 'supported' here means only 'accepted inside a HTTP request line', no different behaviours are actually implemented depending on HTTP version *) type version = [ `HTTP_1_0 | `HTTP_1_1 ] (** HTTP method, actually only GET and POST methods are supported *) type meth = [ `GET | `POST | `HEAD | `PUT | `DELETE | `OPTIONS | `TRACE ] (** Daemon behaviour wrt request handling. `Single mode use a single process to handle all requests, no request is served until a previous one has been fully served. `Fork mode fork a new process for each request, the new process will execute the callback function and then exit. `Thread mode create a new thread for each request, the new thread will execute the callback function and then exit, threads can communicate using standard OCaml Thread library. *) type daemon_mode = [ `Single | `Fork | `Thread ] (** A TCP server is a function taking an address on which bind and listen for connections, an optional timeout after which abort client connections and a callback function which in turn takes an input and an output channel as arguments. After receiving this argument a TCP server sits and waits for connection, on each connection it apply the callback function to channels connected to client. *) type tcp_server = sockaddr:Unix.sockaddr -> timeout:int option -> (in_channel -> out_channel -> unit) -> unit (** authentication information *) type auth_info = [ `Basic of string * string (* username, password *) (* | `Digest of ... (* TODO digest authentication *) *) ] (** @see "RFC2616" informational HTTP status *) type informational_substatus = [ `Continue | `Switching_protocols ] (** @see "RFC2616" success HTTP status *) type success_substatus = [ `OK | `Created | `Accepted | `Non_authoritative_information | `No_content | `Reset_content | `Partial_content ] (** @see "RFC2616" redirection HTTP status *) type redirection_substatus = [ `Multiple_choices | `Moved_permanently | `Found | `See_other | `Not_modified | `Use_proxy | `Temporary_redirect ] (** @see "RFC2616" client error HTTP status *) type client_error_substatus = [ `Bad_request | `Unauthorized | `Payment_required | `Forbidden | `Not_found | `Method_not_allowed | `Not_acceptable | `Proxy_authentication_required | `Request_time_out | `Conflict | `Gone | `Length_required | `Precondition_failed | `Request_entity_too_large | `Request_URI_too_large | `Unsupported_media_type | `Requested_range_not_satisfiable | `Expectation_failed ] (** @see "RFC2616" server error HTTP status *) type server_error_substatus = [ `Internal_server_error | `Not_implemented | `Bad_gateway | `Service_unavailable | `Gateway_time_out | `HTTP_version_not_supported ] type informational_status = [ `Informational of informational_substatus ] type success_status = [ `Success of success_substatus ] type redirection_status = [ `Redirection of redirection_substatus ] type client_error_status = [ `Client_error of client_error_substatus ] type server_error_status = [ `Server_error of server_error_substatus ] type error_status = [ client_error_status | server_error_status ] (** HTTP status *) type status = [ informational_status | success_status | redirection_status | client_error_status | server_error_status ] type status_code = [ `Code of int | `Status of status ] (** File sources *) type file_source = | FileSrc of string (** filename *) | InChanSrc of in_channel (** input channel *) (** {2 Exceptions} *) (** invalid header encountered *) exception Invalid_header of string (** invalid header name encountered *) exception Invalid_header_name of string (** invalid header value encountered *) exception Invalid_header_value of string (** unsupported or invalid HTTP version encountered *) exception Invalid_HTTP_version of string (** unsupported or invalid HTTP method encountered *) exception Invalid_HTTP_method of string (** invalid HTTP status code integer representation encountered *) exception Invalid_code of int (** invalid URL encountered *) exception Malformed_URL of string (** invalid query string encountered *) exception Malformed_query of string (** invalid query string part encountered, arguments are parameter name and parameter value *) exception Malformed_query_part of string * string (** invalid request URI encountered *) exception Malformed_request_URI of string (** malformed cookies *) exception Malformed_cookies of string (** malformed request received *) exception Malformed_request of string (** malformed response received, argument is response's first line *) exception Malformed_response of string (** a parameter you were looking for was not found *) exception Param_not_found of string (** invalid HTTP status line encountered *) exception Invalid_status_line of string (** an header you were looking for was not found *) exception Header_not_found of string (** raisable by callbacks to make main daemon quit, this is the only * 'clean' way to make start functions return *) exception Quit (** raisable by callbacks to force a 401 (unauthorized) HTTP answer. * This exception should be raised _before_ sending any data over given out * channel. * @param realm authentication realm (usually needed to prompt user) *) exception Unauthorized of string (** {2 OO representation of HTTP messages} *) (** HTTP generic messages. See {! Http_message.message} *) class type message = object method version: version option method setVersion: version -> unit method body: string method setBody: string -> unit method bodyBuf: Buffer.t method setBodyBuf: Buffer.t -> unit method addBody: string -> unit method addBodyBuf: Buffer.t -> unit method addHeader: name:string -> value:string -> unit method addHeaders: (string * string) list -> unit method replaceHeader: name:string -> value:string -> unit method replaceHeaders: (string * string) list -> unit method removeHeader: name:string -> unit method hasHeader: name:string -> bool method header: name:string -> string method headers: (string * string) list method clientSockaddr: Unix.sockaddr method clientAddr: string method clientPort: int method serverSockaddr: Unix.sockaddr method serverAddr: string method serverPort: int method toString: string method serialize: out_channel -> unit end (** HTTP requests *) class type request = object (** an HTTP request is a flavour of HTTP message *) inherit message (** @return request method *) method meth: meth (** @return requested URI (including query string, fragment, ...) *) method uri: string (** @return requested path *) method path: string (** lookup a given parameter @param meth if given restrict the lookup area (e.g. if meth = POST than only parameters received via POST are searched), if not given both GET and POST parameter are searched in an unspecified order (actually the implementation prefers POST parameters but this is not granted, you've been warned) @param default if provided, this value will be returned in case no parameter of that name is available instead of raising Param_not_found @param name name of the parameter to lookup @return value associated to parameter name @raise Param_not_found if parameter name was not found *) method param: ?meth:meth -> ?default:string -> string -> string (** like param above but return a list of values associated to given parameter (a parameter could be defined indeed more than once: passed more than once in a query string or passed both insider the url (the GET way) and inside message body (the POST way)) *) method paramAll: ?meth:meth -> string -> string list (** @return the list of all received parameters *) method params: (string * string) list (** @return the list of all parameters received via GET *) method params_GET: (string * string) list (** @return the list of all parameter received via POST *) method params_POST: (string * string) list method cookies: (string * string) list option (** @return authorization information, if given by the client *) method authorization: auth_info option end (** HTTP responses *) class type response = object inherit message (** @return response code *) method code: int (** set response code *) method setCode: int -> unit (** @return response status *) method status: status (** set response status *) method setStatus: status -> unit (** @return reason string *) method reason: string (** set reason string *) method setReason: string -> unit (** @return status line *) method statusLine: string (** set status line @raise Invalid_status_line if an invalid HTTP status line was passed *) method setStatusLine: string -> unit (** response is an informational one *) method isInformational: bool (** response is a success one *) method isSuccess: bool (** response is a redirection one *) method isRedirection: bool (** response is a client error one *) method isClientError: bool (** response is a server error one *) method isServerError: bool (** response is either a client error or a server error response *) method isError: bool (** add basic headers to response, see {!Http_daemon.send_basic_headers} *) method addBasicHeaders: unit (** facilities to access some frequently used headers *) (** @return Content-Type header value *) method contentType: string (** set Content-Type header value *) method setContentType: string -> unit (** @return Content-Encoding header value *) method contentEncoding: string (** set Content-Encoding header value *) method setContentEncoding: string -> unit (** @return Date header value *) method date: string (** set Date header value *) method setDate: string -> unit (** @return Expires header value *) method expires: string (** set Expires header value *) method setExpires: string -> unit (** @return Server header value *) method server: string (** set Server header value *) method setServer: string -> unit (** @return Connection header value *) method connection: string (** set Connection header value *) method setConnection: string -> unit end (** {2 Daemon specification} *) (** daemon specification, describe the behaviour of an HTTP daemon. * * The default daemon specification is {!Http_daemon.default_spec} *) type daemon_spec = { address: string; (** @param address adress on which daemon will be listening, can be both a * numeric address (e.g. "127.0.0.1") and an hostname (e.g. "localhost") *) auth: (string * auth_info) option; (** authentication requirements (currently only basic authentication is * supported). If set to None no authentication is required. If set to Some * ("realm", `Basic ("foo", "bar")), only clients authenticated with baisc * authentication, for realm "realm", providing username "foo" and password * "bar" are accepted; others are rejected with a 401 response code *) callback: request -> out_channel -> unit; (** function which will be called each time a correct HTTP request will be * received. 1st callback argument is an Http_types.request object * corresponding to the request received; 2nd argument is an output channel * corresponding to the socket connected to the client *) mode: daemon_mode; (** requests handling mode, it can have three different values: * - `Single -> all requests will be handled by the same process, * - `Fork -> each request will be handled by a child process, * - `Thread -> each request will be handled by a (new) thread *) port: int; (** TCP port on which the daemon will be listening *) root_dir: string option; (** directory to which ocaml http will chdir before starting handling * requests; if None, no chdir will be performed (i.e. stay in the current * working directory) *) exn_handler: (exn -> out_channel -> unit) option; (** what to do when executing callback raises an exception. If None, the * exception will be re-raised: in `Fork/`Thread mode the current * process/thread will be terminated. in `Single mode the exception is * ignored and the client socket closed. If Some callback, the callback will * be executed before acting as per None; the callback is meant to perform * some clean up actions, like releasing global mutexes in `Thread mode *) timeout: int option; (** timeout in seconds after which an incoming HTTP request will be * terminated closing the corresponding TCP connection; None disable the * timeout *) auto_close: bool; (** whether ocaml-http will automatically close the connection with the * client after callback has completed its execution. If set to true, close * will be attempted no matter if the callback raises an exception or not *) } (** {2 OO representation of other HTTP entities} *) (** an HTTP connection from a client to a server *) class type connection = object (** @return next request object, may block if client hasn't submitted any request yet, may be None if client request was ill-formed *) method getRequest: request option (** respond to client sending it a response *) method respond_with: response -> unit (** close connection to client. Warning: this object can't be used any longer after this method has been called *) method close: unit end (** an HTTP daemon *) class type daemon = object (** @return a connection to a client, may block if no client has connected yet *) method accept: connection (** shortcut method, blocks until a client has submit a request and return a pair request * connection *) method getRequest: request * connection end ocaml-http-0.1.6/http_user_agent.ml000066400000000000000000000066741340603407200173270ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open Http_common exception Http_error of (int * string) (* code, body *) let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://" let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$" let tcp_bufsiz = 4096 (* for TCP I/O *) let parse_url url = try let subs = Pcre.extract ~rex:url_RE (Pcre.replace ~rex:http_scheme_RE url) in (subs.(1), (if subs.(2) = "" then 80 else int_of_string subs.(3)), (if subs.(4) = "" then "/" else subs.(4))) with exc -> failwith (sprintf "Can't parse url: %s (exception: %s)" url (Printexc.to_string exc)) let init_socket addr port = let inet_addr = (Unix.gethostbyname addr).Unix.h_addr_list.(0) in let sockaddr = Unix.ADDR_INET (inet_addr, port) in let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in Unix.connect suck sockaddr; let outchan = Unix.out_channel_of_descr suck in let inchan = Unix.in_channel_of_descr suck in (inchan, outchan) let submit_request kind url = let (address, port, path) = parse_url url in let (inchan, outchan) = init_socket address port in let req_string = match kind with `GET -> "GET" | `HEAD -> "HEAD" in output_string outchan (sprintf "%s %s HTTP/1.0\r\n" req_string path); output_string outchan (sprintf "Host: %s\r\n\r\n" address); flush outchan; (inchan, outchan) let head url = let (inchan, outchan) = submit_request `HEAD url in let (_, status) = Http_parser.parse_response_fst_line inchan in (match code_of_status status with | 200 -> () | code -> raise (Http_error (code, ""))); let buf = Http_misc.buf_of_inchan inchan in close_in inchan; (* close also outchan, same fd *) Buffer.contents buf let get_iter ?(head_callback = fun _ _ -> ()) callback url = let (inchan, outchan) = submit_request `GET url in let buf = Bytes.create tcp_bufsiz in let (_, status) = Http_parser.parse_response_fst_line inchan in (match code_of_status status with | 200 -> () | code -> raise (Http_error (code, ""))); let headers = Http_parser.parse_headers inchan in head_callback status headers; (try while true do match input inchan buf 0 tcp_bufsiz with | 0 -> raise End_of_file | bytes when bytes = tcp_bufsiz -> (* buffer full, no need to slice it *) callback buf | bytes when bytes < tcp_bufsiz -> (* buffer not full, slice it *) callback (Bytes.sub buf 0 bytes) | _ -> (* ( bytes < 0 ) || ( bytes > tcp_bufsiz ) *) assert false done with End_of_file -> ()); close_in inchan (* close also outchan, same fd *) let get ?head_callback url = let buf = Buffer.create 10240 in get_iter ?head_callback (Buffer.add_bytes buf) url; Buffer.contents buf ocaml-http-0.1.6/http_user_agent.mli000066400000000000000000000035711340603407200174710ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002-2005> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Minimal implementation of an HTTP 1.0/1.1 client. Interface is similar to * Gerd Stoplmann's Http_client module. Implementation is simpler and doesn't * handle HTTP redirection, proxies, ecc. The only reason for the existence of * this module is for performances and incremental elaboration of response's * bodies *) open Http_types exception Http_error of (int * string) (* code, body *) (** @param head_callback optional calllback invoked on response's status and * headers. If not provided no callback will be invoked * @param url an HTTP url * @return HTTP response's body * @raise Http_error when response code <> 200 *) val get: ?head_callback:(status -> (string * string) list -> unit) -> string -> string (** as above but iter callback function on HTTP response's body instead of * returning it as a string *) val get_iter: ?head_callback:(status -> (string * string) list -> unit) -> (bytes -> unit) -> string -> unit (** @param url an HTTP url * @return HTTP HEAD raw response * @raise Http_error when response code <> 200 *) val head: string -> string ocaml-http-0.1.6/mt/000077500000000000000000000000001340603407200142055ustar00rootroot00000000000000ocaml-http-0.1.6/mt/.gitignore000066400000000000000000000000351340603407200161730ustar00rootroot00000000000000http_threaded_tcp_server.mli ocaml-http-0.1.6/mt/http_threaded_tcp_server.ml000066400000000000000000000015671340603407200216230ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let serve callback arg = ignore (Thread.create callback arg) ocaml-http-0.1.6/non_mt/000077500000000000000000000000001340603407200150575ustar00rootroot00000000000000ocaml-http-0.1.6/non_mt/.gitignore000066400000000000000000000000351340603407200170450ustar00rootroot00000000000000http_threaded_tcp_server.mli ocaml-http-0.1.6/non_mt/http_threaded_tcp_server.ml000066400000000000000000000017241340603407200224700ustar00rootroot00000000000000 (* OCaml HTTP - do it yourself (fully OCaml) HTTP daemon Copyright (C) <2002> Stefano Zacchiroli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let serve _ _ = failwith ("Threaded server not supported by the non threaded version " ^ "of ocaml-http, please link against http_mt.cm{,x}a") ocaml-http-0.1.6/opam000066400000000000000000000010471340603407200144460ustar00rootroot00000000000000opam-version: "2.0" version: "0.1.6" maintainer: "claudio.sacerdoticoen@unibo.it" bug-reports: "https://github.com/sacerdot/ocaml-http/issues" homepage: "https://github.com/sacerdot/ocaml-http" authors: "Stefano Zacchiroli" dev-repo: "git+https://github.com/sacerdot/ocaml-http.git" build: [ [make "all"] [make "opt"] ] remove: [["ocamlfind" "remove" "http"]] depends: ["ocaml" {>="4.03.0"} "ocamlfind" {build} "ocamlnet" "pcre"] install: [make "install"] synopsis: "Library freely inspired from Perl's HTTP::Daemon module" flags: light-uninstall