From ccdf10e3eed0a9f2b0fc7735fdea537f3e147e5d Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Mon, 16 Jul 2007 14:00:47 +0000 Subject: [PATCH] [svn-buildpackage] Tagging ocaml-http (0.1.4-1) --- 0.1.4-1/.depend | 51 +++ 0.1.4-1/.ocamlinit | 5 + 0.1.4-1/INSTALL | 37 ++ 0.1.4-1/LICENSE | 483 +++++++++++++++++++++ 0.1.4-1/META.in | 8 + 0.1.4-1/Makefile | 150 +++++++ 0.1.4-1/Makefile.defs | 25 ++ 0.1.4-1/README | 4 + 0.1.4-1/TODO | 1 + 0.1.4-1/cookie_lexer.mli | 29 ++ 0.1.4-1/cookie_lexer.mll | Bin 0 -> 1567 bytes 0.1.4-1/debian/changelog | 215 +++++++++ 0.1.4-1/debian/compat | 1 + 0.1.4-1/debian/control | 23 + 0.1.4-1/debian/copyright | 15 + 0.1.4-1/debian/dirs.in | 1 + 0.1.4-1/debian/doc-base | 12 + 0.1.4-1/debian/docs | 2 + 0.1.4-1/debian/examples | 1 + 0.1.4-1/debian/rules | 13 + 0.1.4-1/debian/svn-deblayout | 1 + 0.1.4-1/examples/Makefile | 41 ++ 0.1.4-1/examples/always_ok_daemon.ml | 33 ++ 0.1.4-1/examples/basic_auth.ml | 50 +++ 0.1.4-1/examples/chdir.ml | 34 ++ 0.1.4-1/examples/client_address.ml | 42 ++ 0.1.4-1/examples/damned_recursion.ml | 51 +++ 0.1.4-1/examples/dump_args.ml | 57 +++ 0.1.4-1/examples/highlander.ml | 41 ++ 0.1.4-1/examples/oo_daemon.ml | 47 ++ 0.1.4-1/examples/threads.ml | 63 +++ 0.1.4-1/examples/timeout.ml | 31 ++ 0.1.4-1/examples/webfsd.ml | 50 +++ 0.1.4-1/http_common.ml | 162 +++++++ 0.1.4-1/http_common.mli | 80 ++++ 0.1.4-1/http_constants.ml | 36 ++ 0.1.4-1/http_constants.mli | 44 ++ 0.1.4-1/http_daemon.ml | 474 ++++++++++++++++++++ 0.1.4-1/http_daemon.mli | 186 ++++++++ 0.1.4-1/http_message.ml | 118 +++++ 0.1.4-1/http_message.mli | 130 ++++++ 0.1.4-1/http_misc.ml | 154 +++++++ 0.1.4-1/http_misc.mli | 94 ++++ 0.1.4-1/http_parser.ml | 182 ++++++++ 0.1.4-1/http_parser.mli | 75 ++++ 0.1.4-1/http_parser_sanity.ml | 115 +++++ 0.1.4-1/http_parser_sanity.mli | 46 ++ 0.1.4-1/http_request.ml | 158 +++++++ 0.1.4-1/http_request.mli | 28 ++ 0.1.4-1/http_response.ml | 118 +++++ 0.1.4-1/http_response.mli | 33 ++ 0.1.4-1/http_tcp_server.ml | 172 ++++++++ 0.1.4-1/http_tcp_server.mli | 39 ++ 0.1.4-1/http_threaded_tcp_server.mli | 26 ++ 0.1.4-1/http_types.ml | 221 ++++++++++ 0.1.4-1/http_types.mli | 459 ++++++++++++++++++++ 0.1.4-1/http_user_agent.ml | 101 +++++ 0.1.4-1/http_user_agent.mli | 53 +++ 0.1.4-1/mt/http_threaded_tcp_server.ml | 23 + 0.1.4-1/non_mt/http_threaded_tcp_server.ml | 26 ++ 60 files changed, 4970 insertions(+) create mode 100644 0.1.4-1/.depend create mode 100644 0.1.4-1/.ocamlinit create mode 100644 0.1.4-1/INSTALL create mode 100644 0.1.4-1/LICENSE create mode 100644 0.1.4-1/META.in create mode 100644 0.1.4-1/Makefile create mode 100644 0.1.4-1/Makefile.defs create mode 100644 0.1.4-1/README create mode 100644 0.1.4-1/TODO create mode 100644 0.1.4-1/cookie_lexer.mli create mode 100644 0.1.4-1/cookie_lexer.mll create mode 100644 0.1.4-1/debian/changelog create mode 100644 0.1.4-1/debian/compat create mode 100644 0.1.4-1/debian/control create mode 100644 0.1.4-1/debian/copyright create mode 100644 0.1.4-1/debian/dirs.in create mode 100644 0.1.4-1/debian/doc-base create mode 100644 0.1.4-1/debian/docs create mode 100644 0.1.4-1/debian/examples create mode 100755 0.1.4-1/debian/rules create mode 100644 0.1.4-1/debian/svn-deblayout create mode 100644 0.1.4-1/examples/Makefile create mode 100644 0.1.4-1/examples/always_ok_daemon.ml create mode 100644 0.1.4-1/examples/basic_auth.ml create mode 100644 0.1.4-1/examples/chdir.ml create mode 100644 0.1.4-1/examples/client_address.ml create mode 100644 0.1.4-1/examples/damned_recursion.ml create mode 100644 0.1.4-1/examples/dump_args.ml create mode 100644 0.1.4-1/examples/highlander.ml create mode 100644 0.1.4-1/examples/oo_daemon.ml create mode 100644 0.1.4-1/examples/threads.ml create mode 100644 0.1.4-1/examples/timeout.ml create mode 100644 0.1.4-1/examples/webfsd.ml create mode 100644 0.1.4-1/http_common.ml create mode 100644 0.1.4-1/http_common.mli create mode 100644 0.1.4-1/http_constants.ml create mode 100644 0.1.4-1/http_constants.mli create mode 100644 0.1.4-1/http_daemon.ml create mode 100644 0.1.4-1/http_daemon.mli create mode 100644 0.1.4-1/http_message.ml create mode 100644 0.1.4-1/http_message.mli create mode 100644 0.1.4-1/http_misc.ml create mode 100644 0.1.4-1/http_misc.mli create mode 100644 0.1.4-1/http_parser.ml create mode 100644 0.1.4-1/http_parser.mli create mode 100644 0.1.4-1/http_parser_sanity.ml create mode 100644 0.1.4-1/http_parser_sanity.mli create mode 100644 0.1.4-1/http_request.ml create mode 100644 0.1.4-1/http_request.mli create mode 100644 0.1.4-1/http_response.ml create mode 100644 0.1.4-1/http_response.mli create mode 100644 0.1.4-1/http_tcp_server.ml create mode 100644 0.1.4-1/http_tcp_server.mli create mode 100644 0.1.4-1/http_threaded_tcp_server.mli create mode 100644 0.1.4-1/http_types.ml create mode 100644 0.1.4-1/http_types.mli create mode 100644 0.1.4-1/http_user_agent.ml create mode 100644 0.1.4-1/http_user_agent.mli create mode 100644 0.1.4-1/mt/http_threaded_tcp_server.ml create mode 100644 0.1.4-1/non_mt/http_threaded_tcp_server.ml diff --git a/0.1.4-1/.depend b/0.1.4-1/.depend new file mode 100644 index 000000000..b514ab3f2 --- /dev/null +++ b/0.1.4-1/.depend @@ -0,0 +1,51 @@ +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 diff --git a/0.1.4-1/.ocamlinit b/0.1.4-1/.ocamlinit new file mode 100644 index 000000000..64694a213 --- /dev/null +++ b/0.1.4-1/.ocamlinit @@ -0,0 +1,5 @@ +#use "topfind";; +#require "unix";; +#require "pcre";; +#require "netstring";; +#load "http.cma";; diff --git a/0.1.4-1/INSTALL b/0.1.4-1/INSTALL new file mode 100644 index 000000000..dc1a772e1 --- /dev/null +++ b/0.1.4-1/INSTALL @@ -0,0 +1,37 @@ + +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 + diff --git a/0.1.4-1/LICENSE b/0.1.4-1/LICENSE new file mode 100644 index 000000000..f1c4ea8c3 --- /dev/null +++ b/0.1.4-1/LICENSE @@ -0,0 +1,483 @@ + + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + diff --git a/0.1.4-1/META.in b/0.1.4-1/META.in new file mode 100644 index 000000000..8c325462e --- /dev/null +++ b/0.1.4-1/META.in @@ -0,0 +1,8 @@ +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" diff --git a/0.1.4-1/Makefile b/0.1.4-1/Makefile new file mode 100644 index 000000000..b3d74b10b --- /dev/null +++ b/0.1.4-1/Makefile @@ -0,0 +1,150 @@ +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 diff --git a/0.1.4-1/Makefile.defs b/0.1.4-1/Makefile.defs new file mode 100644 index 000000000..f174b02f8 --- /dev/null +++ b/0.1.4-1/Makefile.defs @@ -0,0 +1,25 @@ +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 + diff --git a/0.1.4-1/README b/0.1.4-1/README new file mode 100644 index 000000000..1566b8e8b --- /dev/null +++ b/0.1.4-1/README @@ -0,0 +1,4 @@ + +OCaml HTTP is a simple OCaml library for creating HTTP daemons, it is largely +inspired to the Perl's HTTP:: modules family. + diff --git a/0.1.4-1/TODO b/0.1.4-1/TODO new file mode 100644 index 000000000..7fc3c6bb6 --- /dev/null +++ b/0.1.4-1/TODO @@ -0,0 +1 @@ +- support for HTTPS diff --git a/0.1.4-1/cookie_lexer.mli b/0.1.4-1/cookie_lexer.mli new file mode 100644 index 000000000..4458d36c7 --- /dev/null +++ b/0.1.4-1/cookie_lexer.mli @@ -0,0 +1,29 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2007> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +type cookie_token = + [ `QSTRING of string + | `SEP + | `TOKEN of string + | `ASSIGN + | `EOF ] + +val token : Lexing.lexbuf -> cookie_token + diff --git a/0.1.4-1/cookie_lexer.mll b/0.1.4-1/cookie_lexer.mll new file mode 100644 index 0000000000000000000000000000000000000000..e665e26aba8125fb25f90d92cd6949e283d731d0 GIT binary patch literal 1567 zcma)6VQ(Tg5bbCFL`QsCNPz>Q>eP};Z!dxbT@EO_=#&Q9m|ZVxWwANio0R6F{`EfZ zZW5waZH>m*!_4!Wc{Yus8qxHOZ8N$E!x^&Hds)<^G_AL5RFO50xDHIuu7SAJnu!8(VA0kIC|T{(I|>OkHd@UA|!uuMW6lo z+@FM31H{@?;a7ggOC+(~Wda=09nGZOqe=jL8qUuykl}wAUyj2oLT5(fa54-68cpZq z)6AcT77jTP8A7lzs(u3{=o`xY>Zz^@%OYqbZg?H-~Br&ZfC@P>cw^Sx_>%a`Ierj~&nE}R zxM2Pz$D=S}BM%r2r=!C#tX-sx-ARc+TPx62?XgzVIUH4!2yBhJRbT1aBYc+DP0~%; zThT)mnDO7&c|wmxq*wQ-as4addxgaMa=EP6n@4Vs=Shg=TZid}6Q>**xA+Od;Qz+S z(7|S7(<&UV?^WcJ0?*MVUq6NRsNsOx)NdZ9Ju6-1R(KWXfrnxW=_<#&!cq0O^tqb; z)&%nYg!3D(?S1RI;$b?0A>BKLwP3*ZeuVu5d*eOT;We;r!dz!pum{*9>^*F`^j6>f YOSf*yoARocB}ooV4+e^I>O Mon, 16 Jul 2007 15:57:42 +0200 + +ocaml-http (0.1.3-2) unstable; urgency=low + + * debian/control.in + - file removed, no longer needed + * debian/control + - bumped dependencies on pcre-ocaml and ocamlnet + * debian/rules + - binNMU safe substitution of variables in .in files + * debian/dirs + - file removed, will be generated at build time + + -- Stefano Zacchiroli Fri, 15 Sep 2006 00:29:56 +0200 + +ocaml-http (0.1.3-1) unstable; urgency=low + + * force bash as SHELL in Makefile, since we rely on bashisms + (closes: bug#381915) + * removed Http_daemon.{start,start'}, they have been deprecated a while ago + in favour of Http_daemon.main + * added 'auto_close' to daemon specifications. When set to true (defaults to + false), makes ocaml-http close every connection with client just after + having executed a callback, no matter if that callback succeeds or fails + with an exception + + -- Stefano Zacchiroli Sun, 20 Aug 2006 18:07:41 +0200 + +ocaml-http (0.1.2-4) unstable; urgency=low + + * Rebuilt against ocaml 3.09.2, bumped deps accordingly. + * debian/control + - Bumped Standards-Version to 3.7.2 (no changes needed) + + -- Stefano Zacchiroli Wed, 17 May 2006 05:18:32 +0000 + +ocaml-http (0.1.2-3) unstable; urgency=low + + * Rebuilt against OCaml 3.09.1, bumped deps accordingly. + + -- Stefano Zacchiroli Sun, 8 Jan 2006 13:13:07 +0100 + +ocaml-http (0.1.2-2) unstable; urgency=low + + * rebuilt with ocaml 3.09 + * debian/* + - no more hardcoding of ocaml abi version anywhere + * debian/rules + - use cdbs + + -- Stefano Zacchiroli Sat, 26 Nov 2005 20:28:26 +0100 + +ocaml-http (0.1.2-1) unstable; urgency=low + + * avoid exceptions for closing connection twice during finaliztion of + connection objects (thanks to Eric Strokes + for the patch) + + -- Stefano Zacchiroli Wed, 14 Sep 2005 18:03:40 +0200 + +ocaml-http (0.1.1-1) unstable; urgency=low + + * added ?default parameter to "param" method + * fixed bug in response status line parsing + * integrated patch for HTTP/1.1 persistent connections from + Eric Cooper : + - added support for persistent connections to http_daemon.ml: server + now loops until End_of_file (or any exception) occurs when trying + to parse the next request + * debian/control + - bumped pcre and ocamlnet dependencies + - bumped standards-version to 3.6.2 + + -- Stefano Zacchiroli Wed, 16 Mar 2005 09:24:07 +0100 + +ocaml-http (0.1.0-2) unstable; urgency=low + + * rebuilt against ocaml 3.08.3 + + -- Stefano Zacchiroli Tue, 29 Mar 2005 11:39:24 +0200 + +ocaml-http (0.1.0-1) unstable; urgency=low + + * first debian official package + + -- Stefano Zacchiroli Tue, 8 Feb 2005 22:45:54 +0100 + +ocaml-http (0.1.0) unstable; urgency=low + + * added "daemon specifications": a unified way of specifying daemons + behaviour including old parameters of Http_daemon.start together + with authentication requirements and exception handling + * added new way of building daemons starting from specifications, old + ways (e.g. Http_daemon.start) are now deprecated + * added sigpipe handling to avoid daemons dying for uncaught signals + * added exception handler (as part of a daemon specification), it can + be used to ensure that some code is execute before a process/thread + die for uncaught exception (e.g. unlocking a global mutex) + * added authentication requirements (as part of a daemon + specification): an handy way to specify required user name and + password for HTTP basic authentication + * added head_callback to Http_user_agent in order to have access to + response status and headers in HTTP requests + * changed license from GPL to LGPL + * improved ocamldoc documentation and debian packaging + + -- Stefano Zacchiroli Thu, 3 Feb 2005 23:08:14 +0100 + +ocaml-http (0.0.10) unstable; urgency=low + + * renamed Http_client module to Http_user_agent to avoid compatibility + issues with Netclient. Renamed that module functions removing + "http_" prefix (e.g., summarizing, Http_client.http_get -> + Http_user_agent.get) + * ported to ocaml 3.08 + * debian/control + - bumped standards version to 3.6.1.1 + - changed deps to ocaml 3.08 and -nox + + -- Stefano Zacchiroli Thu, 5 Aug 2004 15:06:49 +0200 + +ocaml-http (0.0.9) unstable; urgency=low + + * Added support for HTTP Basic authentication + * Restyled Http_daemon API so that correct invocations of them are + statically typechecked + * Added support for HEAD requests to Http_client + * ~addr parameter now support not only ip addresses but also hostnames + * debian/control + - bumped Standards-Version to 3.6.1.0 + * debian/rules + - moved debhelper compatibility level to debian/compat + + -- Stefano Zacchiroli Tue, 16 Dec 2003 18:01:41 +0100 + +ocaml-http (0.0.8) unstable; urgency=low + + * Added support for "ancient" HTTP requests which specify no HTTP + version + - 'version' method on message now has type 'version option' + * Http_daemon now use debugging prints from Http_common like other + modules + * Added debugging print of requests parse error + * Shutdown server socket on abnormal exit (actually: uncaught + exceptions or SIGTERM received) + * Added a lot of ocamldoc documentation + * Added minimal HTTP 1.0/1.1 client support + + -- Stefano Zacchiroli Fri, 10 Jan 2003 10:36:53 +0100 + +ocaml-http (0.0.7) unstable; urgency=low + + * Added support for POST requests + * Implemented a commont 'message' class from which 'request' and + 'response' inherit + * Changed constructor of 'request' objects, requests are now buildable + directly (and only) from an input channel + * Added client IP address information to Http_request.request class + * Added OO daemon interfaces ("daemon" and "connection" classes) + * Use Pcre to perform sanity test on headers instead of home made + parsing + * Callback functions can raise Http_types.Quit to have main daemon + quit + * Case-insensitive handling of header names + + -- Stefano Zacchiroli Wed, 25 Dec 2002 16:22:31 +0100 + +ocaml-http (0.0.6) unstable; urgency=low + + * Ship multithreaded and non multithreaded cm{x,}aS + * Added support for multiple binding of the same parameter in request + objects (new method 'paramAll') + * Added support for 'empty' bindings in query arguments (e.g. + "/foo?b=" or "/foo?b") + * Added some sanity checks + * Bumped Standards-Version to 3.5.8 + * Use versioned dependencies lib{pcre,ocamlnet}-ocaml-dev- + * Added 'Provides libhttp-ocaml-dev-' + * Removed GPL from debian/copyright, added reference to + /usr/share/common-licenses/GPL + + -- Stefano Zacchiroli Mon, 25 Nov 2002 11:04:49 +0100 + +ocaml-http (0.0.5) unstable; urgency=low + + * Fixed bug for HTTP encoded GET parameters which contain '?' or '&' + characters + * Added support for chdir in a given document root before starting + * Added support for multi threaded daemons + * Added a generic 'Http_daemon.respond' function + * Added 'toString' method to response objects + + -- Stefano Zacchiroli Fri, 22 Nov 2002 11:29:37 +0100 + +ocaml-http (0.0.3) unstable; urgency=low + + * First release. + + -- Stefano Zacchiroli Sun, 17 Nov 2002 17:41:41 +0100 diff --git a/0.1.4-1/debian/compat b/0.1.4-1/debian/compat new file mode 100644 index 000000000..7ed6ff82d --- /dev/null +++ b/0.1.4-1/debian/compat @@ -0,0 +1 @@ +5 diff --git a/0.1.4-1/debian/control b/0.1.4-1/debian/control new file mode 100644 index 000000000..78524675a --- /dev/null +++ b/0.1.4-1/debian/control @@ -0,0 +1,23 @@ +Source: ocaml-http +Section: devel +Priority: optional +Maintainer: Stefano Zacchiroli +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. diff --git a/0.1.4-1/debian/copyright b/0.1.4-1/debian/copyright new file mode 100644 index 000000000..38cb08c98 --- /dev/null +++ b/0.1.4-1/debian/copyright @@ -0,0 +1,15 @@ + +Author: Stefano Zacchiroli + +Copyright: + + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + 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 + diff --git a/0.1.4-1/debian/dirs.in b/0.1.4-1/debian/dirs.in new file mode 100644 index 000000000..330aaf420 --- /dev/null +++ b/0.1.4-1/debian/dirs.in @@ -0,0 +1 @@ +/usr/lib/ocaml/@OCamlABI@ diff --git a/0.1.4-1/debian/doc-base b/0.1.4-1/debian/doc-base new file mode 100644 index 000000000..29b950dab --- /dev/null +++ b/0.1.4-1/debian/doc-base @@ -0,0 +1,12 @@ +Document: ocaml-http +Title: OCaml HTTP API reference manual +Author: Stefano Zacchiroli +Abstract: API reference manual for OCaml HTTP, an Objective Caml library for writing HTTP servers +Section: Apps/Programming + +Format: HTML +Index: /usr/share/doc/libhttp-ocaml-dev/html/index.html +Files: /usr/share/doc/libhttp-ocaml-dev/html/* + +Format: PostScript +Files: /usr/share/doc/libhttp-ocaml-dev/ocaml-http.ps.gz diff --git a/0.1.4-1/debian/docs b/0.1.4-1/debian/docs new file mode 100644 index 000000000..2e098492d --- /dev/null +++ b/0.1.4-1/debian/docs @@ -0,0 +1,2 @@ +README +doc/* diff --git a/0.1.4-1/debian/examples b/0.1.4-1/debian/examples new file mode 100644 index 000000000..6e72ae207 --- /dev/null +++ b/0.1.4-1/debian/examples @@ -0,0 +1 @@ +examples/*.ml diff --git a/0.1.4-1/debian/rules b/0.1.4-1/debian/rules new file mode 100755 index 000000000..51b217617 --- /dev/null +++ b/0.1.4-1/debian/rules @@ -0,0 +1,13 @@ +#!/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 + +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) diff --git a/0.1.4-1/debian/svn-deblayout b/0.1.4-1/debian/svn-deblayout new file mode 100644 index 000000000..24b49c381 --- /dev/null +++ b/0.1.4-1/debian/svn-deblayout @@ -0,0 +1 @@ +tagsUrl=svn+ssh://zacchiro@mowgli.cs.unibo.it/local/svn/helm/tags/ocaml-http diff --git a/0.1.4-1/examples/Makefile b/0.1.4-1/examples/Makefile new file mode 100644 index 000000000..9209563f6 --- /dev/null +++ b/0.1.4-1/examples/Makefile @@ -0,0 +1,41 @@ +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)) diff --git a/0.1.4-1/examples/always_ok_daemon.ml b/0.1.4-1/examples/always_ok_daemon.ml new file mode 100644 index 000000000..caa0d4516 --- /dev/null +++ b/0.1.4-1/examples/always_ok_daemon.ml @@ -0,0 +1,33 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_types + + (* start an http daemon that alway respond with a 200 status code and an empty + content *) +let spec = + { Http_daemon.default_spec with + callback = (fun _ outchan -> Http_daemon.respond outchan); + port = 9999; + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/basic_auth.ml b/0.1.4-1/examples/basic_auth.ml new file mode 100644 index 000000000..bdfb2b949 --- /dev/null +++ b/0.1.4-1/examples/basic_auth.ml @@ -0,0 +1,50 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_types + +(* the easy way: specify authentication requirements within a daemon_spec *) +let spec = + { Http_daemon.default_spec with + (* requires basic authentication, username "foo", password "bar" *) + auth = Some ("my realm", `Basic ("foo", "bar")); + callback = (fun _ outchan -> Http_daemon.respond ~body:"secret" outchan); + port = 9999; + } + +(* +(* the hard^Wother way: manual handling of authorization *) +let callback req outchan = + match req#authorization with + | Some (`Basic (username, password)) + when username = "foo" && password = "bar" -> + Http_daemon.respond ~code:(`Code 200) ~body:"secret" outchan + | _ -> raise (Unauthorized "my secret site") + +let spec = + { Http_daemon.default_spec with + callback = callback; + port = 9999; + } +*) + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/chdir.ml b/0.1.4-1/examples/chdir.ml new file mode 100644 index 000000000..bcba1ebc3 --- /dev/null +++ b/0.1.4-1/examples/chdir.ml @@ -0,0 +1,34 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Printf +open Http_types + +let spec = + { Http_daemon.default_spec with + callback = (fun _ outchan -> + Http_daemon.respond ~body:(sprintf "%s\n" (Sys.getcwd ())) outchan); + port = 9999; + root_dir = Some "/etc"; + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/client_address.ml b/0.1.4-1/examples/client_address.ml new file mode 100644 index 000000000..79d4ff836 --- /dev/null +++ b/0.1.4-1/examples/client_address.ml @@ -0,0 +1,42 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Printf +open Http_types + +let callback req outchan = + let body = + sprintf + "Hi, this is your personal assistant, you are connected from %s:%d\n" + req#clientAddr + req#clientPort + in + let res = new Http_response.response ~body () in + Http_daemon.respond_with res outchan + +let spec = + { Http_daemon.default_spec with + callback = callback; + port = 9999 + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/damned_recursion.ml b/0.1.4-1/examples/damned_recursion.ml new file mode 100644 index 000000000..be2e30629 --- /dev/null +++ b/0.1.4-1/examples/damned_recursion.ml @@ -0,0 +1,51 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Printf +open Http_types + +let port = 9999 + +let callback (req: Http_types.request) outchan = + let i = int_of_string (req#param "x") in + let body = + match i with + | 0 -> "0" + | x when x > 0 -> + let data = + Http_user_agent.get (sprintf "http://127.0.0.1:%d/foo?x=%d" + port (x - 1)) + in + sprintf "%s %d" data x + | _ -> assert false + in + Http_daemon.respond ~code:(`Code 200) ~body outchan; + close_out outchan (* Http_user_agent relies on EOF, not Content-Length *) + +let spec = + { Http_daemon.default_spec with + callback = callback; + port = port; + mode = `Thread; + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/dump_args.ml b/0.1.4-1/examples/dump_args.ml new file mode 100644 index 000000000..e8a66a57f --- /dev/null +++ b/0.1.4-1/examples/dump_args.ml @@ -0,0 +1,57 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2007> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Printf +open Http_types + +let callback req outchan = + let str = + (sprintf "request path = %s\n" req#path) ^ + (sprintf "request GET params = %s\n" + (String.concat ";" + (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_GET))) ^ + (sprintf "request POST params = %s\n" + (String.concat ";" + (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_POST))) ^ + (sprintf "request ALL params = %s\n" + (String.concat ";" + (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params))) ^ + (sprintf "cookies = %s\n" + (match req#cookies with + | None -> + "NO COOKIES " + ^ (if req#hasHeader ~name:"cookie" + then "('Cookie:' header was '" ^ req#header ~name:"cookie" ^ "')" + else "(No 'Cookie:' header received)") + | Some cookies -> + (String.concat ";" + (List.map (fun (n,v) -> String.concat "=" [n;v]) cookies)))) ^ + (sprintf "request BODY = '%s'\n\n" req#body) + in + Http_daemon.respond ~code:(`Code 200) ~body: str outchan + +let spec = + { Http_daemon.default_spec with + callback = callback; + port = 9999; + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/highlander.ml b/0.1.4-1/examples/highlander.ml new file mode 100644 index 000000000..d42445481 --- /dev/null +++ b/0.1.4-1/examples/highlander.ml @@ -0,0 +1,41 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +(* test for fast rebinding of the tcp port *) + +open Printf +open Http_types + +let spec = + { Http_daemon.default_spec with + callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan); + port = 9999; + mode = `Single; + } + +let _ = + Sys.catch_break true; + while true do + try + Http_daemon.main spec; + with Sys.Break -> prerr_endline "RESURRECTION!!!!" + done + diff --git a/0.1.4-1/examples/oo_daemon.ml b/0.1.4-1/examples/oo_daemon.ml new file mode 100644 index 000000000..91197e3f7 --- /dev/null +++ b/0.1.4-1/examples/oo_daemon.ml @@ -0,0 +1,47 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_daemon +open Http_response + + (* the simple way *) +let d = new daemon ~addr:"127.0.0.1" ~port:9999 () + +let _ = + while true do + let (req, conn) = d#getRequest in (* wait for valid request *) + conn#respond_with (new response ~body:"foo\n" ()); + conn#close + done + +(* + (* the hard^Wother way *) +let d = new daemon ~addr:"127.0.0.1" ~port:9999 () in +let _ = + while true do + let conn = d#accept in (* wait for client connection *) + (match conn#getRequest with + | None -> () (* invalid request received *) + | Some req -> conn#respond_with (new response ~body:"foo\n" ())); + conn#close (* close socket *) + done +*) + diff --git a/0.1.4-1/examples/threads.ml b/0.1.4-1/examples/threads.ml new file mode 100644 index 000000000..01f6dae4c --- /dev/null +++ b/0.1.4-1/examples/threads.ml @@ -0,0 +1,63 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_types + +let m = Mutex.create () +let m_locked = ref true + +let critical f = + Mutex.lock m; + m_locked := true; + Lazy.force f; + m_locked := false; + Mutex.unlock m + + (** ocaml's Thread.unlock suspend the invoking process if the mutex is already + * unlocked, therefore we unlock it only if we know that it's currently locked + *) +let safe_unlock _ _ = if !m_locked then Mutex.unlock m + +let i = ref 10 +let dump_i outchan = + Http_daemon.respond ~body:(Printf.sprintf "i = %d\n" !i) outchan + +let callback req outchan = + match req#path with + | "/incr" -> critical (lazy (incr i; dump_i outchan; Unix.sleep 5)) + | "/decr" -> critical (lazy (decr i; dump_i outchan; Unix.sleep 5)) + | "/get" -> critical (lazy (dump_i outchan)) + | bad_request -> Http_daemon.respond_error outchan + +let spec = + { Http_daemon.default_spec with + port = 9999; + mode = `Thread; + callback = callback; + exn_handler = Some safe_unlock; + (** ocaml-http's default exn_handler is Pervasives.ignore. This means + * that threads holding the "m" mutex above may die without unlocking it. + * Using safe_unlock as an exception handler we ensure that "m" mutex is + * unlocked in case of exceptions (e.g. SIGPIPE) *) + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/timeout.ml b/0.1.4-1/examples/timeout.ml new file mode 100644 index 000000000..d39f6be7a --- /dev/null +++ b/0.1.4-1/examples/timeout.ml @@ -0,0 +1,31 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_types + +let spec = + { Http_daemon.default_spec with + callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan); + timeout = Some 10; + } + +let _ = Http_daemon.main spec + diff --git a/0.1.4-1/examples/webfsd.ml b/0.1.4-1/examples/webfsd.ml new file mode 100644 index 000000000..c7a984b03 --- /dev/null +++ b/0.1.4-1/examples/webfsd.ml @@ -0,0 +1,50 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2004> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_types + +let def_port = 80 +let def_addr = "0.0.0.0" +let def_root = Sys.getcwd () + +let port = ref def_port +let addr = ref def_addr +let root = ref def_root +let argspec = + [ "-p", Arg.Int (fun p -> port := p), + "TCP port on which listen, default: " ^ string_of_int !port; + "-a", Arg.String (fun a -> addr := a), + "IP address on which listen, default: " ^ !addr; + "-r", Arg.String (fun r -> root := r), + "DocumentRoot, default: current working directory"; + ] + +let _ = + Arg.parse argspec (fun _ -> ()) ""; + let spec = + { Http_daemon.default_spec with + address = !addr; + port = !port; + root_dir = Some !root + } + in + Http_daemon.Trivial.main spec + diff --git a/0.1.4-1/http_common.ml b/0.1.4-1/http_common.ml new file mode 100644 index 000000000..affbdb23a --- /dev/null +++ b/0.1.4-1/http_common.ml @@ -0,0 +1,162 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Http_types;; +open Printf;; + +let debug = ref false +let debug_print s = + if !debug then + prerr_endline (sprintf "[OCaml HTTP] DEBUG: %s" s) + +let http_version = Http_constants.version +let server_string = Http_constants.server_string + +let string_of_version = function + | `HTTP_1_0 -> "HTTP/1.0" + | `HTTP_1_1 -> "HTTP/1.1" + +let version_of_string = function + | "HTTP/1.0" -> `HTTP_1_0 + | "HTTP/1.1" -> `HTTP_1_1 + | invalid_version -> raise (Invalid_HTTP_version invalid_version) + +let string_of_method = function + | `GET -> "GET" + | `POST -> "POST" + +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 + diff --git a/0.1.4-1/http_common.mli b/0.1.4-1/http_common.mli new file mode 100644 index 000000000..6029a7031 --- /dev/null +++ b/0.1.4-1/http_common.mli @@ -0,0 +1,80 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Common functionalities shared by other OCaml HTTP modules *) + +open Http_types;; + + (** whether debugging messages are enabled or not, can be changed at runtime + *) +val debug: bool ref + + (** print a string on stderr only if debugging is enabled *) +val debug_print: string -> unit + + (** see {!Http_constants.version} *) +val http_version: version + + (** see {!Http_constants.server_string} *) +val server_string: string + + (** pretty print an HTTP version *) +val string_of_version: version -> string + + (** parse an HTTP version from a string + @raise Invalid_HTTP_version if given string doesn't represent a supported HTTP + version *) +val version_of_string: string -> version + + (** pretty print an HTTP method *) +val string_of_method: meth -> string + + (** parse an HTTP method from a string + @raise Invalid_HTTP_method if given string doesn't represent a supported + method *) +val method_of_string: string -> meth + + (** 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 + diff --git a/0.1.4-1/http_constants.ml b/0.1.4-1/http_constants.ml new file mode 100644 index 000000000..f45829ddc --- /dev/null +++ b/0.1.4-1/http_constants.ml @@ -0,0 +1,36 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +let version = `HTTP_1_1 ;; +let server_string = "OCaml HTTP Daemon" ;; +let crlf = "\r\n" ;; + +let default_addr = "0.0.0.0" +let default_auth = None +let default_auto_close = 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 + + diff --git a/0.1.4-1/http_constants.mli b/0.1.4-1/http_constants.mli new file mode 100644 index 000000000..03d2ee424 --- /dev/null +++ b/0.1.4-1/http_constants.mli @@ -0,0 +1,44 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Constants *) + + (** default HTTP version *) +val version: Http_types.version + + (** string returned as value of "Server:" response header *) +val server_string: string + + (** "\r\n" string *) +val crlf: string + + (** {2 daemon default values} *) + +val default_addr: string +val default_auth: (string * Http_types.auth_info) option +val default_auto_close: bool +val default_callback: Http_types.request -> out_channel -> unit +val default_mode: Http_types.daemon_mode +val default_port: int +val default_root_dir: string option +val default_exn_handler: (exn -> out_channel -> unit) option +val default_timeout: int option + diff --git a/0.1.4-1/http_daemon.ml b/0.1.4-1/http_daemon.ml new file mode 100644 index 000000000..f7c8495de --- /dev/null +++ b/0.1.4-1/http_daemon.ml @@ -0,0 +1,474 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Printf + +open Http_common +open Http_types +open Http_constants +open Http_parser + +exception Http_daemon_failure of string + + (** send raw data on outchan, flushing it afterwards *) +let send_raw ~data outchan = + output_string outchan data; + flush outchan + +let send_CRLF = send_raw ~data:crlf + +let send_header ~header ~value = + let header = String.lowercase 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 +" + +%d %s + +

%d - %s

%s +" + code reason_phrase code reason_phrase body + + (** internal: send a fooish body explaining in HTML form the 'reason phrase' + of an HTTP response; body, if given, will be appended to the body *) +let send_foo_body code body = send_raw ~data:(foo_body code body) + + (* Warning: keep default values in sync with Http_response.response class *) +let respond ?(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 "\n%s\n\n" name; + let (dirs, files) = + List.partition (fun e -> Http_misc.is_directory (path ^ e)) (Http_misc.ls dir) + in + List.iter + (fun d -> fprintf outchan "%s/
\n" d d) + (List.sort compare dirs); + List.iter + (fun f -> fprintf outchan "%s
\n" f f) + (List.sort compare files); + fprintf outchan "\n"; + flush outchan + +let respond_file ~fname ?(version = http_version) outchan = + (** ASSUMPTION: 'fname' doesn't begin with a "/"; it's relative to the current + document root (usually the daemon's cwd) *) + let droot = Sys.getcwd () in (* document root *) + let path = droot ^ "/" ^ fname in (* full path to the desired file *) + if not (Sys.file_exists path) then (* file not found *) + respond_not_found ~url:fname outchan + else begin + try + if Http_misc.is_directory path then begin (* file found, is a dir *) + let dir = Unix.opendir path in + send_basic_headers ~version ~code:(`Code 200) outchan; + send_header "Content-Type" "text/html" outchan; + send_CRLF outchan; + send_dir_listing ~dir ~name:fname ~path outchan; + Unix.closedir dir + end else begin (* file found, is something else *) + let file = open_in fname in + send_basic_headers ~version ~code:(`Code 200) outchan; + send_header + ~header:"Content-Length" + ~value:(string_of_int (Http_misc.filesize fname)) + outchan; + send_CRLF outchan; + send_file ~src:(InChanSrc file) outchan; + close_in file + end + with + | Unix.Unix_error (Unix.EACCES, _, _) + | Sys_error _ -> + respond_forbidden ~url:fname ~version outchan + end + +let respond_with (res: Http_types.response) outchan = + res#serialize outchan; + flush outchan + + (** internal: this exception is raised after a malformed request has been read + by a serving process to signal main server (or itself if mode = `Single) to + skip to next request *) +exception Again;; + +let pp_parse_exc e = + sprintf "HTTP request parse error: %s" (Printexc.to_string e) + + (* given a Http_parser.parse_request like function, wrap it in a function that + do the same and additionally catch parsing exception sending HTTP error + messages back to client as needed. Returned function raises Again when it + encounter a parse error (name 'Again' is intended for future versions that + will support http keep alive signaling that a new request has to be parsed + from client) *) +let rec wrap_parse_request_w_safety parse_function inchan outchan = + (try + parse_function inchan + with + | (Malformed_request req) as e -> + debug_print (pp_parse_exc e); + respond_error ~code:(`Code 400) + ~body:("request 1st line format should be: " ^ + "'<method> <url> <version>'" ^ + "
\nwhile received request 1st line was:
\n" ^ req) + outchan; + raise Again + | (Invalid_HTTP_method meth) as e -> + debug_print (pp_parse_exc e); + respond_error ~code:(`Code 501) + ~body:("Method '" ^ meth ^ "' isn't supported (yet)") + outchan; + raise Again + | (Malformed_request_URI uri) as e -> + debug_print (pp_parse_exc e); + respond_error ~code:(`Code 400) ~body:("Malformed URL: '" ^ uri ^ "'") + outchan; + raise Again + | (Invalid_HTTP_version version) as e -> + debug_print (pp_parse_exc e); + respond_error ~code:(`Code 505) + ~body:("HTTP version '" ^ version ^ "' isn't supported (yet)") + outchan; + raise Again + | (Malformed_query query) as e -> + debug_print (pp_parse_exc e); + respond_error ~code:(`Code 400) + ~body:(sprintf "Malformed query string '%s'" query) outchan; + raise Again + | (Malformed_query_part (binding, query)) as e -> + debug_print (pp_parse_exc e); + respond_error ~code:(`Code 400) + ~body:(sprintf "Malformed query part '%s' in query '%s'" binding query) + outchan; + raise Again) + + (* wrapper around Http_parser.parse_request which catch parsing exceptions and + return error messages to client as needed + @param inchan in_channel from which read incoming requests + @param outchan out_channl on which respond with error messages if needed + *) +let safe_parse_request = wrap_parse_request_w_safety parse_request + + (* as above but for OO version (Http_parser.parse_request') *) +let safe_parse_request' = wrap_parse_request_w_safety (new Http_request.request) + +let chdir_to_document_root = function (* chdir to document root *) + | Some dir -> Sys.chdir dir + | None -> () + +let server_of_mode = function + | `Single -> Http_tcp_server.simple + | `Fork -> Http_tcp_server.fork + | `Thread -> Http_tcp_server.thread + + (* TODO what happens when a Quit exception is raised by a callback? Do other + callbacks keep on living until the end or are them all killed immediatly? + The right semantics should obviously be the first one *) + + (** - handle HTTP authentication + * - handle automatic closures of client connections *) +let invoke_callback req spec outchan = + let callback req outchan = + if spec.auto_close then + Http_misc.finally + (fun () -> + (* 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; + } + diff --git a/0.1.4-1/http_daemon.mli b/0.1.4-1/http_daemon.mli new file mode 100644 index 000000000..2b7be19cb --- /dev/null +++ b/0.1.4-1/http_daemon.mli @@ -0,0 +1,186 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Main OCaml HTTP module. + Here you can find two set of functions: + - functions which let you start an HTTP Daemon (start* functions) + - facility functions which let you sent responses back to clients *) + + (** send a CRLF sequence on the given output channel, this is mandatory after + the last header was sent and before start sending the response body *) +val send_CRLF: out_channel -> unit + + (** send response status line, version is the http version used in response, + either code or status must be given (not both, not none) which represent the + HTTP response code, outchan is the output channel to which send status line *) +val send_status_line: + ?version:Http_types.version -> code:Http_types.status_code -> + out_channel -> + unit + + (** 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 *) +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 + diff --git a/0.1.4-1/http_message.ml b/0.1.4-1/http_message.ml new file mode 100644 index 000000000..5dc0f0472 --- /dev/null +++ b/0.1.4-1/http_message.ml @@ -0,0 +1,118 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Http_common;; +open Http_constants;; +open Http_types;; +open Printf;; + + (* remove all bindings of 'name' from hashtbl 'tbl' *) +let rec hashtbl_remove_all tbl name = + if not (Hashtbl.mem tbl name) then + raise (Header_not_found name); + Hashtbl.remove tbl name; + if Hashtbl.mem tbl name then hashtbl_remove_all tbl name +;; + +class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = + + let ((cliaddr, cliport), (srvaddr, srvport)) = + (Http_misc.explode_sockaddr clisockaddr, + Http_misc.explode_sockaddr srvsockaddr) + in + + object (self) + + val _contentsBuf = Buffer.create 1024 + val _headers = Hashtbl.create 11 + val mutable _version: version option = version + + initializer + self#setBody body; + self#addHeaders headers + + method version = _version + method setVersion v = _version <- Some v + + method body = Buffer.contents _contentsBuf + method setBody c = + Buffer.clear _contentsBuf; + Buffer.add_string _contentsBuf c + method bodyBuf = _contentsBuf + method setBodyBuf b = + Buffer.clear _contentsBuf; + Buffer.add_buffer _contentsBuf b + method addBody s = Buffer.add_string _contentsBuf s + method addBodyBuf b = Buffer.add_buffer _contentsBuf b + + method addHeader ~name ~value = + let name = String.lowercase 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 + diff --git a/0.1.4-1/http_message.mli b/0.1.4-1/http_message.mli new file mode 100644 index 000000000..0a30b3eec --- /dev/null +++ b/0.1.4-1/http_message.mli @@ -0,0 +1,130 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Object Oriented representation of HTTP messages *) + +open Http_types;; + + (** OO representation of an HTTP message + @param entity body included in the message + @param headers message headers shipped with the message *) +class virtual message: + body: string -> headers: (string * string) list -> version: version option -> + clisockaddr: Unix.sockaddr -> srvsockaddr: Unix.sockaddr -> + object + + (** @return message HTTP version, it can be None because older version + of the HTTP protocol don't require HTTP version to be told between + message source and destination *) + method version: version option + + (** set message HTTP version *) + method setVersion: version -> unit + + (** @return message body *) + method body: string + + (** set message body *) + method setBody: string -> unit + + (** @return a Buffer.t connected to message body (Warning: changing this + buffer will change message body too) *) + method bodyBuf: Buffer.t + + (** set a new Buffer.t used to keep message body *) + method setBodyBuf: Buffer.t -> unit + + (** append a string to message body *) + method addBody: string -> unit + + (** append a whole buffer to message body *) + method addBodyBuf: Buffer.t -> unit + + (** {i header name comparison are performed in a case-insensitive manner + as required by RFC2616, actually the implementation works converting all + header names in lowercase} *) + + (** add an HTTP header + @param name header's name + @param value header's value *) + method addHeader: name:string -> value:string -> unit + + (** add a list of HTTP headers + @param headers a list of pairs: header_name, header_value *) + method addHeaders: (string * string) list -> unit + + (** like addHeader but replace previous definition of the same header *) + method replaceHeader: name:string -> value:string -> unit + + (** like addHeaders but replace previous definition of headers that were + already defined *) + method replaceHeaders: (string * string) list -> unit + + (** remove _all_ occurences of an HTTP header from the message + @param name name of the header to be removed *) + method removeHeader: name:string -> unit + + (** @return true if given header exists in message, false otherwise *) + method hasHeader: name:string -> bool + + (** @return value associated to a given header + @param name name of the header to lookup + @raise Header_not_found if given header wasn't defined in message *) + method header: name:string -> string + + (** @return the full set of headers defined for this message, the value + returned is an association list from headers name to headers value, an + header may occurs more that once in the list *) + method headers: (string * string) list + + + (** @return client Unix.sockaddr *) + method clientSockaddr: Unix.sockaddr + + (** @return client address pretty printed *) + method clientAddr: string + + (** @return client port *) + method clientPort: int + + (** @return server Unix.sockaddr *) + method serverSockaddr: Unix.sockaddr + + (** @return server address pretty printed *) + method serverAddr: string + + (** @return server port *) + method serverPort: int + + + (** @return for requests first request line, for responses first + response line. + User by derived requests and responses to implement toString method *) + method private virtual fstLineToString: string + + (** @return a string representation of the message *) + method toString: string + + (** serialize the message over an output channel *) + method serialize: out_channel -> unit + + end + diff --git a/0.1.4-1/http_misc.ml b/0.1.4-1/http_misc.ml new file mode 100644 index 000000000..daa81f3b7 --- /dev/null +++ b/0.1.4-1/http_misc.ml @@ -0,0 +1,154 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Printf + +open Http_types + +let date_822 () = + Netdate.mk_mail_date ~zone:Netdate.localzone (Unix.time ()) + +let is_directory name = + match Unix.lstat name with + | { Unix.st_kind = Unix.S_DIR } -> true + | _ -> false + +let filesize fname = (Unix.stat fname).Unix.st_size + +let strip_trailing_slash = + let rex = Pcre.regexp "/$" in + fun s -> Pcre.replace ~rex ~templ:"" s + +let strip_heading_slash = + let rex = Pcre.regexp "^/" in + fun s -> Pcre.replace ~rex ~templ:"" s + +let ls dir = + let rec ls' entries = + try ls' ((Unix.readdir dir)::entries) with End_of_file -> entries + in + ls' [] + +let string_explode s = + let rec string_explode' acc = function + | "" -> acc + | s -> string_explode' (s.[0] :: acc) (String.sub s 1 (String.length s - 1)) + in + List.rev (string_explode' [] s) + +let string_implode = List.fold_left (fun s c -> s ^ (String.make 1 c)) "" + +let reason_phrase_of_code = function + | 100 -> "Continue" + | 101 -> "Switching protocols" + | 200 -> "OK" + | 201 -> "Created" + | 202 -> "Accepted" + | 203 -> "Non authoritative information" + | 204 -> "No content" + | 205 -> "Reset content" + | 206 -> "Partial content" + | 300 -> "Multiple choices" + | 301 -> "Moved permanently" + | 302 -> "Found" + | 303 -> "See other" + | 304 -> "Not modified" + | 305 -> "Use proxy" + | 307 -> "Temporary redirect" + | 400 -> "Bad request" + | 401 -> "Unauthorized" + | 402 -> "Payment required" + | 403 -> "Forbidden" + | 404 -> "Not found" + | 405 -> "Method not allowed" + | 406 -> "Not acceptable" + | 407 -> "Proxy authentication required" + | 408 -> "Request time out" + | 409 -> "Conflict" + | 410 -> "Gone" + | 411 -> "Length required" + | 412 -> "Precondition failed" + | 413 -> "Request entity too large" + | 414 -> "Request URI too large" + | 415 -> "Unsupported media type" + | 416 -> "Requested range not satisfiable" + | 417 -> "Expectation failed" + | 500 -> "Internal server error" + | 501 -> "Not implemented" + | 502 -> "Bad gateway" + | 503 -> "Service unavailable" + | 504 -> "Gateway time out" + | 505 -> "HTTP version not supported" + | invalid_code -> raise (Invalid_code invalid_code) + +let build_sockaddr (addr, port) = + try + Unix.ADDR_INET ((Unix.gethostbyname addr).Unix.h_addr_list.(0), port) + with Not_found -> failwith ("OCaml-HTTP, can't resolve hostname: " ^ addr) + +let explode_sockaddr = function + | Unix.ADDR_INET (addr, port) -> (Unix.string_of_inet_addr addr, port) + | _ -> assert false (* can explode only inet address *) + +let peername_of_out_channel outchan = + Unix.getpeername (Unix.descr_of_out_channel outchan) +let peername_of_in_channel inchan = + Unix.getpeername (Unix.descr_of_in_channel inchan) +let sockname_of_out_channel outchan = + Unix.getsockname (Unix.descr_of_out_channel outchan) +let sockname_of_in_channel inchan = + Unix.getsockname (Unix.descr_of_in_channel inchan) + +let buf_of_inchan ?limit ic = + let buf = Buffer.create 10240 in + let tmp = 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 + diff --git a/0.1.4-1/http_misc.mli b/0.1.4-1/http_misc.mli new file mode 100644 index 000000000..bb6a86fbb --- /dev/null +++ b/0.1.4-1/http_misc.mli @@ -0,0 +1,94 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Helpers and other not better classified functions which should not be +exposed in the final API *) + + (** @return the current date compliant to RFC 1123, which updates RFC 822 + zone info are retrieved from UTC *) +val date_822: unit -> string + + (** @return true if 'name' is a directory on the file system, false otherwise + *) +val is_directory: string -> bool + + (** @return the filesize of fname *) +val filesize: string -> int + + (** strip trailing '/', if any, from a string and @return the new string *) +val strip_trailing_slash: string -> string + + (** strip heading '/', if any, from a string and @return the new string *) +val strip_heading_slash: string -> string + + (** given a dir handle @return a list of entries contained *) +val ls: Unix.dir_handle -> string list + + (** explode a string in a char list *) +val string_explode: string -> char list + + (** implode a char list in a string *) +val string_implode: char list -> string + + (** given an HTTP response code return the corresponding reason phrase *) +val reason_phrase_of_code: int -> string + + (** build a Unix.sockaddr inet address from a string representation of an IP + address and a port number *) +val build_sockaddr: string * int -> Unix.sockaddr + + (** explode an _inet_ Unix.sockaddr address in a string representation of an + IP address and a port number *) +val explode_sockaddr: Unix.sockaddr -> string * int + + (** given an out_channel build on top of a socket, return peername related to + that socket *) +val peername_of_out_channel: out_channel -> Unix.sockaddr + + (** as above but works on in_channels *) +val peername_of_in_channel: in_channel -> Unix.sockaddr + + (** given an out_channel build on top of a socket, return sockname related to + that socket *) +val sockname_of_out_channel: out_channel -> Unix.sockaddr + + (** as above but works on in_channels *) +val sockname_of_in_channel: in_channel -> Unix.sockaddr + + (* TODO replace with Buffer.add_channel which does almost the same :-((( *) + (** reads from an input channel till it End_of_file and returns what has been + read; if limit is given returned buffer will contains at most first 'limit' + bytes read from input channel *) +val buf_of_inchan: ?limit: int -> in_channel -> Buffer.t + + (** like List.assoc but return all bindings of a given key instead of the + leftmost one only *) +val list_assoc_all: 'a -> ('a * 'b) list -> 'b list + +val warn: string -> unit (** print a warning msg to stderr. Adds trailing \n *) +val error: string -> unit (** print an error msg to stderr. Adds trailing \n *) + + (** @param finalizer finalization function (execution both in case of success + * and in case of raised exception + * @param f function to be invoked + * @param arg argument to be passed to function *) +val finally: (unit -> unit) -> ('a -> 'b) -> 'a -> 'b + diff --git a/0.1.4-1/http_parser.ml b/0.1.4-1/http_parser.ml new file mode 100644 index 000000000..b92a844e3 --- /dev/null +++ b/0.1.4-1/http_parser.ml @@ -0,0 +1,182 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Printf;; + +open Http_common;; +open Http_types;; +open Http_constants;; + +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) + diff --git a/0.1.4-1/http_parser.mli b/0.1.4-1/http_parser.mli new file mode 100644 index 000000000..452d70765 --- /dev/null +++ b/0.1.4-1/http_parser.mli @@ -0,0 +1,75 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** HTTP messages parsing *) + +open Http_types;; + + (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...") + @return a list of pairs [("name1", "value1"); ("name2", "value2")] + @raise Malformed_query if the string isn't a valid query string + @raise Malformed_query_part if some piece of the query isn't valid + *) +val split_query_params: string -> (string * string) list + + (** parse 1st line of an HTTP request + @param inchan input channel from which parse request + @return a triple meth * url * version, meth is the HTTP method invoked, url is + the requested url, version is the HTTP version specified or None if no version + was specified + @raise Malformed_request if request 1st linst isn't well formed + @raise Malformed_request_URI if requested URI isn't well formed *) +val parse_request_fst_line: in_channel -> meth * Neturl.url * version option + + (** parse 1st line of an HTTP response + * @param inchan input channel from which parse response + * @raise Malformed_response if first line isn't well formed + *) +val parse_response_fst_line: in_channel -> version * status + + (** parse HTTP GET parameters from an URL; paramater which were passed with no + value (like 'x' in "/foo.cgi?a=10&x=&c=9") are returned associated with the + empty ("") string. + @return a list of pairs param_name * param_value *) +val parse_query_get_params: Neturl.url -> (string * string) list + + (** parse the base path (removing query string, fragment, ....) from an URL *) +val parse_path: Neturl.url -> string + + (** parse HTTP headers. Consumes also trailing CRLF at the end of header list + @param inchan input channel from which parse headers + @return a list of pairs header_name * header_value + @raise Invalid_header if a not well formed header is encountered *) +val parse_headers: in_channel -> (string * string) list + + (** parse a Cookie header, extracting an associative list . See RFC 2965 + * @param raw_cookies: value of a "Cookies:" header + * @return a list of pairs cookie_name * cookie_value + * @raise Malformed_cookies if raw_cookies does not conform to RFC 2965 *) +val parse_cookies: string -> (string * string) list + + (** given an input channel, reads from it a GET HTTP request and + @return a pair where path is a string representing the + requested path and query_params is a list of pairs (the GET + parameters) *) +val parse_request: in_channel -> string * (string * string) list + diff --git a/0.1.4-1/http_parser_sanity.ml b/0.1.4-1/http_parser_sanity.ml new file mode 100644 index 000000000..7fe08cf93 --- /dev/null +++ b/0.1.4-1/http_parser_sanity.ml @@ -0,0 +1,115 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Printf + +open Http_types +open Http_constants + +(* +type url_syntax_option = + Url_part_not_recognized + | Url_part_allowed + | Url_part_required + +* (1) scheme://user:password@host:port/path;params?query#fragment +*) + +let request_uri_syntax = +{ + Neturl.url_enable_scheme = Neturl.Url_part_not_recognized; + url_enable_user = Neturl.Url_part_not_recognized; + url_enable_user_param = Neturl.Url_part_not_recognized; + url_enable_password = Neturl.Url_part_not_recognized; + url_enable_host = Neturl.Url_part_not_recognized; + url_enable_port = Neturl.Url_part_not_recognized; + url_enable_path = Neturl.Url_part_required; + url_enable_param = Neturl.Url_part_not_recognized; + url_enable_query = Neturl.Url_part_allowed; + url_enable_fragment = Neturl.Url_part_not_recognized; + url_enable_other = Neturl.Url_part_not_recognized; + url_accepts_8bits = false; + url_enable_relative = true; + url_is_valid = (fun _ -> true); +} + + (* convention: + foo_RE_raw is the uncompiled regexp matching foo + foo_RE is the compiled regexp matching foo + is_foo is the predicate over string matching foo + *) + +let separators_RE_raw = "()<>@,;:\\\\\"/\\[\\]?={} \t" +let ctls_RE_raw = "\\x00-\\x1F\\x7F" +let token_RE_raw = "[^" ^ separators_RE_raw ^ ctls_RE_raw ^ "]+" +let lws_RE_raw = "(\r\n)?[ \t]" +let quoted_string_RE_raw = "\"(([^\"])|(\\\\\"))*\"" +let text_RE_raw = "(([^" ^ ctls_RE_raw ^ "])|(" ^ lws_RE_raw ^ "))+" +let field_content_RE_raw = + sprintf + "^(((%s)|(%s)|(%s))|(%s))*$" + token_RE_raw + separators_RE_raw + quoted_string_RE_raw + text_RE_raw +(* + (* following RFC 2616 specifications *) +let field_value_RE_raw = "((" ^ field_content_RE_raw ^ ")|(" ^ lws_RE_raw^ "))*" +*) + (* smarter implementation: TEXT production is included in the regexp below *) +let field_value_RE_raw = + sprintf + "^((%s)|(%s)|(%s)|(%s))*$" + token_RE_raw + separators_RE_raw + quoted_string_RE_raw + lws_RE_raw + +let token_RE = Pcre.regexp ("^" ^ token_RE_raw ^ "$") +let field_value_RE = Pcre.regexp ("^" ^ field_value_RE_raw ^ "$") +let heading_lws_RE = Pcre.regexp (sprintf "^%s*" lws_RE_raw) +let trailing_lws_RE = Pcre.regexp (sprintf "%s*$" lws_RE_raw) + +let is_token s = Pcre.pmatch ~rex:token_RE s +let is_field_name = is_token +let is_field_value s = Pcre.pmatch ~rex:field_value_RE s + +let heal_header_name s = + if not (is_field_name s) then raise (Invalid_header_name s) else () + +let heal_header_value s = + if not (is_field_value s) then raise (Invalid_header_value s) else () + +let normalize_header_value s = + Pcre.replace ~rex:trailing_lws_RE + (Pcre.replace ~rex:heading_lws_RE s) + +let heal_header (name, value) = + heal_header_name name; + heal_header_value name + +let url_of_string s = + try + Neturl.url_of_string request_uri_syntax s + with Neturl.Malformed_URL -> raise (Malformed_URL s) + +let string_of_url = Neturl.string_of_url + diff --git a/0.1.4-1/http_parser_sanity.mli b/0.1.4-1/http_parser_sanity.mli new file mode 100644 index 000000000..a869f182f --- /dev/null +++ b/0.1.4-1/http_parser_sanity.mli @@ -0,0 +1,46 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Sanity test functions related to HTTP message parsing *) + + (** @param name an HTTP header name + @raise Invalid_header_name if name isn't a valid HTTP header name *) +val heal_header_name: string -> unit + + (** @param value an HTTP header value + @raise Invalid_header_value if value isn't a valid HTTP header value *) +val heal_header_value: string -> unit + + (** @param header a pair header_name * header_value + @raise Invalid_header_name if name isn't a valid HTTP header name + @raise Invalid_header_value if value isn't a valid HTTP header value *) +val heal_header: string * string -> unit + + (** remove heading and/or trailing LWS sequences as per RFC2616 *) +val normalize_header_value: string -> string + + (** parse an URL from a string. + @raise Malformed_URL if an invalid URL is encountered *) +val url_of_string: string -> Neturl.url + + (** pretty print an URL *) +val string_of_url: Neturl.url -> string + diff --git a/0.1.4-1/http_request.ml b/0.1.4-1/http_request.ml new file mode 100644 index 000000000..93e6d8811 --- /dev/null +++ b/0.1.4-1/http_request.ml @@ -0,0 +1,158 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2007> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Printf;; + +open Http_common;; +open Http_types;; + +let debug_dump_request path params = + debug_print ("request path = " ^ path); + debug_print ( + sprintf"request params = %s" + (String.concat ";" + (List.map (fun (h,v) -> String.concat "=" [h;v]) params))) + +let auth_sep_RE = Pcre.regexp ":" +let basic_auth_RE = Pcre.regexp "^Basic\\s+" + +exception Fallback;; (* used internally by request class *) + +class request ic = + let (meth, uri, version) = Http_parser.parse_request_fst_line ic in + let uri_str = Neturl.string_of_url uri in + let path = Http_parser.parse_path uri in + let query_get_params = Http_parser.parse_query_get_params uri in + let (headers, body) = + (match version with + | None -> [], "" (* No version given, use request's 1st line only *) + | Some version -> (* Version specified, parse also headers and body *) + let headers = + List.map (* lowercase header names to ease lookups before having a + request object *) + (fun (h,v) -> (String.lowercase 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 + diff --git a/0.1.4-1/http_request.mli b/0.1.4-1/http_request.mli new file mode 100644 index 000000000..5c9c17583 --- /dev/null +++ b/0.1.4-1/http_request.mli @@ -0,0 +1,28 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2007> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Object Oriented representation of HTTP requests *) + +open Http_types;; + + (** OO representation of an HTTP request + @param inchan input channel from which parse an HTTP request *) +class request: in_channel -> Http_types.request + diff --git a/0.1.4-1/http_response.ml b/0.1.4-1/http_response.ml new file mode 100644 index 000000000..58308d307 --- /dev/null +++ b/0.1.4-1/http_response.ml @@ -0,0 +1,118 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Http_types;; +open Http_constants;; +open Http_common;; +open Http_daemon;; +open Printf;; + +let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" + +let anyize = function + | Some addr -> addr + | None -> Unix.ADDR_INET (Unix.inet_addr_any, -1) + +class response + (* Warning: keep default values in sync with Http_daemon.respond function *) + ?(body = "") ?(headers = []) ?(version = http_version) + ?clisockaddr ?srvsockaddr (* optional because response have to be easily + buildable in callback functions *) + ?(code = 200) ?status + () + = + + (** if no address were supplied for client and/or server, use a foo address + instead *) + let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in + + (* "version code reason_phrase" *) + object (self) + + (* note that response objects can't be created with a None version *) + inherit + Http_message.message + ~body ~headers ~version:(Some version) ~clisockaddr ~srvsockaddr + + val mutable _code = + match status with + | None -> code + | Some (s: Http_types.status) -> code_of_status s + val mutable _reason: string option = None + + method private getRealVersion = + match self#version with + | None -> + failwith ("Http_response.fstLineToString: " ^ + "can't serialize an HTTP response with no HTTP version defined") + | Some v -> string_of_version v + + method code = _code + method setCode c = + ignore (status_of_code c); (* sanity check on c *) + _code <- c + method status = status_of_code _code + method setStatus (s: Http_types.status) = _code <- code_of_status s + method reason = + match _reason with + | None -> Http_misc.reason_phrase_of_code _code + | Some r -> r + method setReason r = _reason <- Some r + method statusLine = + String.concat " " + [self#getRealVersion; string_of_int self#code; self#reason] + method setStatusLine s = + try + let subs = Pcre.extract ~rex:status_line_RE s in + self#setVersion (version_of_string subs.(1)); + self#setCode (int_of_string subs.(2)); + self#setReason subs.(3) + with Not_found -> + raise (Invalid_status_line s) + + method isInformational = is_informational _code + method isSuccess = is_success _code + method isRedirection = is_redirection _code + method isClientError = is_client_error _code + method isServerError = is_server_error _code + method isError = is_error _code + + (* 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 + diff --git a/0.1.4-1/http_response.mli b/0.1.4-1/http_response.mli new file mode 100644 index 000000000..694eb22c0 --- /dev/null +++ b/0.1.4-1/http_response.mli @@ -0,0 +1,33 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Object Oriented representation of HTTP responses *) + +open Http_types;; + + (** OO representation of an HTTP response. *) +class response: + ?body:string -> ?headers:(string * string) list -> ?version: version -> + ?clisockaddr: Unix.sockaddr -> ?srvsockaddr: Unix.sockaddr -> + ?code:int -> ?status:Http_types.status -> + unit -> + Http_types.response + diff --git a/0.1.4-1/http_tcp_server.ml b/0.1.4-1/http_tcp_server.ml new file mode 100644 index 000000000..cbe01add1 --- /dev/null +++ b/0.1.4-1/http_tcp_server.ml @@ -0,0 +1,172 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + + + (** raised when a client timeouts *) +exception Timeout + +let backlog = 10 + + (** if timeout is given (Some _) @return a new callback which establish + timeout_callback as callback for signal Sys.sigalrm and register an alarm + (expiring after timeout seconds) before invoking the real callback given. If + timeout is None, callback is returned unchanged. *) +let wrap_callback_w_timeout ~callback ~timeout ~timeout_callback = + match timeout with + | None -> callback + | Some timeout -> (* wrap callback setting an handler for ALRM signal and an + alarm that ring after timeout seconds *) + (fun inchan outchan -> + ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_callback)); + ignore (Unix.alarm timeout); + callback inchan outchan) + + (* try to close nicely a socket *) +let shutdown_socket suck = + try + Unix.shutdown suck Unix.SHUTDOWN_ALL + with Unix.Unix_error(_, "shutdown", "") -> () + +let nice_unix_accept suck = + try + Unix.accept suck + with e -> (* clean up socket before exit *) + shutdown_socket suck; + raise e + +let init_socket sockaddr = + let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + (* shutdown socket on SIGTERM *) + ignore (Sys.signal Sys.sigterm + (Sys.Signal_handle + (fun _ -> shutdown_socket suck; exit 17))); + Unix.setsockopt suck Unix.SO_REUSEADDR true; + Unix.bind suck sockaddr; + Unix.listen suck backlog; + suck + +let init_callback callback timeout = + let timeout_callback signo = + if signo = Sys.sigalrm then + raise Timeout + in + wrap_callback_w_timeout ~callback ~timeout ~timeout_callback + + (** try to close an outchannel connected to a socket, ignore Sys_error since + * this probably means that socket is already closed (e.g. on sigpipe) *) +let try_close_out ch = try close_out ch with Sys_error _ -> () + + (** like Unix.establish_server, but shutdown sockets when receiving SIGTERM + and before exiting for an uncaught exception *) +let my_establish_server server_fun sockaddr = + let suck = init_socket sockaddr in + while true do + let (s, caller) = nice_unix_accept suck in + (** "double fork" trick, see {!Unix.establish_server} implementation *) + match Unix.fork() with + | 0 -> (* parent *) + (try + if Unix.fork () <> 0 then + exit 0; (* The son exits, the grandson works *) + let inchan = Unix.in_channel_of_descr s in + let outchan = Unix.out_channel_of_descr s in + server_fun inchan outchan; + try_close_out outchan; (* closes also inchan: socket is the same *) + exit 0 + with e -> + shutdown_socket suck; (* clean up socket before exit *) + raise e) + | child when (child > 0) -> (* child *) + Unix.close s; + ignore (Unix.waitpid [] child) (* Reclaim the son *) + | _ (* < 0 *) -> + failwith "Can't fork" + done + + (** tcp_server which forks a new process for each request *) +let fork ~sockaddr ~timeout callback = + let timeout_callback signo = + if signo = Sys.sigalrm then + exit 2 + in + my_establish_server + (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback) + sockaddr + + (** tcp_server which doesn't fork, requests are server sequentially and in the + same address space of the calling process *) +let simple ~sockaddr ~timeout callback = + let suck = init_socket sockaddr in + let callback = init_callback callback timeout in + try + while true do + let (client, _) = Unix.accept suck in + (* client is now connected *) + let (inchan, outchan) = + (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client) + in + (try + callback inchan outchan; + ignore (Unix.alarm 0) (* reset alarm *) + with Timeout -> ()); + try_close_out outchan (* this close also inchan: socket is the same *) + done + with e -> (* clean up socket before exit *) + shutdown_socket suck; + raise e + + (** tcp_server which creates a new thread for each request to be served *) +let thread ~sockaddr ~timeout callback = + let suck = init_socket sockaddr in + let callback = init_callback callback timeout in + let callback (i, o) = + (try + callback i o + with + | Timeout -> () + | e -> + try_close_out o; + raise e); + try_close_out o + in + while true do + let (client, _) = nice_unix_accept suck in + (* client is now connected *) + let (inchan, outchan) = + (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client) + in + Http_threaded_tcp_server.serve callback (inchan, outchan) + done + + (** @param server an Http_types.tcp_server + * @return an Http_types.tcp_server which takes care of ignoring SIGPIPE during + * server execution and restoring previous handler when (if ever) the server + * returns *) +let handle_sigpipe server = + fun ~sockaddr ~timeout callback -> + let old_sigpipe_behavior = Sys.signal Sys.sigpipe Sys.Signal_ignore in + server ~sockaddr ~timeout callback; + ignore (Sys.signal Sys.sigpipe old_sigpipe_behavior) + +let simple = handle_sigpipe simple +let thread = handle_sigpipe thread +let fork = handle_sigpipe fork + diff --git a/0.1.4-1/http_tcp_server.mli b/0.1.4-1/http_tcp_server.mli new file mode 100644 index 000000000..e94f84f95 --- /dev/null +++ b/0.1.4-1/http_tcp_server.mli @@ -0,0 +1,39 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** TCP servers used as low-levels for HTTP daemons *) + +(** {2 servers} *) + + (** single process server *) +val simple: Http_types.tcp_server + + (** multi threaded server *) +val thread: Http_types.tcp_server + + (** multi process server *) +val fork: Http_types.tcp_server + +(** {2 low level functions} *) + + (** initialize a passive socket listening on given Unix.sockaddr *) +val init_socket: Unix.sockaddr -> Unix.file_descr + diff --git a/0.1.4-1/http_threaded_tcp_server.mli b/0.1.4-1/http_threaded_tcp_server.mli new file mode 100644 index 000000000..6504f7e01 --- /dev/null +++ b/0.1.4-1/http_threaded_tcp_server.mli @@ -0,0 +1,26 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Multithreaded part of Http_tcp_server *) + + (** serve an HTTP request for a multi threaded TCP server *) +val serve : ('a -> 'b) -> 'a -> unit + diff --git a/0.1.4-1/http_types.ml b/0.1.4-1/http_types.ml new file mode 100644 index 000000000..216b9e02f --- /dev/null +++ b/0.1.4-1/http_types.ml @@ -0,0 +1,221 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2007> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Type definitions *) + +type version = [ `HTTP_1_0 | `HTTP_1_1 ] +type meth = [ `GET | `POST ] +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; +} + diff --git a/0.1.4-1/http_types.mli b/0.1.4-1/http_types.mli new file mode 100644 index 000000000..82967c5e4 --- /dev/null +++ b/0.1.4-1/http_types.mli @@ -0,0 +1,459 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2007> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Type definitions *) + + (** HTTP version, actually only 1.0 and 1.1 are supported. Note that + 'supported' here means only 'accepted inside a HTTP request line', no + different behaviours are actually implemented depending on HTTP version *) +type version = + [ `HTTP_1_0 + | `HTTP_1_1 + ] + + (** HTTP method, actually only GET and POST methods are supported *) +type meth = + [ `GET + | `POST + ] + + (** 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 + diff --git a/0.1.4-1/http_user_agent.ml b/0.1.4-1/http_user_agent.ml new file mode 100644 index 000000000..f5317d685 --- /dev/null +++ b/0.1.4-1/http_user_agent.ml @@ -0,0 +1,101 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +open Printf + +open Http_common + +exception Http_error of (int * string) (* code, body *) + +let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://" +let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$" + +let tcp_bufsiz = 4096 (* for TCP I/O *) + +let parse_url url = + try + let subs = + Pcre.extract ~rex:url_RE (Pcre.replace ~rex:http_scheme_RE url) + in + (subs.(1), + (if subs.(2) = "" then 80 else int_of_string subs.(3)), + (if subs.(4) = "" then "/" else subs.(4))) + with exc -> + failwith + (sprintf "Can't parse url: %s (exception: %s)" + url (Printexc.to_string exc)) + +let init_socket addr port = + let inet_addr = (Unix.gethostbyname addr).Unix.h_addr_list.(0) in + let sockaddr = Unix.ADDR_INET (inet_addr, port) in + let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + Unix.connect suck sockaddr; + let outchan = Unix.out_channel_of_descr suck in + let inchan = Unix.in_channel_of_descr suck in + (inchan, outchan) + +let submit_request kind url = + let (address, port, path) = parse_url url in + let (inchan, outchan) = init_socket address port in + let req_string = match kind with `GET -> "GET" | `HEAD -> "HEAD" in + output_string outchan (sprintf "%s %s HTTP/1.0\r\n" req_string path); + output_string outchan (sprintf "Host: %s\r\n\r\n" address); + flush outchan; + (inchan, outchan) + +let head url = + let (inchan, outchan) = submit_request `HEAD url in + let (_, status) = Http_parser.parse_response_fst_line inchan in + (match code_of_status status with + | 200 -> () + | code -> raise (Http_error (code, ""))); + let buf = Http_misc.buf_of_inchan inchan in + close_in inchan; (* close also outchan, same fd *) + Buffer.contents buf + +let get_iter ?(head_callback = fun _ _ -> ()) callback url = + let (inchan, outchan) = submit_request `GET url in + let buf = 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 + diff --git a/0.1.4-1/http_user_agent.mli b/0.1.4-1/http_user_agent.mli new file mode 100644 index 000000000..79f2d696e --- /dev/null +++ b/0.1.4-1/http_user_agent.mli @@ -0,0 +1,53 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002-2005> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as + published by the Free Software Foundation, version 2. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA +*) + +(** Minimal implementation of an HTTP 1.0/1.1 client. Interface is similar to + * Gerd Stoplmann's Http_client module. Implementation is simpler and doesn't + * handle HTTP redirection, proxies, ecc. The only reason for the existence of + * this module is for performances and incremental elaboration of response's + * bodies *) + +open Http_types + +exception Http_error of (int * string) (* code, body *) + + (** @param head_callback optional calllback invoked on response's status and + * headers. If not provided no callback will be invoked + * @param url an HTTP url + * @return HTTP response's body + * @raise Http_error when response code <> 200 *) +val get: + ?head_callback:(status -> (string * string) list -> unit) -> + string -> + string + + (** as above but iter callback function on HTTP response's body instead of + * returning it as a string *) +val get_iter: + ?head_callback:(status -> (string * string) list -> unit) -> + (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 + diff --git a/0.1.4-1/mt/http_threaded_tcp_server.ml b/0.1.4-1/mt/http_threaded_tcp_server.ml new file mode 100644 index 000000000..acdef6105 --- /dev/null +++ b/0.1.4-1/mt/http_threaded_tcp_server.ml @@ -0,0 +1,23 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +let serve callback arg = ignore (Thread.create callback arg) + diff --git a/0.1.4-1/non_mt/http_threaded_tcp_server.ml b/0.1.4-1/non_mt/http_threaded_tcp_server.ml new file mode 100644 index 000000000..9c92d7112 --- /dev/null +++ b/0.1.4-1/non_mt/http_threaded_tcp_server.ml @@ -0,0 +1,26 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +let serve _ _ = + failwith + ("Threaded server not supported by the non threaded version " ^ + "of ocaml-http, please link against http_mt.cm{,x}a") + -- 2.39.2