+++ /dev/null
-cookie_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
-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_parser.cmi: http_types.cmi
-http_request.cmi: http_types.cmi
-http_response.cmi: http_types.cmi
-http_tcp_server.cmi: http_types.cmi
-http_user_agent.cmi: http_types.cmi
+++ /dev/null
-#use "topfind";;
-#require "unix";;
-#require "pcre";;
-#require "netstring";;
-#load "http.cma";;
+++ /dev/null
-
-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
-
+++ /dev/null
-
- 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.
-\f
- 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.
-\f
- 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.
-\f
- 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.
-\f
- 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.
-\f
- 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.
-\f
- 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.
-\f
- 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.
-\f
- 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
-\f
- 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.
-
- <one line to give the library's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- 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.
-
- <signature of Ty Coon>, 1 April 1990
- Ty Coon, President of Vice
-
-That's all there is to it!
-
+++ /dev/null
-description = "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"
+++ /dev/null
-include 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
+++ /dev/null
-PKGNAME = http
-DISTVERSION = $(shell dpkg-parsechangelog | egrep '^Version: ' | sed 's/^Version: //' | sed 's/-.*//')
-
-DEBUG_FLAGS =
-REQUIRES = unix str pcre netstring
-COMMON_FLAGS = $(DEBUG_FLAGS) -pp camlp4o -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
-
+++ /dev/null
-
-OCaml HTTP is a simple OCaml library for creating HTTP daemons, it is largely
-inspired to the Perl's HTTP:: modules family.
-
+++ /dev/null
-- support for HTTPS
+++ /dev/null
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 =
- [ `QSTRING of string
- | `SEP
- | `TOKEN of string
- | `ASSIGN
- | `EOF ]
-
-val token : Lexing.lexbuf -> cookie_token
-
+++ /dev/null
-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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <eric.stokes@csun.edu>
- for the patch)
-
- -- Stefano Zacchiroli <zack@debian.org> 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 <ecc@cmu.edu>:
- - 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 <zack@debian.org> 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 <zack@debian.org> Tue, 29 Mar 2005 11:39:24 +0200
-
-ocaml-http (0.1.0-1) unstable; urgency=low
-
- * first debian official package
-
- -- Stefano Zacchiroli <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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 <zack@debian.org> 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-<version>
- * Added 'Provides libhttp-ocaml-dev-<version>'
- * Removed GPL from debian/copyright, added reference to
- /usr/share/common-licenses/GPL
-
- -- Stefano Zacchiroli <zack@debian.org> 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 <zack@debian.org> Fri, 22 Nov 2002 11:29:37 +0100
-
-ocaml-http (0.0.3) unstable; urgency=low
-
- * First release.
-
- -- Stefano Zacchiroli <zack@debian.org> Sun, 17 Nov 2002 17:41:41 +0100
+++ /dev/null
-Source: ocaml-http
-Section: devel
-Priority: optional
-Maintainer: Stefano Zacchiroli <zack@debian.org>
-Build-Depends: debhelper (>> 5.0.0), cdbs, ocaml-nox (>= 3.10.0), camlp4 (>= 3.10.0), ocaml-findlib (>= 1.1), libpcre-ocaml-dev (>= 5.11.1), libocamlnet-ocaml-dev (>= 2.2)
-Standards-Version: 3.7.2
-
-Package: libhttp-ocaml-dev
-Architecture: any
-Depends: ocaml-nox-${F:OCamlABI}, libpcre-ocaml-dev (>= 5.11.1), libocamlnet-ocaml-dev (>= 2.2)
-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 to Perl's
- HTTP::Daemon module.
- .
- In order to implement an HTTP servers 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 could 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.
+++ /dev/null
-
-Author: Stefano Zacchiroli <zack@cs.unibo.it>
-
-Copyright:
-
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-/usr/lib/ocaml/@OCamlABI@
+++ /dev/null
-examples/*.ml
+++ /dev/null
-#!/usr/bin/make -f
-include /usr/share/cdbs/1/rules/debhelper.mk
-include /usr/share/cdbs/1/class/makefile.mk
-include /usr/share/cdbs/1/class/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)
+++ /dev/null
-tagsUrl=svn+ssh://zacchiro@mowgli.cs.unibo.it/local/svn/helm/tags/ocaml-http
+++ /dev/null
-include ../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))
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-*)
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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"
-
-let method_of_string = function
- | "GET" -> `GET
- | "POST" -> `POST
- | invalid_method -> raise (Invalid_HTTP_method invalid_method)
-
-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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
- (** 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 = false
-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
-
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 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
-
- (* FIXME duplication of code between this and response#addBasicHeaders *)
-let send_basic_headers ?(version = http_version) ~(code: status_code) outchan =
- send_status_line' ~version (int_of_code code) outchan;
- send_headers
- ~headers:["Date", Http_misc.date_822 (); "Server", server_string]
- 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
-"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
-<HTML><HEAD>
-<TITLE>%d %s</TITLE>
-</HEAD><BODY>
-<H1>%d - %s</H1>%s
-</BODY></HTML>"
- 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 ?(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
-
- (** 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 = String.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 "<html>\n<head><title>%s</title></head>\n<body>\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 "<a href=\"%s/\">%s/</a><br />\n" d d)
- (List.sort compare dirs);
- List.iter
- (fun f -> fprintf outchan "<a href=\"%s\">%s</a><br />\n" f f)
- (List.sort compare files);
- fprintf outchan "</body>\n</html>";
- 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>'" ^
- "<br />\nwhile received request 1st line was:<br />\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 () ->
- (* XXX the pair flush + shutdown is a temporary solution since double
- * close on a socket make ocaml 3.09.2 segfault (see
- * http://caml.inria.fr/mantis/view.php?id=4059). The right thing to
- * do is probably invoke try_close outchan here *)
- flush outchan;
- try
- Unix.shutdown (Unix.descr_of_out_channel outchan) Unix.SHUTDOWN_ALL
- with Unix.Unix_error(_, "shutdown", "") -> ())
- (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)
- ()
-=
- { default_spec with
- address = address;
- auth = auth;
- auto_close = auto_close;
- callback = callback;
- mode = mode;
- port = port;
- root_dir = root_dir;
- exn_handler = exn_handler;
- timeout = timeout;
- }
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
- (** like send_status_line but additionally will also send "Date" and "Server"
- 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 <header, value> *)
-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, 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
-
- (** 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 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 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 name in
- hashtbl_remove_all _headers name
- method hasHeader ~name =
- let name = String.lowercase name in
- Hashtbl.mem _headers name
- method header ~name =
- if not (self#hasHeader name) then raise (Header_not_found name);
- let name = String.lowercase 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 = String.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_substring 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_substring 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
- | [] -> raise (Malformed_query query)
- | 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 =
- prerr_endline ("raw 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
- | [ `TOKEN n ; `ASSIGN ; (`TOKEN v | `QSTRING v) ] ->
- prerr_endline ("found cookie " ^ n ^ " " ^ v);
- [ (n,v) ]
- | `TOKEN n :: `ASSIGN :: (`TOKEN v | `QSTRING v) :: `SEP :: tl ->
- prerr_endline ("found cookie " ^ n ^ " " ^ v);
- (n,v) :: aux tl
- | _ -> 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)
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 <attribute name,
- * attribute value>. 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 <path, query_params> where path is a string representing the
- requested path and query_params is a list of pairs <name, value> (the GET
- parameters) *)
-val parse_request: in_channel -> string * (string * string) list
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 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 *)
- if meth = `POST then
- 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 *)
- else (* TODO empty body for methods other than POST, is ok? *)
- ""
- in
- (headers, body))
- in
- let cookies =
- try
- let _hdr, raw_cookies =
- List.find
- (fun (hdr, _cookie) -> String.lowercase 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 `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 `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
-
+++ /dev/null
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
- (* FIXME duplication of code between this and send_basic_headers *)
- method addBasicHeaders =
- self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
- self#addHeader ~name:"Server" ~value:server_string
-
- 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 private fstLineToString =
- sprintf "%s %d %s" self#getRealVersion self#code self#reason
-
- end
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
-
+++ /dev/null
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 ]
-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
- 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;
-}
-
+++ /dev/null
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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
- ]
-
- (** 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
-
- 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
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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 = String.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 (String.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_string buf) url;
- Buffer.contents buf
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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) ->
- (string -> unit) -> string ->
- unit
-
- (** @param url an HTTP url
- * @return HTTP HEAD raw response
- * @raise Http_error when response code <> 200 *)
-val head: string -> string
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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)
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- 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")
-
projects / helm.git / commitdiff