pax_global_header00006660000000000000000000000064112146732110014510gustar00rootroot0000000000000052 comment=0fb479321ef696d473db850e9e160a878c33b55d pkglab-1.4.2/000077500000000000000000000000001121467321100127545ustar00rootroot00000000000000pkglab-1.4.2/INSTALL000066400000000000000000000007571121467321100140160ustar00rootroot00000000000000Compilation: ------------ - You need to compile and install the dose libraries (see ../dose2). - You also need the GNU dbm database routines development files. In debian these are in the package "libgdbm-dev". - You need the libledit package, in debian: libledit-ocaml-dev. Then, do make depend (if you're working from SVN) make make pkglab.opt (if applicable for your architecture) - To compile distcheck: cd distcheck make distcheck make install [Ralf/Jaap, last update Mar 16, 2009] pkglab-1.4.2/LICENSE000066400000000000000000001045131121467321100137650ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, 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 them 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 prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If 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 convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU 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 Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state 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 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 3 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, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . pkglab-1.4.2/Makefile000066400000000000000000000017761121467321100144270ustar00rootroot00000000000000include Makefile.config OCAMLFIND= ocamlfind PACKAGE= -linkpkg -package dose2.conduit,dose2.io,dose2.lifetime,dose2.napkin,dose2.packetology,dose2.rapids,ledit DESTDIR = /usr/bin MANDIR = /usr/share/man pkglab: dql/dql.cma pkglab.ml ifdef PROFILE $(OCAMLFIND) ocamlcp $(PACKAGE) -I dql -o pkglab $^ else $(OCAMLFIND) ocamlc $(PACKAGE) -I dql -o pkglab $^ endif pkglab.opt: dql/dql.cmxa pkglab.ml $(OCAMLFIND) ocamlopt $(PACKAGE) -I dql -o pkglab.opt $^ dql/dql.cma: $(MAKE) PROFILE=${PROFILE} -C dql dql.cma dql/dql.cmxa: $(MAKE) -C dql dql.cmxa install: if [ -x pkglab.opt ] ; then \ cp pkglab.opt $(BINDIR)/pkglab ; \ elif [ -x pkglab ] ; then \ cp pkglab $(BINDIR)/pkglab ; \ else \ echo "No executable to install found" ; exit 2 ; \ fi test -d $(MANDIR)/man1 || mkdir -p $(MANDIR)/man1 install -m 644 pkglab.1 $(MANDIR)/man1 clean: rm -rf pkglab.cmo pkglab.cmx pkglab pkglab.o pkglab.opt pkglab.cmi $(MAKE) -C dql clean rm -f dql/.depend depend: touch dql/.depend $(MAKE) -C dql depend pkglab-1.4.2/Makefile.config000066400000000000000000000000431121467321100156550ustar00rootroot00000000000000DESTDIR=/usr BINDIR=$(DESTDIR)/bin pkglab-1.4.2/distcheck/000077500000000000000000000000001121467321100147155ustar00rootroot00000000000000pkglab-1.4.2/distcheck/Makefile000066400000000000000000000016551121467321100163640ustar00rootroot00000000000000include ../Makefile.config SRCS= common.ml OBJS= $(SRCS:.ml=.cmo) XBJS= $(SRCS:.ml=.cmx) PACKAGES= dose2.packetology,dose2.rapids OCAMLC= ocamlfind ocamlc -package $(PACKAGES) OCAMLOPT= ocamlfind ocamlopt -package $(PACKAGES) all: distcheck distcheck.opt distcheck: $(OBJS) $(OCAMLC) -linkpkg -o $@ $^ distcheck.opt: $(XBJS) $(OCAMLOPT) -linkpkg -o $@ $^ .PHONY: install links links: distcheck distcheck.opt ln -s distcheck debcheck ln -s distcheck.opt debcheck.opt ln -s distcheck rpmcheck ln -s distcheck.opt rpmcheck.opt ln -s distcheck pscheck ln -s distcheck.opt pscheck.opt install: links cp distcheck $(BINDIR) cp distcheck.opt $(BINDIR) cp debcheck $(BINDIR) cp debcheck.opt $(BINDIR) cp rpmcheck $(BINDIR) cp rpmcheck.opt $(BINDIR) cp pscheck $(BINDIR) cp pscheck.opt $(BINDIR) clean: rm -f distcheck distcheck.opt *.o *.cmo *.cmx %.cmo: %.ml $(OCAMLC) -o $@ -c $^ %.cmx: %.ml $(OCAMLOPT) -o $@ -c $^ pkglab-1.4.2/distcheck/common.ml000066400000000000000000000170001121467321100165350ustar00rootroot00000000000000(* distcheck *) (* Copyright 2008-2009 Jaap Boender and the MANCOOSI Project *) (* Released under the GNU GPL version 3 *) open Arg open Diagnosis open Napkin open Rapids open Waterway let show_successes = ref true and show_failures = ref true and explain_results = ref false and quiet = ref false and output_xml= ref false and dist_type = ref `Debian and source_added = ref false;; let db = create_database ();; let architecture_index = get_architecture_index db;; let unit_index = get_unit_index db;; let package_index = get_package_index db;; let not_to_check = ref Package_set.empty;; let add_source add_to_check s = let merge x = if !quiet then Waterway.merge db ~progress:Progress.dummy x else Waterway.merge db x in begin source_added := true; (* This is not very effective, but hey... *) let pkgs_old = Functions.packages db in (let s2 = if s = "-" then begin let (n, c) = Filename.open_temp_file "distcheck" "" in begin try while true do Printf.fprintf c "%s\n" (read_line ()) done with End_of_file -> close_out c end; n end else s in match !dist_type with | `Debian -> merge [Debian, File s2] | `RPM -> merge [RPM, File s2] | `Pkgsrc -> merge [Pkgsrc, File s2]); if not add_to_check then let new_packages = Package_set.diff (Functions.packages db) pkgs_old in not_to_check := Package_set.union !not_to_check new_packages end;; let unit_name_of u_id = Unit_index.find unit_index u_id;; let pkg_name_of p_id = let (_, pkg) = Package_index.find package_index p_id in let unit_name = Unit_index.find unit_index pkg.pk_unit and version_name = Version_index.get_version (fst pkg.pk_version) and release_name = Release_index.get_version (snd pkg.pk_version) in Printf.sprintf "%s (= %s%s)" unit_name version_name (match release_name with | None -> "" | Some rn -> "-" ^ rn);; let pkg_xml_of p_id = let (_, pkg) = Package_index.find package_index p_id in let unit_name = Unit_index.find unit_index pkg.pk_unit and arch_name = Architecture_index.find architecture_index pkg.pk_architecture and version_name = Version_index.get_version (fst pkg.pk_version) and release_name = Release_index.get_version (snd pkg.pk_version) in Printf.sprintf "package=\"%s\" architecture=\"%s\" version=\"%s%s\"" unit_name arch_name version_name (match release_name with | None -> "" | Some rn -> "-" ^ rn);; let spec_string s = let version_string (v, r) = let vn = Version_index.get_version v and rn = Release_index.get_version r in vn ^ (match rn with None -> "" | Some r -> r) in begin match s with | Sel_ANY -> "" | Sel_LT v -> Printf.sprintf " (< %s)" (version_string v) | Sel_LEQ v -> Printf.sprintf " (<= %s)" (version_string v) | Sel_EQ v -> Printf.sprintf " (= %s)" (version_string v) | Sel_GEQ v -> Printf.sprintf " (>= %s)" (version_string v) | Sel_GT v -> Printf.sprintf " (> %s)" (version_string v) end;; let check () = let pkgs_to_check = ref (Package_set.diff (Functions.packages db) !not_to_check) in let result_ht = Hashtbl.create (Package_set.cardinal !pkgs_to_check) in let progress = if !quiet then Progress.dummy else new Progress.indicator ~decimation:1000 ~channel:stderr ~label:"Solving..." () in let diag = Installability.check db ~indicator:progress ~targets:!pkgs_to_check ~available:(Functions.packages db) () in begin Array.iter (fun (p_id, rl) -> Hashtbl.add result_ht p_id (false, rl); pkgs_to_check := Package_set.remove p_id !pkgs_to_check; ) diag.dg_failures; Package_set.iter (fun p_id -> Hashtbl.add result_ht p_id (true, []) ) !pkgs_to_check; result_ht end;; let show_results ht = begin if !output_xml then print_endline ""; Hashtbl.iter (fun p_id (result, rl) -> if result && !show_successes then begin if !output_xml then Printf.printf "\n" (pkg_xml_of p_id) else begin Printf.printf "%s: OK\n" (pkg_name_of p_id); if !explain_results then let (_, pkg) = Package_index.find package_index p_id in begin Printf.printf "Depends: %s\n" (String.concat ", " (List.map (fun alt -> (String.concat " | " (List.map (function | Unit_version (u, v) -> (unit_name_of u) ^ (spec_string v) | Glob_pattern g -> g) alt)) ^ " {" ^ (String.concat ";" (List.map pkg_name_of (List.flatten (List.map (fun x -> Package_set.elements (Functions.select db x)) alt)))) ^ "}" ) pkg.pk_depends)); Printf.printf "Pre-depends: %s\n" (String.concat ", " (List.map (fun alt -> (String.concat " | " (List.map (function | Unit_version (u, v) -> (unit_name_of u) ^ (spec_string v) | Glob_pattern g -> g) alt)) ^ " {" ^ (String.concat ";" (List.map pkg_name_of (List.flatten (List.map (fun x -> Package_set.elements (Functions.select db x)) alt)))) ^ "}" ) pkg.pk_pre_depends)); Printf.printf "Conflicts: %s\n" (String.concat ", " (List.map (fun c -> (match c with | Unit_version (u, v) -> (unit_name_of u) ^ (spec_string v) | Glob_pattern g -> g) ^ (if Package_set.is_empty (Functions.select db c) then " {ok}" else " {NOT OK}")) pkg.pk_conflicts)) end end end else if (not result) && !show_failures then begin if !explain_results then begin if !output_xml then Printf.printf "\n" (pkg_xml_of p_id) else Printf.printf "%s: FAILED\n" (pkg_name_of p_id); List.iter (fun r -> match r with | Not_available p_id' -> Printf.printf " %s is not available\n" (pkg_name_of p_id') | Requested p_id' -> Printf.printf " %s has been requested\n" (pkg_name_of p_id') | Conflict (p_id', p_id'') -> Printf.printf " %s and %s conflict\n" (pkg_name_of p_id') (pkg_name_of p_id'') | Empty_disjunction (p_id', rl') -> Printf.printf " %s depends on missing:\n" (pkg_name_of p_id'); List.iter (fun spec -> match spec with | Unit_version (u_id, s) -> Printf.printf " - %s%s\n" (unit_name_of u_id) (spec_string s) | Glob_pattern g -> Printf.printf " - %s\n" g ) rl' | Dependency (p_id', dl') -> Printf.printf " %s depends on one of:\n" (pkg_name_of p_id'); List.iter (fun p_id'' -> Printf.printf " - %s\n" (pkg_name_of p_id'') ) dl' ) rl; if !output_xml then print_endline ""; end else if !output_xml then Printf.printf "\n" (pkg_xml_of p_id) else Printf.printf "%s: FAILED\n" (pkg_name_of p_id) end ) ht; if !output_xml then print_endline ""; end;; let speclist = [ ("-explain", Set explain_results, "Explain the results"); ("-failures", Clear show_successes, "Only show failures"); ("-successes", Clear show_failures, "Only show successes"); ("-base FILE", String (add_source false), "Additional binary package control file providing packages that are not checked but used for resolving dependencies"); ("-quiet", Set quiet, "Do not emit warnings nor progress/timing information"); ("-xml", Set output_xml, "Output results in XML format"); ("-", Unit (fun () -> add_source true "-"), ""); ];; let _ = if Util.string_contains Sys.argv.(0) "debcheck" then dist_type := `Debian else if Util.string_contains Sys.argv.(0) "rpmcheck" then dist_type := `RPM else if Util.string_contains Sys.argv.(0) "pscheck" then dist_type := `Pkgsrc else (Printf.eprintf "Warning: unknown name '%s', behaving like debcheck\n%!" Sys.argv.(0); dist_type := `Debian); Arg.parse speclist (add_source true) "Distcheck v1.4.1"; if not !source_added then add_source true "-"; show_results (check ());; pkglab-1.4.2/distcheck/edos-debcheck.1000066400000000000000000000057271121467321100174720ustar00rootroot00000000000000.TH EDOS-DEBCHECK 1 2006-05-20 EDOS .SH NAME Edos-debcheck \- Check satisfiability of Debian package dependencies .SH SYNOPSIS \fBedos-debcheck\fR [option] ... [package] ... .SH DESCRIPTION .B edos-debcheck reads from standard input a set of Debian package descriptions, each of which is in the format of deb-control(5). For instance, the Packages files as found on a Debian mirror server, or in the directory \fI/var/lib/apt/lists/\fR of a Debian system, are suitable as input to \fBedos-debcheck\fR. Packages may appear with multiple versions in this set. We say that a package is identified in this set by the pair consisting of the .I package name and of the .I package version\fR. A package (called goal) is called \fIinstallable\fR with respect to a set of packages if there exists a subset of the packages that - contains at most one version for each package name - contains the goal package (in any version, or a specific version) - all packages of the subset have their dependencies and conflicts satisfied in this subset. Debcheck checks whether every package given as argument is installable with respect to the input set of packages. Specific versions can be specified by following the package name with the sign '=' and the version of the package (for instance, 'xemacs21=21.4.17-1'). If no package name is given as argument then all packages of the input set are checked for satisfiability. The constraint solving algorithm is complete, that is it finds a solution whenever there exists one, even for multiple disjunctive dependencies and deep package conflicts. This problem is computationally infeasible in theory (that is, NP-complete), but can in practice be solved very efficiently for Packages files occurring actually in Debian. .SH OPTIONS .TP .B -check Double-check the results .TP .B -explain Explain the results .TP .B -rules Print generated rules .TP .B -failures Only show failures .TP .B -successes Only show successes .TP .B -base \fIfile\fR Specifiy an additional file (in deb-control(5) format, as the main input file) providing packages that are not checked but used for resolving dependencies .TP .B -quiet Supress warnings and progress/timing messages .TP .B -xml Output results in XML format.TP .B -help, --help Display this list of options .SH EXAMPLE Check which packages in a particular distribution are not installable and why: edos-debcheck -failures -explain < Packages where Packages is the file pertaining to that distribution, as for instance found in the directory \fI /var/lib/apt/lists\fR. Check whether version 21.4.17-1 of the xemacs21 package is installable in a distribution described by the file Packages: edos-debcheck -explain xemacs=21.4.17-1 < Packages .SH AUTHOR Edos-debcheck has been written by Jerome Vouillon for the EDOS project. This man-page has been compiled by Ralf Treinen. .SH SEE ALSO .BR deb-control (5) is the home page of the EDOS project. .BR edos-rpmcheck (1) is the analogous tool for rpm packages. pkglab-1.4.2/distcheck/edos-rpmcheck.1000066400000000000000000000052271121467321100175310ustar00rootroot00000000000000.TH EDOS-RPMCHECK 1 2006-05-20 EDOS .SH NAME Edos-rpmcheck \- Check satisfiability of rpm package dependencies .SH SYNOPSIS \fBedos-rpmcheck\fR [option] ... [package] ... .SH DESCRIPTION .B edos-rpmcheck reads from standard input a set of rpm package descriptions. Packages may appear with multiple versions in this set. For instance, an uncompressed \fIhdlist.cz\fR is suitable as input. We say that a package is identified in this set by the pair consisting of the .I package name and of the .I package version\fR. A package (called goal) is called \fIinstallable\fR with respect to a set of packages if there exists a subset of the packages that - contains at most one version for each package name - contains the goal package (in any version, or a specific version) - all packages of the subset have their dependencies and conflicts satisfied in this subset. .B Edos-rpmcheck checks whether every package given as argument is installable with respect to the input set of packages. Specific versions can be specified by following the package name with the sign '=' and the version of the package (for instance, 'xemacs21=21.4.17-1'). If no package name is given as argument then all packages of the input set are checked for satisfiability. The constraint solving algorithm is complete, that is it finds a solution whenever there exists one, even for multiple disjunctive dependencies and deep package conflicts. This problem is computationally infeasible in theory (that is, NP-complete), but can in practice be solved very efficiently. .SH OPTIONS .TP .B -check Double-check the results .TP .B -explain Explain the results .TP .B -rules Print generated rules .TP .B -failures Only show failures .TP .B -successes Only show successes .TP .B -base \fIfile\fR Specifiy an additional file providing packages that are not checked but used for resolving dependencies .TP .B -quiet Supress warnings and progress/timing messages .TP .B -xml Output results in XML format .TP .B -help, --help Display this list of options .SH EXAMPLE Check which packages in a particular distribution are not installable and why: gunzip -c hdlist.cz | edos-rpmcheck -failures -explain where hdlist.cz is the file pertaining to that distribution. Check whether version 21.4.17-1 of the xemacs21 package is installable in a distribution described by the file Packages: gunzip -c hdlist.cz | edos-rpmcheck -explain xemacs=21.4.17-1 .SH AUTHOR Edos-rpmcheck has been written by Jerome Vouillon for the EDOS project. This man-page has been compiled by Ralf Treinen. .SH SEE ALSO is the home page of the EDOS project. .BR edos-debcheck (1) is the analogous tool for debian packages. pkglab-1.4.2/doc/000077500000000000000000000000001121467321100135215ustar00rootroot00000000000000pkglab-1.4.2/doc/Makefile000066400000000000000000000003531121467321100151620ustar00rootroot00000000000000MAIN=pkglab $(MAIN).ps: $(MAIN).dvi dvips -o $@ $< $(MAIN).dvi: $(MAIN).tex latex $< $(MAIN).pdf: $(MAIN).tex pdflatex $< $(MAIN).html: $(MAIN).tex hevea $< clean: -rm -f $(MAIN).{aux,log,dvi,ps,pdf,html,haux} .phony: cleanpkglab-1.4.2/doc/pkglab.tex000066400000000000000000000233701121467321100155100ustar00rootroot00000000000000\documentclass[a4paper]{article} \renewcommand{\familydefault}{pbk} \newcommand{\codebox}[1]{\fbox{\parbox{\textwidth}{\small \tt #1}}} %HEVEA\renewcommand{\codebox}[1]{{\tt\begin{tabular}{l}\hline{}#1\\\hline\end{tabular}}} \title{Pkglab documentation} \author{Jaap Boender} \date{April 23, 2009} \begin{document} \maketitle \section{Introduction} Pkglab is a tool for exploring open-source distributions, currently supporting Debian-style (Debian, Ubuntu) and RPM-based (Mandriva, Fedora) distributions, as well as pkgsrc summary files. This document is intended as a guide to its usage. The basic mode of operation of Pkglab is to firstly create a universe by {\em merging} one or more {\em waterways}; a waterway consists of one or more distributions. Then, the different operations provided by Pkglab (see below) can be applied to this universe. \section{Command-line options} Pkglab has the following command-line options: \begin{tabular}{|c|c|c|} \hline Option & Behaviour & Default value \\ \hline \hline {\tt -architecture} & Set the default architecture & {\tt i386} \\ {\tt -history} {\it file} & Use {\it file} for command history & {\tt \$HOME/.pkglab-history} \\ {\tt -script} {\it file} & Execute the script {\it file} & \\ {\tt -merge} {\it waterway} & Merge {\it waterway} & \\ \hline \end{tabular} \section{Example session} We start by merging the Debian Lenny distribution: \codebox{ ./pkglab.opt -merge deb:data/debian/history/2009214-debian-5.0-Packages \\ Completing conflicts... * 100.0\% \\ pkglab version 1.4 by the MANCOOSI Project \\ >} The {\tt packages} variable contains all the packages in the universe, currently 22 311: \codebox{ > count(packages) \\ 22311 \\ >} Let's see if there are any non-installable packages: \codebox{ > check(packages,packages) \\ Conflicts and dependencies... * 100.0\% \\ Solving * 100.0\% \\ Conflicts and dependencies... * 100.0\% \\ Solving * 100.0\% \\ \\ >} There are no non-installable packages. \section{Objects and operators} Pkglab knows several different types of objects: \begin{description} \item[Strings] (denoted: {\tt "\ldots"}) The name of a file or a waterway. \item[Units] (denoted: {\tt kde}) A name; combined with a version and an architecture it forms a package. \item[Packages] (denoted: {\tt kde'5:47@all}) One specific version of a unit, for a specific architecture (or for all architectures). \item[Archives] (denoted: {\tt \%name}) A mapping between dates and package sets; used to track the contents of a distribution through times \item[Dates] (denoted: {\tt YYYY-MM-DD}) \item[Date ranges] (denoted: {\tt [YYYY-MM-DD;YYYY-MM-DD]}) \item[Specifications] (denoted: {\tt [. kde (>= 5.2) .]}) A selector on the versions of a unit, in this case all versions of the unit {\tt kde} greater than or equal to {\tt 5.2}. The version is optional; {\tt [. kde .]} is a valid specification as well. \item[Sets] (denoted: {\tt \{a, b, \ldots\}}) \item[Diagnoses] The result of a check operation: a list of packages that are not installable with their reasons. \item[Functions] (denoted: {\tt \$x -> \ldots \$x \ldots}) \item[Booleans] (denoted: {\tt true} or {\tt false}) \end{description} It is possible to use variables: like in Unix shells, variable names are prefixed by a dollar sign ({\tt \$}). Assignment is done as follows: \codebox{ > \$a <- select([. kde (>= 5.2) .]) } Pkglab has the following operators: \begin{tabular}{|c|c|} \hline Operator & Function \\ \hline \hline \tt | & Set union \\ \tt \& & Set intersection \\ \tt \verb+\+ & Set difference \\ \hline \tt not and or & Boolean operators \\ \hline \tt = <> > < >= <= & Comparison (for versions, numbers and sets) \\ \hline {\it set} \verb+ ~ /+ {\it regexp} {\tt /} & Package selection by regular expression \\ \hline \end{tabular} There are inbuilt variables to show all packages, archives, source packages and units in the universe: they are called {\tt packages}, {\tt archives}, {\tt sources} and {\tt units} respectively. \section{Directives} \begin{description} \item [\#abundance {\it set}] Test {\it set} for abundance; i.e. check if all packages have their dependencies satisfied. \item [\#dump {\tt filename} {\tt expression}] Dump the result of {\tt expression} to the file {\tt filename}. \item [\#exit] Quit Pkglab. \item [\#help] Show help (also: {\tt \#help} "functions" or {\tt \#help} "directives") \item [\#merge {\it waterway}] Merge {\it waterway} with the universe. \item [\#show {\it expression}] Like {\tt \#dump}, but show the expression on screen. \item [\#type {\it expression}] Show the type of {\it expression}. \item [\#quit] The same as {\tt \#exit}. \end{description} \section{Functions} \begin{description} \item [check({\it set1}, {\it set2})] Check whether all packages in {\it set1} are installable {\em separately} using only the packages in {\it set2}. Returns a diagnosis. \item [check\_together({\it set1}, {\it set2})] Check whether all packages in {\it set1} are installable {\em together} using only the packages in {\it set2}. Returns a diagnosis. \item [closure({\it set})] Give the transitive closure of the dependencies and pre-dependencies of {\it set}, ignoring dependencies that cannot be resolved. Returns a package set. \item [conflict\_list({\it package})] Gives the conflict specification of {\it package}. Returns a list of specifications. \item [conflicts({\it set})] Gives the set of packages that have a conflict with a package in {\it set}. Returns a package set. \item [contents({\it archive}, {\it date})] Gives the packages that are in {\it archive} on {\it date}. Returns a package set. \item [count({\it set})] Returns the number of elements in {\it set}. \item [dep\_closure({\it set})] Like {\tt closure}, but uses only the dependencies of {\it set}. \item [dep\_path({\it set}, {\it pkg1}, {\it pkg2})] Shows a dependency path (if available) between {\it pkg1} and {\it pkg2} using only packages from {\tt set}. Returns either Nothing (if no dependency path can be found) or a list of packages. \item [depends({\it package})] Gives the dependency specification of {\it package}. Returns a list of lists of version specifications; each list of version specifications represents a disjunction, so that the equivalent of the dependency "A and (B or C)" would be \mbox{{\tt [ [ [. A .] ]; [ [. B .]; [. C .] ] ]}}. \item [elements({\it set})] Returns a list that contains the elements of {\it set}. \item [exists({\it set}, {\it function})] {\it function} must return a boolean; {\tt exists(x,f)} returns {\tt true} if there is an element in {\tt x} for which {\tt f} returns {\tt true}; {\tt false} otherwise. \item [forall({\it set}, {\it function})] Like {\tt exists}, but {\tt forall(x,f)} returns {\tt true} if {\tt f} returns {\tt true} for {\em all} elements of {\tt x}, and {\tt false} otherwise. \item [filter({\it set}, {\it function})] {\it function} must return a boolean; {\tt filter(x,f)} returns the set of all elements in {\tt x} for which {\tt f} returns {\tt true}. \item [install({\it set1},{\it set2})] If it is possible to install all packages in {\it set1} together using only the packages in {\it set2}, returns a subset of {\it set2} in which all dependencies of {\it set1} are satisfied. Otherwise returns the empty set. \item [installed\_size({\it package})] The size after installation of package {\it package}. Returns an integer. \item [is\_empty({\it set})] Returns {\tt true} if {\it set} is empty (has no elements). Returns {\tt false} otherwise. \item [load\_packages({\it filename})] If the file {\it filename} contains a list of package names (in the form {\tt package'version@arch}), then {\tt load\_packages} returns a package set containing these packages. \item [map({\it set},{\it function}] Apply {\it function} to all elements of {\it set}. Returns a set of the same type as {\it set}. \item [member({\it element}, {\it set})] Check whether {\it element} belongs to {\it set}. Returns a boolean. \item [pre\_closure({\it set})]. Like {\tt closure}, but uses only the pre-dependencies of {\it set}. Returns a package set. \item [provides({\it package})] Gives the units {\em explicitly} provided by {\it package}. Returns a list of version specifications. \item [range({\it archive})] Gives the dates available in {\it archive}. Returns a list of date ranges (an archive need not be continuous). \item [select({\it specification})] Gives the packages that satisfy {\it specification}. Returns a package set. \item [size({\it package})] Like {\tt installed\_size}, but gives the size of the package itself (i.e. before installation) \item [source({\it package})] Returns the source package from which {\it package} was created. \item [strong\_dep({\it set}, {\it package1}, {\it package2})] Checks whether {\it package2} is a strong dependency of {\it package1} in {\it set}; this is the case if (and only if) it is {\em NOT} possible to install {\it package1} in {\it set} without also installing {\tt package2}. \item [success({\it diagnosis})] Returns {\tt true} if {\it diagnosis} does not contain any failures, and {\tt false} otherwise. \item [trim({\it set})] Given a package set {\it set}, removes the non-installable packages from it (in the context of {\it set}). \item [unit({\it package})] Returns the unit of {\it package}. \item [versions({\it unit})] Returns a set of all packages that have {\it unit} as their unit. Returns a package set. \item [what\_provides({\it unit})] Gives all packages that provide {\it unit}. Returns a package set. \end{description} \end{document} pkglab-1.4.2/dql/000077500000000000000000000000001121467321100135345ustar00rootroot00000000000000pkglab-1.4.2/dql/.depend000066400000000000000000000006551121467321100150020ustar00rootroot00000000000000query.cmo: query.cmx: help.cmo: help.cmi help.cmx: help.cmi gregorian.cmo: gregorian.cmi gregorian.cmx: gregorian.cmi cache.cmo: cache.cmi cache.cmx: cache.cmi error.cmo: error.cmi error.cmx: error.cmi interpreter.cmo: query.cmo lexic.cmi help.cmi interpreter.cmi interpreter.cmx: query.cmx lexic.cmi help.cmx interpreter.cmi help.cmi: gregorian.cmi: cache.cmi: error.cmi: interpreter.cmi: query.cmo lexic.cmi: pkglab-1.4.2/dql/Makefile000066400000000000000000000033131121467321100151740ustar00rootroot00000000000000# Makefile NAME= dql SOURCES= lexic.ml query.ml syntax.ml help.ml gregorian.ml cache.ml error.ml \ interpreter.ml MLIS= help.mli gregorian.mli cache.mli error.mli interpreter.mli lexic.mli \ syntax.mli PACKAGES= pcre,dose2.rapids,dose2.lifetime,dose2.napkin,dose2.packetology,dose2.conduit,dose2.progress,dose2.util EXTRA_CLEAN= syntax.ml syntax.mli lexic.ml include ../Makefile.config include .depend interpreter.cmo: syntax.cmi lexic.cmo interpreter.cmx: syntax.cmx lexic.cmx syntax.ml syntax.mli: syntax.mly menhir $< syntax.cmi: query.cmo syntax.cmo: query.cmo syntax.cmi syntax.cmx: query.cmx syntax.cmi lexic.ml: lexic.mll syntax.cmi ocamllex -o $@ $< lexic.cmi: syntax.cmi lexic.cmo: syntax.cmi lexic.cmi lexic.cmx: syntax.cmx lexic.cmi CMOS= $(SOURCES:%.ml=%.cmo) CMIS= $(MLIS:%.mli=%.cmi) query.cmi CMXS= $(SOURCES:%.ml=%.cmx) OBJS= $(C_SOURCES:%.c=%.o) dql.cma: $(CMOS) ifdef PROFILE ocamlfind ocamlcp -package $(PACKAGES) -o $@ -a $^ else ocamlfind ocamlc -package $(PACKAGES) -o $@ -a $^ endif dql.cmxa: $(CMXS) ocamlfind ocamlopt -package $(PACKAGES) -o $@ -a $^ OCAMLC= ocamlfind ocamlc OCAMLCP= ocamlfind ocamlcp OCAMLOPT= ocamlfind ocamlopt OCAMLMKLIB= ocamlmklib %.cmo: %.ml ifdef PROFILE $(OCAMLCP) -package $(PACKAGES) -o $@ -c $< else $(OCAMLC) -package $(PACKAGES) -o $@ -c $< endif %.cmi: %.mli ifdef PROFILE $(OCAMLCP) -package $(PACKAGES) -o $@ -c $< else $(OCAMLC) -package $(PACKAGES) -o $@ -c $< endif %.cmx: %.ml $(OCAMLOPT) -package $(PACKAGES) -o $@ -c $< .PHONY: clean depend cmi-install clean: @rm -f $(CMOS) $(CMIS) $(CMXS:.cmx=.o) $(CMXS) $(OBJS) $(NAME).a $(NAME).cma $(NAME).cmxa $(EXTRA_CLEAN) .depend depend: ocamldep $(SOURCES) $(MLIS) > .depend pkglab-1.4.2/dql/TODO000066400000000000000000000001171121467321100142230ustar00rootroot00000000000000* Versioned features (libbonoboui in mandriva) * Fix friggin' Menhir parser !! pkglab-1.4.2/dql/cache.ml000066400000000000000000000076551121467321100151460ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, Inria Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) module type S = sig type key type thing type t val create : int option -> t val find : t -> key -> thing val mem : t -> key -> bool val add : t -> key -> thing -> unit val remove : t -> key -> unit end ;; module type SingleType = sig type t end ;; module Make(K:Map.OrderedType)(T:SingleType) = struct type key = K.t;; type thing = T.t;; type elt = { mutable priority : int; key : key; thing : thing; };; let comparator a x y = compare (a x) (a y);; let product_compare c1 c2 x y = let r = c1 x y in if r = 0 then c2 x y else r;; let compare_elements = product_compare (comparator (fun x -> x.priority)) (fun x y -> K.compare x.key y.key) ;; module KM = Map.Make(K);; module ES = Set.Make(struct type t = elt let compare = compare_elements end);; type t = { maximum_size : int; mutable current_size : int; mutable elements : ES.t; mutable map : elt KM.t; mutable decay_counter : int; mutable accesses : int; mutable hits : int };; let create m = { maximum_size = (match m with None -> (-1)|Some(x) -> x); current_size = 0; elements = ES.empty; map = KM.empty; decay_counter = 0; accesses = 0; hits = 0 } ;; let decay c = let l = ES.elements c.elements in List.iter (fun e -> e.priority <- e.priority / 2) l; c.elements <- List.fold_right ES.add l ES.empty ;; let statistics c = (c.accesses, c.current_size, if c.accesses > 0 then (float_of_int) c.hits /. (float_of_int) c.accesses else 0.0) ;; let remove c k = let e = KM.find k c.map in c.elements <- ES.remove e c.elements; c.current_size <- c.current_size - 1; c.map <- KM.remove k c.map; ;; let kick c = let e = ES.min_elt c.elements in c.elements <- ES.remove e c.elements; c.current_size <- c.current_size - 1; c.map <- KM.remove e.key c.map ;; let add c k t = if c.maximum_size <> 0 then begin if c.current_size = c.maximum_size then kick c; let e = { priority = (if c.current_size > 0 then (ES.max_elt c.elements).priority + 1 else 1); key = k; thing = t } in c.elements <- ES.add e c.elements; c.current_size <- c.current_size + 1; c.map <- KM.add k e c.map end ;; let find c k f = c.accesses <- c.accesses + 1; try let e = KM.find k c.map in c.hits <- c.hits + 1; c.elements <- ES.remove e c.elements; if e.priority < max_int then e.priority <- e.priority + 1; c.elements <- ES.add e c.elements; c.decay_counter <- c.decay_counter + 1; if c.decay_counter >= (if c.maximum_size < 0 then 2 * c.current_size else 2 * c.maximum_size) then begin c.decay_counter <- 0; decay c end; e.thing with | Not_found -> let y = f k in add c k y; y ;; let mem c k = KM.mem k c.map ;; end ;; pkglab-1.4.2/dql/cache.mli000066400000000000000000000027401121467321100153050ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, Inria Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) module type S = sig type key and thing and t val create : int option -> t val find : t -> key -> thing val mem : t -> key -> bool val add : t -> key -> thing -> unit val remove : t -> key -> unit end ;; module type SingleType = sig type t end ;; module Make : functor (K : Map.OrderedType) -> functor (T : SingleType) -> sig type key = K.t and thing = T.t type t val create : int option -> t val decay : t -> unit val statistics : t -> int * int * float val find : t -> key -> (key -> thing) -> thing val remove : t -> key -> unit val mem : t -> key -> bool val kick : t -> unit val add : t -> key -> thing -> unit end ;; pkglab-1.4.2/dql/error.ml000066400000000000000000000063021121467321100152200ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, Inria Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) let sf = Printf.sprintf;; (*** put_arrows *) let put_arrows out i j = for h = 1 to i do out " " done; for h = i to j do out "^"; done; out "\n" ;; (* ***) (*** show_highlighted *) let show_highlighted out w i j n = let m = String.length w in let j = max 0 (min (m - 1) j) in let b = min (n / 3) (j - i + 1) in let ps = min (m - b) (n - b) in let s = min (m - j - 1) ((ps + 1) / 2) in let p = min i (ps - s) in let s = min (m - j - 1) (ps - p) in let p_i = i - p in let hi_i = if p_i > 0 then begin out "..."; out (String.sub w p_i p); p + 3 end else begin out (String.sub w 0 p); p end in if b < j - i + 1 then begin let b' = b - 3 in let bl = b' / 2 in let br = b' - bl in out (String.sub w i bl); out "..."; out (String.sub w (j - br) br) end else out (String.sub w i b); if j + 1 + s < m then begin out (String.sub w (j + 1) s); out "..." end else out (String.sub w (j + 1) s); out "\n"; put_arrows out hi_i (hi_i + b - 1) ;; (* ***) (*** escape_and_record_indexes *) let escape_and_record_indexes w l = let m = String.length w in let b = Buffer.create m in let r = ref [] in for i = 0 to m - 1 do if List.mem i l then r := (i,Buffer.length b)::!r; Buffer.add_string b (String.escaped (String.make 1 w.[i])) done; if List.mem m l then r := (m,Buffer.length b)::!r; (Buffer.contents b,!r) ;; (* ***) let lower_half x = x / 2 let upper_half x = x - (x / 2) (*** show_parse_error *) let show_parse_error ~out ?(columns=75) i j x w = let m = String.length w in if m = 0 then out "Error: Syntax error -- Empty query.\n" else begin out (sf "Error: Syntax error %s of query --- %s:\n" (if i = j then if i >= m - 1 then "end" else sf "at character %d" (i + 1) else "between "^ (if i = 0 then "beginning" else sf "character %d" (i + 1))^ " and "^ (if j >= m - 1 then "end" else sf "character %d" (j + 1))) x); let (w',z) = escape_and_record_indexes w [i;j] in let m = String.length w' and i' = List.assoc i z and j' = List.assoc j z in (* show string w' highlighting i' to j' on columns columns *) let w' = if j' >= m - 1 then w'^" " else w' in show_highlighted out w' i' j' columns end ;; (* ***) pkglab-1.4.2/dql/error.mli000066400000000000000000000015001121467321100153640ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, Inria Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) val show_parse_error : out:(string -> unit) -> ?columns:int -> int -> int -> string -> string -> unit pkglab-1.4.2/dql/gregorian.ml000066400000000000000000000053171121467321100160510ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, INRIA Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) type t = { mutable year : int; mutable month : int; (* 1..12 *) mutable day : int; (* 1..31 *) };; type u = int * int * int;; let copy t = { t with year = t.year };; let to_string g = Printf.sprintf "%04d-%02d-%02d" g.year g.month g.day;; let make (y,m,d) = { year = y; month = m; day = d };; let unmake g = (g.year, g.month, g.day);; let set g (y,m,d) = g.year <- y; g.month <- m; g.day <- d;; let get g = (g.year, g.month, g.day);; let ( *** ) x y = if x = 0 then y else x ;; let compare g1 g2 = (compare g1.year g2.year) *** (compare g1.month g2.month) *** (compare g1.day g2.day) ;; let is_year_leap y = (y mod 400 = 0) || ((y land 3 = 0) && not (y mod 100 = 0)) ;; let is_leap g = let y = g.year in (y mod 400 = 0) || ((y land 3 = 0) && not (y mod 100 = 0)) ;; let month_lengths = [|31;28;31;30;31;30;30;31;30;31;30;31|] let leap_month_lengths = [|31;29;31;30;31;30;30;31;30;31;30;31|] let month_length y m = let ml = if is_year_leap y then leap_month_lengths else month_lengths in ml.(m - 1) ;; let increment g = let ml = if is_leap g then leap_month_lengths else month_lengths in g.day <- g.day + 1; if g.day > ml.(g.month - 1) then begin g.day <- 1; g.month <- g.month + 1; if g.month > 12 then begin g.year <- g.year + 1; g.month <- 1; g.day <- 1 end end ;; let decrement g = g.day <- g.day - 1; if g.day = 0 then begin g.month <- g.month - 1; if g.month = 0 then begin g.year <- g.year - 1; g.month <- 12; g.day <- 31 end else let ml = if is_leap g then leap_month_lengths else month_lengths in g.day <- ml.(g.month - 1) end ;; let today () = let tm = Unix.gmtime (Unix.gettimeofday ()) in make (tm.Unix.tm_year + 1900, tm.Unix.tm_mon + 1, tm.Unix.tm_mday) ;; let iter start stop f = let lo = make start and hi = make stop in while compare lo hi <= 0 do f (get lo); increment lo done ;; pkglab-1.4.2/dql/gregorian.mli000066400000000000000000000023651121467321100162220ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, Inria Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) type t = { mutable year : int; mutable month : int; mutable day : int; } type u = int * int * int val to_string : t -> string val make : u -> t val unmake : t -> int * int * int val set : t -> u -> unit val get : t -> u val ( *** ) : int -> int -> int val compare : t -> t -> int val is_leap : t -> bool val month_lengths : int array val month_length : int -> int -> int val leap_month_lengths : int array val increment : t -> unit val decrement : t -> unit val copy : t -> t val today : unit -> t val iter : u -> u -> (u -> unit) -> unit pkglab-1.4.2/dql/help.ml000066400000000000000000000233031121467321100150170ustar00rootroot00000000000000(* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) type tidbit = Simple of string | Bold of string | Underscore of string | Red of string | Green of string | Brown of string | Blue of string | Magenta of string | Cyan of string | White of string | Tab | Newline type colourful = tidbit list;; let tidbit_to_string (t: tidbit): string = begin match t with | Simple s -> s | Bold s -> Format.sprintf "\x1b[1m%s\x1b[0m" s | Underscore s -> Format.sprintf "\x1b[4m%s\x1b[0m" s | Red s -> Format.sprintf "\x1b[31m%s\x1b[0m" s | Green s -> Format.sprintf "\x1b[32m%s\x1b[0m" s | Brown s -> Format.sprintf "\x1b[33m%s\x1b[0m" s | Blue s -> Format.sprintf "\x1b[34m%s\x1b[0m" s | Magenta s -> Format.sprintf "\x1b[35m%s\x1b[0m" s | Cyan s -> Format.sprintf "\x1b[36m%s\x1b[0m" s | White s -> Format.sprintf "\x1b[37m%s\x1b[0m" s | Tab -> "\t" | Newline -> "\n" end;; let colourful_to_string (str: colourful): string = String.concat "" (List.map tidbit_to_string str);; let help_string = colourful_to_string [ Simple "Basic entities and operators:"; Newline; Simple " \""; Red "string"; Simple "\""; Tab; Tab; Tab; Simple "String (filename, waterway)"; Newline; Simple " "; Red "unit"; Simple "'"; Red "version"; Simple "@"; Red "arch"; Tab; Tab; Simple "Package (e.g. kde'5:47@all)"; Newline; Simple " "; Red "unit"; Simple "`"; Red "version"; Tab; Tab; Tab; Simple "Source package"; Newline; Simple " %"; Red "name"; Tab; Tab; Tab; Tab; Simple "Archive"; Newline; Simple " $"; Red "name"; Tab; Tab; Tab; Tab; Simple "Variable"; Newline; Simple " "; Red "yyyy"; Simple "-"; Red "mm"; Simple "-"; Red "dd"; Tab; Tab; Tab; Simple "Date"; Newline; Simple " ["; Red "date1"; Simple ";"; Red "date2"; Simple "]"; Tab; Tab; Tab; Simple "Date range"; Newline; Simple " [."; Red "unit"; Simple "("; Red "operator version"; Simple ").]"; Tab; Simple "Version specification (e.g. [.kde (>= 5.2).])"; Newline; Tab; Tab; Tab; Tab; Simple "(version part is optional)"; Newline; Simple " {"; Red "e1"; Simple ","; Red "e2"; Simple ","; Red "..."; Simple ","; Red "en"; Simple "}"; Tab; Tab; Simple "Set construction"; Newline; Simple " "; Red "set1"; Simple "|"; Red "set2"; Simple " "; Red "set1"; Simple "&"; Red "set2"; Simple " "; Red "set1"; Simple "\\"; Red "set2"; Tab; Simple "Set union/intersection/difference"; Newline; Simple " not "; Red "bool"; Simple " "; Red "b1"; Simple " and "; Red "b2"; Simple " "; Red "b1"; Simple " or "; Red "b2"; Tab; Simple "Boolean operators"; Newline; Simple " "; Red "x"; Simple "="; Red "y"; Simple " "; Red "x"; Simple "<>"; Red "y"; Simple " "; Red "x"; Simple ">"; Red "y"; Simple " "; Red "x"; Simple "<"; Red "y"; Simple " "; Red "x"; Simple ">="; Red "y"; Simple " "; Red "x"; Simple "<="; Red "y"; Tab; Simple "Comparison (if applicable; also for sets)"; Newline; Simple " "; Red "set"; Simple " ~ /"; Red "regexp"; Simple "/"; Tab; Tab; Simple "Regular expression matching"; Newline; Simple " "; Red "packages"; Tab; Tab; Tab; Simple "Show all packages"; Newline; Simple " "; Red "archives"; Tab; Tab; Tab; Simple "Show all archives"; Newline; Simple " "; Red "sources"; Tab; Tab; Tab; Simple "Show all source packages"; Newline; Simple " "; Red "units"; Tab; Tab; Tab; Tab; Simple "Show all units"; Newline; Simple "Other help sections:"; Newline; Simple " #help \"functions\""; Tab; Tab; Simple "Functions"; Newline; Simple " #help \"directives\""; Tab; Tab; Simple "Directives"; Newline ];; let help_functions_string = colourful_to_string [ Simple "Functions:"; Newline; Simple " check("; Red "set1"; Simple ","; Red "set2"; Simple ")"; Tab; Tab; Simple "Check whether "; Underscore "set1"; Simple " is installable using "; Underscore "set2"; Newline; Simple " check_together("; Red "set1"; Simple ","; Red "set2"; Simple ")"; Tab; Simple "Check if "; Underscore "set1"; Simple " is installable together using "; Underscore "set2"; Newline; Simple " closure("; Red "set"; Simple ")"; Tab; Tab; Tab; Simple "Dependency cone of "; Underscore "set"; Simple " (depends and pre-depends)"; Newline; Simple " conflict_list("; Red "package"; Simple ")"; Tab; Simple "Conflict specification of "; Underscore "package"; Newline; Simple " conflicts("; Red "set"; Simple ")"; Tab; Tab; Simple "Packages that conflict with packages in "; Underscore "set"; Newline; Simple " contents("; Red "archive"; Simple ","; Red "date"; Simple ")"; Tab; Simple "Contents of "; Underscore "archive"; Simple " on "; Underscore "date"; Newline; Simple " count("; Red "set"; Simple ")"; Tab; Tab; Tab; Simple "Number of elements of "; Underscore "set"; Newline; Simple " dep_closure("; Red "set"; Simple ")"; Tab; Tab; Simple "Dependency cone of "; Underscore "set"; Simple " (depends only)"; Newline; Simple " dep_path("; Red "set"; Simple ","; Red "pkg1"; Simple ","; Red "pkg2"; Simple ")"; Tab; Simple "Dependency path in "; Underscore "set"; Simple " from "; Underscore "pkg1"; Simple " to "; Underscore "pkg2"; Newline; Simple " depends("; Red "package"; Simple ")"; Tab; Tab; Simple "Dependency specification of "; Underscore "package"; Newline; Simple " elements("; Red "set"; Simple ")"; Tab; Tab; Tab; Simple "Returns a list containing the elements of "; Underscore "set"; Newline; Simple " exists("; Red "set"; Simple ","; Red "function"; Simple ")"; Tab; Tab; Underscore "function"; Simple " is true for any element of "; Underscore "set"; Newline; Simple " forall("; Red "set"; Simple ","; Red "function"; Simple ")"; Tab; Tab; Underscore "function"; Simple " is true for all elements of "; Underscore "set"; Newline; Simple " filter("; Red "set"; Simple ","; Red "function"; Simple ")"; Tab; Tab; Simple "Filter "; Underscore "set"; Simple " by "; Underscore "function"; Newline; Simple " install("; Red "set1"; Simple ","; Red "set2"; Simple ")"; Tab; Tab; Simple "Give a possible installation of "; Underscore "set1"; Simple " in "; Underscore "set2"; Newline; Simple " installed_size("; Red "package"; Simple ")"; Tab; Simple "Installed size of "; Underscore "package"; Newline; Simple " is_empty("; Red "set"; Simple ")"; Tab; Tab; Tab; Simple "Tests whether "; Underscore "set"; Simple " is empty"; Newline; Simple " load_packages("; Red "filename"; Simple ")"; Tab; Simple "Load packages from file "; Underscore "filename"; Newline; Simple " map("; Red "set"; Simple ","; Red "function"; Simple ")"; Tab; Tab; Simple "Map "; Underscore "set"; Simple " by "; Underscore "function"; Newline; Simple " member("; Red "elt"; Simple ","; Red "set"; Simple ")"; Tab; Tab; Underscore "set"; Simple " contains "; Underscore "elt"; Newline; Simple " pre_closure("; Red "set"; Simple ")"; Tab; Tab; Simple "Pre-dependency cone of "; Underscore "set"; Newline; Simple " provides("; Red "package"; Simple ")"; Tab; Tab; Simple "Units provided by "; Underscore "package"; Newline; Simple " range("; Red "archive"; Simple ")"; Tab; Tab; Simple "Range of dates available in "; Underscore "archive"; Newline; Simple " select("; Red "specification"; Simple ")"; Tab; Tab; Simple "All packages satisfying a version specification"; Newline; Simple " size("; Red "package"; Simple ")"; Tab; Tab; Tab; Simple "Package size of "; Underscore "package"; Newline; Simple " source("; Red "package"; Simple ")"; Tab; Tab; Simple "Source package of "; Underscore "package"; Newline; Simple " strong_dep("; Red "set"; Simple ","; Red "pkg1"; Simple ","; Red "pkg2"; Simple ")"; Tab; Underscore "pkg2"; Simple " is a strong dependency of "; Underscore "pkg1"; Simple " in "; Underscore "set"; Newline; Simple " success("; Red "diagnosis"; Simple ")"; Tab; Tab; Simple "Whether there are failures in "; Underscore "diagnosis"; Newline; Simple " trim("; Red "set"; Simple ")"; Tab; Tab; Tab; Simple "Remove all non-installable packages from "; Underscore "set"; Newline; Simple " unit("; Red "package"; Simple ")"; Tab; Tab; Tab; Simple "Give the unit of "; Underscore "package"; Newline; Simple " versions("; Red "unit"; Simple ")"; Tab; Tab; Simple "Give all known versions of a unit"; Newline; Simple " what_provides("; Red "unit"; Simple ")"; Tab; Tab; Simple "Packages that provide "; Underscore "unit"; Newline; ];; let help_directives_string = colourful_to_string [ Simple "Directives:"; Newline; Simple " #abundance "; Red "set"; Tab; Tab; Simple "Test a package set for abundance"; Newline; Simple " #dump "; Red "filename"; Simple " "; Red "expression"; Tab; Simple "Dump an expression to a file"; Newline; Simple " #exit"; Tab; Tab; Tab; Tab; Simple "Exit the program"; Newline; Simple " #help"; Tab; Tab; Tab; Tab; Simple "Show help"; Newline; Tab; Tab; Tab; Tab; Simple "(#help, #help \"functions\" or #help \"directives\")"; Newline; Simple " #merge "; Red "waterway"; Tab; Tab; Simple "Merge a waterway"; Newline; Simple " #show "; Red "expression"; Tab; Tab; Simple "Print an expression"; Newline; Simple " #type "; Red "expression"; Tab; Tab; Simple "Show the type of "; Underscore "expression"; Newline; Simple " #quit"; Tab; Tab; Tab; Tab; Simple "Exit the program"; Newline; ];; pkglab-1.4.2/dql/help.mli000066400000000000000000000015101121467321100151640ustar00rootroot00000000000000(* Copyright 2005-2008 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) val help_functions_string : string val help_directives_string : string val help_string : string pkglab-1.4.2/dql/interpreter.ml000066400000000000000000001542601121467321100164410ustar00rootroot00000000000000(* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) open Conduit open Napkin open Rapids open Diagnosis open Query open Formula ;; exception Parse_error of int * int * string exception Unbound_value of string exception Unknown_directive of string exception Sorry of string exception Type_error exception Because of string * exn exception Time_limit_exceeded exception Space_limit_exceeded exception Output_limit_exceeded exception Access_denied exception Not_implemented exception Quit ;; module SM = Map.Make(String) module SS = Set.Make(String) ;; type env = value_ SM.t;; (*** context *) type context = { ctx_space_limit : int; ctx_time_limit : int; ctx_output_limit : int; ctx_filesystem_access : bool; ctx_modify_database : bool; ctx_modify_environment : bool; ctx_interactive : bool; ctx_default_architecture : string; } ;; (* ***) (*** 'a t *) type 'a t = { mutable db : db; cx : context; cd : 'a conduit; mutable tm : int; (* Remaining time *) mutable sp : int; (* Remaining space *) mutable ol : int; (* Remaining output space *) mutable env : env (* Variable environment *) } ;; (* ***) let default_architecture = "i386";; (* Hard-coded *) (*** default_batch_context *) let default_batch_context ?(architecture=default_architecture) () = { ctx_space_limit = max_int; ctx_time_limit = max_int; ctx_output_limit = max_int; ctx_filesystem_access = true; ctx_modify_database = true; ctx_modify_environment = true; ctx_interactive = false; ctx_default_architecture = architecture; };; (* ***) (*** default_cli_context *) let default_cli_context ?architecture () = { (default_batch_context ?architecture ()) with ctx_interactive = true; ctx_output_limit = 100; };; (* ***) (*** default_web_context *) let default_web_context ?(architecture=default_architecture) () = { ctx_space_limit = 100_000; ctx_time_limit = 10_000; ctx_output_limit = 100_000; ctx_filesystem_access = false; ctx_modify_database = false; ctx_modify_environment = false; ctx_interactive = false; ctx_default_architecture = architecture; };; (* ***) let env0 = SM.empty;; (*** create_interpreter *) let create_interpreter db cx cd = { db = db; cx = cx; cd = cd; tm = 0; sp = 0; ol = 0; env = env0 } ;; (* ***) let sf = Printf.sprintf;; (*** apply_parser *) let apply_parser p u = let l = Lexing.from_string u in try p Lexic.token l with | Syntax.Error -> raise (Parse_error(Lexing.lexeme_start l,Lexing.lexeme_end l,"Syntax error")) | Parsing.Parse_error -> raise (Parse_error(Lexing.lexeme_start l,Lexing.lexeme_end l,"Parse error")) | Failure x -> raise (Parse_error(Lexing.lexeme_start l,Lexing.lexeme_end l,"Failure: "^x)) | Lexic.Parse_error(i,j,x) -> raise (Parse_error(i,j,x)) ;; (* ***) let parse_expression = apply_parser Syntax.expression let parse_query = apply_parser Syntax.query let parse_program = apply_parser Syntax.program ;; (*** scribe_date *) let scribe_date cd oc j = let (y,m,d) = Lifetime.ymd_of_day j in cd.cd_print oc "%04d-%02d-%02d" y m d ;; (* ***) (*** package_set_of_value *) let package_set_of_value = function | Package_set ps -> ps | _ -> raise (Because ("Package set expected", Type_error)) ;; (* ***) (*** diagnosis_of_value *) let diagnosis_of_value = function | Diagnosis dg -> dg | _ -> raise (Because ("Diagnosis expected", Type_error)) ;; (* ***) (*** package_id_of_value *) let package_id_of_value = function | Package_id p_id -> p_id | _ -> raise (Because ("Package expected", Type_error)) ;; (* ***) (*** int_of_value *) let int_of_value = function | Int x -> x | _ -> raise (Because ("Integer expected", Type_error)) ;; (* ***) (*** bool_of_value *) let bool_of_value = function | Bool b -> b | _ -> raise (Because ("Boolean expected", Type_error)) ;; (* ***) (*** source_id_of_value *) let source_id_of_value = function | Source_id s_id -> s_id | _ -> raise (Because ("Source package expected", Type_error)) (* ***) (*** archive_id_of_value *) let archive_id_of_value = function | Archive_id a_id -> a_id | _ -> raise (Because ("Archive expected", Type_error)) ;; (* ***) (*** date_of_value *) let date_of_value = function | Date j -> j | _ -> raise (Because ("Date expected", Type_error)) ;; (* ***) (*** unit_id_of_value *) let unit_id_of_value = function | Unit_id u_id -> u_id | _ -> raise (Because ("Unit expected", Type_error)) ;; (* ***) (*** string_of_value *) let string_of_value = function | String u -> u | _ -> raise (Because ("String expected", Type_error)) ;; (* ***) (*** version_of_value *) let version_of_value = function | Version (v, r) -> v, r | _ -> raise (Because ("Version number expected", Type_error)) ;; (* ***) (*** unit_id_of_string *) let unit_id_of_string it u = try Unit_index.search (get_unit_index it.db) u with | Not_found -> raise (Sorry(sf "Can't find unit %S" u)) ;; (* ***) (*** archive_id_of_string *) let archive_id_of_string it a = try Archive_index.search (get_archive_index it.db) a with | Not_found -> raise (Sorry(sf "Can't find archive %S" a)) ;; (* ***) (*** version_of_string *) let version_of_string it x = let (v, r) = Rapids.split_version x in let version_index = get_version_index it.db and release_index = get_release_index it.db in try if it.cx.ctx_modify_database then (Version_index.register version_index v, Release_index.register release_index r) else (Version_index.search version_index v, Release_index.search release_index r) with | Not_found -> raise (Sorry(sf "Can't find version %S" x)) ;; (* ***) (*** reset_output_limit *) let reset_output_limit it = it.ol <- it.cx.ctx_output_limit ;; (* ***) (*** reset_limits *) let reset_limits it = it.tm <- it.cx.ctx_time_limit; it.sp <- it.cx.ctx_space_limit; reset_output_limit it ;; (* ***) (*** tick *) let tick it = if it.tm > 0 then it.tm <- it.tm - 1 (* else raise Time_limit_exceeded *) ;; (* ***) (*** tick_out *) let tick_out it = tick it; if it.ol > 0 then it.ol <- it.ol - 1 else raise Output_limit_exceeded ;; (* ***) (*** execute_statement *) let execute_statement it s = tick it; ;; (* ***) (*** Nonary_library *) module Nonary_library = struct let units it () = Unit_set(Functions.units it.db);; let packages it () = Package_set(Functions.packages it.db);; let sources it () = Source_set(Functions.sources it.db);; let archives it () = Archive_set(Functions.archives it.db);; let table = Hashtbl.create 1009;; let resolve it = function | Nonary_operator(name, q) -> begin match !q with | None -> begin try let f = Hashtbl.find table in q := Some f; f with | Not_found -> raise (Unbound_value name) end | Some f -> f end | Units -> units it | Packages -> packages it | Sources -> sources it | Archives -> archives it (*| _ -> raise Not_implemented*) ;; end ;; (* ***) (*** Unary_library *) module Unary_library = struct (*** complement *) let complement it = function | Bool b -> Bool(not b) | _ -> raise (Because ("not: Boolean expected", Type_error)) ;; (* ***) (*** find_unit *) let find_unit it u' = Unit_id(unit_id_of_string it (string_of_value u'));; (* ***) (*** find_archive *) let find_archive it a' = Archive_id(archive_id_of_string it (string_of_value a'));; (* ***) (*** select *) let select it = function | Versioned vd -> Package_set(Functions.select it.db vd) | _ -> raise (Because ("selection: Version specification expected", Type_error)) ;; (* ***) (*** find_version *) let find_version it v' = Version(version_of_string it (string_of_value v'));; (* ***) (*** count *) let count it = function | Package_set s -> Int(Package_set.cardinal s) | Unit_set s -> Int(Unit_set.cardinal s) | Source_set s -> Int(Source_set.cardinal s) | Date_set s -> Int(Date_set.cardinal s) | Archive_set s -> Int(Archive_set.cardinal s) | _ -> raise (Because ("count: Set expected", Type_error)) ;; (* ***) (*** range *) let range it v = let db = it.db in let a_id = archive_id_of_value v in let archive_index = get_archive_index db in let a = Archive_index.data archive_index a_id in let (j0,j1) = archive_range db a in List[Date j0; Date j1] ;; (* ***) (*** closure *) let closure relations it v = let db = it.db in let ps = package_set_of_value v in let ps' = Functions.dependency_closure db ~relations ps in Package_set ps' ;; (* ***) (*** conflicts *) let conflicts it v = let db = it.db in let ps = package_set_of_value v in let ps' = Functions.conflicts db ps in Package_set ps' ;; (* ***) (*** conflicts *) let conflicts it v = let db = it.db in let ps = package_set_of_value v in let ps' = Functions.conflicts db ps in Package_set ps' ;; (* ***) (*** conflict_list *) let conflict_list it v = let p_id = package_id_of_value v in let db = it.db in let p = Functions.get_package_from_id db p_id in List( List.map begin fun v -> Versioned v end p.pk_conflicts) ;; (* ***) (*** what_provides *) let what_provides it v = let u_s = match v with | Unit_set u_s -> u_s | Unit_id u_id -> Unit_set.singleton u_id | _ -> raise (Because ("what_provides: Unit or unit set expected", Type_error)) in Package_set begin Unit_set.fold begin fun u_id p_s -> let x = ref Package_set.empty in List.iter (fun spec -> match spec with | Unit_version (pkg, _) -> x := Package_set.add pkg !x | Glob_pattern _ -> raise (Invalid_argument "Uh?") ) (Functions.unit_id_to_providers it.db u_id); Package_set.union p_s !x end u_s Package_set.empty end ;; (* ***) (*** provides *) let provides it v = let p_id = package_id_of_value v in let db = it.db in let p = Functions.get_package_from_id db p_id in List( List.map begin fun v -> Versioned v end p.pk_provides) ;; (* ***) (*** depends *) let depends it v = let p_id = package_id_of_value v in let p = Functions.get_package_from_id it.db p_id in List(List.map begin fun disjunction -> List(List.map (fun v -> Versioned v) disjunction) end p.pk_depends) ;; (* ***) let pre_depends it v = let p_id = package_id_of_value v in let p = Functions.get_package_from_id it.db p_id in List(List.map begin fun disjunction -> List(List.map (fun v -> Versioned v) disjunction) end p.pk_pre_depends) ;; (*** load_packages *) let load_packages it v = let channel = match v with String s -> open_in s | _ -> raise (Because ("load_packages: File name expected", Type_error)) in begin let set = ref Package_set.empty in let db = it.db in let arch_index = get_architecture_index db and package_index = get_package_index db and version_index = get_version_index db and release_index = get_release_index db and unit_index = get_unit_index db in begin try while true do let l = input_line channel in Scanf.sscanf l "%[^']'%[^@]@@%s" (fun u x a -> let (v, r) = Rapids.split_version x in try let u_id = Unit_index.search unit_index u in try let a_id = Architecture_index.search arch_index (if a = "" then it.cx.ctx_default_architecture else a) in try let v_id = Version_index.get_id (Version_index.search version_index v) in try let r_id = Release_index.get_id (Release_index.search release_index r) in try let p_id = Package_index.search1 package_index (u_id, v_id, r_id, a_id) in set := Package_set.add p_id !set with | Not_found -> raise (Sorry (sf "Can't find package %s'%s@%s" u x a)) with | Not_found -> raise (Sorry (sf "Can't find version %S" x)) with | Not_found -> raise (Sorry (sf "Can't find version %S" x)) with | Not_found -> raise (Sorry (sf "Can't find architecture %S" a)) with | Not_found -> raise (Sorry (sf "Can't find unit %S" u))) done with End_of_file -> close_in channel end; Package_set !set end;; (* ***) (*** success *) let success it v = begin match v with | Diagnosis dg -> Bool (Array.length dg.dg_failures = 0) | _ -> raise (Because ("success: Diagnosis expected", Type_error)) end;; (* ***) (*** unit_of *) let unit_of it v = let p_id = package_id_of_value v in let p = Functions.get_package_from_id it.db p_id in Unit_id p.pk_unit;; (* ***) (*** source_of *) let source_of it v = let p_id = package_id_of_value v in let p = Functions.get_package_from_id it.db p_id in Source_id p.pk_source;; (* ***) let size_of it v = let p_id = package_id_of_value v in let p = Functions.get_package_from_id it.db p_id in Int (Int64.to_int p.pk_size);; let installed_size_of it v = let p_id = package_id_of_value v in let p = Functions.get_package_from_id it.db p_id in Int (Int64.to_int p.pk_installed_size);; let elements_of it v = match v with | Package_set s -> List (List.map (fun p -> Package_id p) (Package_set.elements s)) | Unit_set s -> List (List.map (fun u -> Unit_id u) (Unit_set.elements s)) | Source_set s -> List (List.map (fun i -> Source_id i) (Source_set.elements s)) | Date_set s -> List (List.map (fun d -> Date d) (Date_set.elements s)) | Archive_set s -> List (List.map (fun a -> Archive_id a) (Archive_set.elements s)) | _ -> raise (Because ("elements: Set expected", Type_error));; let is_empty it v = match v with | Package_set s -> Bool (Package_set.is_empty s) | Unit_set s -> Bool (Unit_set.is_empty s) | Source_set s -> Bool (Source_set.is_empty s) | Date_set s -> Bool (Date_set.is_empty s) | Archive_set s -> Bool (Archive_set.is_empty s) | _ -> raise (Because ("is_empty: Set expected", Type_error));; let trim it v = match v with | Package_set s -> Package_set (Installability.trim it.db s) | _ -> raise (Because ("trim: package set expected", Type_error));; let versions_of it v = match v with | Unit_id u_id -> Package_set (Functions.unit_id_to_package_set it.db u_id) | _ -> raise (Because ("versions: unit expected", Type_error));; let table = Hashtbl.create 1009;; let resolve it = function | Unary_operator(name, q) -> begin match !q with | None -> begin try let f = Hashtbl.find table in q := Some f; f with | Not_found -> raise (Unbound_value name) end | Some f -> f end | Complement -> complement it | Find_unit -> find_unit it | Find_archive -> find_archive it | Find_version -> find_version it | Count -> count it | Select -> select it | Range -> range it | Closure -> closure [`Pre;`Dep] it | Pre_closure -> closure [`Pre] it | Dep_closure -> closure [`Dep] it | Conflicts -> conflicts it | Conflict_list -> conflict_list it | What_provides -> what_provides it | Provides -> provides it | Depends -> depends it | Pre_depends -> pre_depends it | Load_packages -> load_packages it | Success -> success it | Unit -> unit_of it | Source -> source_of it | Size -> size_of it | Installed_size -> installed_size_of it | Elements -> elements_of it | Is_empty -> is_empty it | Versions -> versions_of it | Trim -> trim it | _ -> raise Not_implemented ;; end ;; (* ***) (*** Binary_library *) module Binary_library = struct (*** intersection *) let intersection it v1 v2 = match (v1,v2) with | Package_set ps1, Package_set ps2 -> Package_set(Package_set.inter ps1 ps2) | Unit_set us1, Unit_set us2 -> Unit_set(Unit_set.inter us1 us2) | Source_set ss1, Source_set ss2 -> Source_set(Source_set.inter ss1 ss2) | Archive_set ss1, Archive_set ss2 -> Archive_set(Archive_set.inter ss1 ss2) | Bool b1, Bool b2 -> Bool(b1 && b2) | Date_set ds1, Date_set ds2 -> Date_set(Date_set.inter ds1 ds2) | (Package_set _|Unit_set _|Source_set _|Archive_set _|Date_set _), Nothing -> Nothing | Nothing, (Package_set _|Unit_set _|Source_set _|Archive_set _|Date_set _) -> Nothing | Nothing, Nothing -> Nothing | _, _ -> raise (Because ("&: Set or boolean expected", Type_error)) ;; (* ***) (*** union *) let union it v1 v2 = match (v1,v2) with | Package_set ps1, Package_set ps2 -> Package_set(Package_set.union ps1 ps2) | Unit_set us1, Unit_set us2 -> Unit_set(Unit_set.union us1 us2) | Source_set ss1, Source_set ss2 -> Source_set(Source_set.union ss1 ss2) | Archive_set as1, Archive_set as2 -> Archive_set(Archive_set.union as1 as2) | Date_set ds1, Date_set ds2 -> Date_set(Date_set.union ds1 ds2) | (Package_set _|Unit_set _|Source_set _|Archive_set _|Date_set _), Nothing -> v1 | Nothing, (Package_set _|Unit_set _|Source_set _|Archive_set _|Date_set _) -> v2 | Nothing, Nothing -> Nothing | Bool b1, Bool b2 -> Bool(b1 or b2) | _, _ -> raise (Because ("|: Set or boolean expected", Type_error)) ;; (* ***) (*** diff *) let diff it v1 v2 = match (v1,v2) with | Package_set ps1, Package_set ps2 -> Package_set(Package_set.diff ps1 ps2) | Unit_set us1, Unit_set us2 -> Unit_set(Unit_set.diff us1 us2) | Source_set ss1, Source_set ss2 -> Source_set(Source_set.diff ss1 ss2) | Archive_set as1, Archive_set as2 -> Archive_set(Archive_set.diff as1 as2) | Date_set ds1, Date_set ds2 -> Date_set(Date_set.diff ds1 ds2) | Bool b1, Bool b2 -> Bool(b1 && not b2) | (Package_set _|Unit_set _|Source_set _|Archive_set _|Date_set _), Nothing -> v1 | Nothing, (Package_set _|Unit_set _|Source_set _|Archive_set _|Date_set _) -> Nothing | Nothing, Nothing -> Nothing | _, _ -> raise (Because ("\\: Set or boolean expected", Type_error)) ;; (* ***) (*** member *) let member v1 v2 = match (v1, v2) with | _, Nothing -> Bool false | Package_id p_id, Package_set ps -> Bool (Package_set.mem p_id ps) | Unit_id u_id, Unit_set us -> Bool (Unit_set.mem u_id us) | Source_id s_id, Source_set ss -> Bool (Source_set.mem s_id ss) | Archive_id a_id, Archive_set ars -> Bool (Archive_set.mem a_id ars) | Date d, Date_set ds -> Bool (Date_set.mem d ds) | _, _ -> raise (Because ("member: element and set expected", Type_error)) (* ***) (*** regexp_match *) let regexp_match it v1 v2 = match v1 with | Regexp rex -> begin let b = Buffer.create 128 in let cd = conduit_of_buffer b in let f u = Pcre.pmatch ~rex u in let matcher filter scribe set = filter begin fun id -> Buffer.clear b; scribe it.db cd cd.cd_out_channel id; f (Buffer.contents b) end set in match v2 with | Package_set s -> Package_set( matcher Package_set.filter (fun db cd oc p_id -> Functions.scribe_package_from_id db cd oc p_id) s) | Unit_set s -> Unit_set(matcher Unit_set.filter Functions.scribe_unit_from_id s) | Source_set s -> Source_set(matcher Source_set.filter Functions.scribe_source_from_id s) | Archive_set s -> Archive_set(matcher Archive_set.filter Functions.scribe_archive_from_id s) | Date_set s -> Date_set(matcher Date_set.filter (fun _ cd oc -> scribe_date cd oc) s) | _ -> raise (Because ("regexp: Set expected as first argument", Type_error)) end | _ -> raise (Because ("regexp: Regular expression expected as second argument", Type_error)) ;; (* ***) (*** find_source *) let find_source it v1 v2 = let db = it.db in let u = string_of_value v1 and v = string_of_value v2 in let source_index = get_source_index db in try let s_id = Source_index.search source_index (u,v) in Source_id s_id with | Not_found -> raise (Sorry(sf "Can't find source %s`%s" u v)) ;; (* ***) (*** contents *) let contents it v1 v2 = let a_s = match v1 with | Archive_id a_id -> Archive_set.singleton a_id | Archive_set a_s -> a_s | _ -> raise (Because ("contents: Archive or archive set expected as first argument", Type_error)) in let j_s = match v2 with | Date j -> Date_set.singleton j | Date_set j_s -> j_s | _ -> raise (Because ("contents: Date or date set expected as second argument", Type_error)) in let archive_index = get_archive_index it.db in let ps = Archive_set.fold begin fun a_id set -> let a = Archive_index.data archive_index a_id in Date_set.fold begin fun j set -> Package_set.union (get_archive_contents a j) set end j_s set end a_s Package_set.empty in Package_set ps ;; (* ***) (*** check *) let check it v1 v2 = (* let module S = Solver in *) let db = it.db in let targets = package_set_of_value v1 in let available = package_set_of_value v2 in let ind = new Progress.formatter_indicator ~decimation:1000 ~label:"Solving" ~fmt:(Format.std_formatter) () in Diagnosis begin Installability.check db (* ~log: begin fun msg -> it.cd.cd_print it.cd.cd_out_channel "Solver: %s\n%!" msg end *) ~indicator:ind ~targets ~available () end;; (* ***) (*** check_together *) let check_together it v1 v2 = (* let module S = Solver in *) let db = it.db in let targets = package_set_of_value v1 in let available = package_set_of_value v2 in let ind = new Progress.formatter_indicator ~decimation:1000 ~label:"Solving" ~fmt:(Format.std_formatter) () in Diagnosis_list begin Installability.check_together db (* ~log: begin fun msg -> it.cd.cd_print it.cd.cd_out_channel "Solver: %s\n%!" msg end *) ~indicator:ind ~targets ~available () end;; (* ***) (*** install *) let install it v1 v2 = (* let module S = Solver in *) let db = it.db in let targets = package_set_of_value v1 in let available = package_set_of_value v2 in let ind = new Progress.formatter_indicator ~decimation:1000 ~label:"Solving" ~fmt:(Format.std_formatter) () in Package_set (Installability.install db (* ~log: begin fun msg -> it.cd.cd_print it.cd.cd_out_channel "Solver: %s\n%!" msg end *) ~indicator:ind ~targets ~available () ) ;; (* ***) (*** andify_value_list *) let rec andify_value_list vl = begin match vl with [] -> true | h::t -> (match h with Bool b -> if b then (andify_value_list t) else false | _ -> raise (Because ("function should return booleans", Type_error))) end;; (* ***) (*** orify_value_list *) let rec orify_value_list vl = begin match vl with [] -> false | h::t -> (match h with Bool b -> if b then true else (orify_value_list t) | _ -> raise (Because ("function should return booleans", Type_error))) end;; (* ***) (*** iterate *) let iterate ifier v1 v2 = begin match v1 with | Date_set d_s -> begin match v2 with | Thunk f -> Bool (ifier (List.map (fun d -> f (Date d)) (Date_set.elements d_s))) | _ -> raise (Because ("Function expected as second argument", Type_error)) end | Package_set p_s -> begin match v2 with | Thunk f -> Bool (ifier (List.map (fun p -> f (Package_id p)) (Package_set.elements p_s))) | _ -> raise (Because ("Function expected as second argument", Type_error)) end | Unit_set u_s -> begin match v2 with | Thunk f -> Bool (ifier (List.map (fun u -> f (Unit_id u)) (Unit_set.elements u_s))) | _ -> raise (Because ("Function expected as second argument", Type_error)) end | Source_set s_s -> begin match v2 with | Thunk f -> Bool (ifier (List.map (fun s -> f (Source_id s)) (Source_set.elements s_s))) | _ -> raise (Because ("Function expected as second argument", Type_error)) end | Archive_set a_s -> begin match v2 with | Thunk f -> Bool (ifier (List.map (fun a -> f (Archive_id a)) (Archive_set.elements a_s))) | _ -> raise (Because ("Function expected as second argument", Type_error)) end | _ -> raise (Because ("Set expected as first argument", Type_error)) end;; (* ***) (*** filter *) let filter v1 v2 = begin match v1 with | Date_set d_s -> begin match v2 with | Thunk f -> Date_set (Date_set.filter (fun d -> bool_of_value (f (Date d))) d_s) | _ -> raise (Because ("filter: Function expected as second argument", Type_error)) end | Package_set p_s -> begin match v2 with | Thunk f -> Package_set (Package_set.filter (fun p -> bool_of_value (f (Package_id p))) p_s) | _ -> raise (Because ("filter: Function expected as second argument", Type_error)) end | Unit_set u_s -> begin match v2 with | Thunk f -> Unit_set (Unit_set.filter (fun u -> bool_of_value (f (Unit_id u))) u_s) | _ -> raise (Because ("filter: Function expected as second argument", Type_error)) end | Source_set s_s -> begin match v2 with | Thunk f -> Source_set (Source_set.filter (fun s -> bool_of_value (f (Source_id s))) s_s) | _ -> raise (Because ("filter: Function expected as second argument", Type_error)) end | Archive_set a_s -> begin match v2 with | Thunk f -> Archive_set (Archive_set.filter (fun a -> bool_of_value (f (Archive_id a))) a_s) | _ -> raise (Because ("filter: Function expected as second argument", Type_error)) end | _ -> raise (Because ("filter: Set expected as first argument", Type_error)) end;; (* ***) (*** list_to_set *) let list_to_set l = begin match l with | [] -> Nothing | h::t -> begin match h with | Unit_id _ -> Unit_set (List.fold_left (fun set x -> Unit_set.add x set) Unit_set.empty (List.map unit_id_of_value l)) | Package_id _ -> Package_set (List.fold_left (fun set x -> Package_set.add x set) Package_set.empty (List.map package_id_of_value l)) | Source_id _ -> Source_set (List.fold_left (fun set x -> Source_set.add x set) Source_set.empty (List.map source_id_of_value l)) | Archive_id _ -> Archive_set (List.fold_left (fun set x -> Archive_set.add x set) Archive_set.empty (List.map archive_id_of_value l)) | Date _ -> Date_set (List.fold_left (fun set x -> Date_set.add x set) Date_set.empty (List.map date_of_value l)) | _ -> raise Type_error end end;; (* ***) (*** map *) let map v1 v2 = begin match v1 with | Date_set d_s -> begin match v2 with | Thunk f -> list_to_set (List.rev_map (fun d -> f (Date d)) (Date_set.elements d_s)) | _ -> raise (Because ("map: Function expected as second argument", Type_error)) end | Package_set p_s -> begin match v2 with | Thunk f -> list_to_set (List.rev_map (fun p -> f (Package_id p)) (Package_set.elements p_s)) | _ -> raise (Because ("map: Function expected as second argument", Type_error)) end | Unit_set u_s -> begin match v2 with | Thunk f -> list_to_set (List.rev_map (fun u -> f (Unit_id u)) (Unit_set.elements u_s)) | _ -> raise (Because ("map: Function expected as second argument", Type_error)) end | Source_set s_s -> begin match v2 with | Thunk f -> list_to_set (List.rev_map (fun s -> f (Source_id s)) (Source_set.elements s_s)) | _ -> raise (Because ("map: Function expected as second argument", Type_error)) end | Archive_set a_s -> begin match v2 with | Thunk f -> list_to_set (List.rev_map (fun a -> f (Archive_id a)) (Archive_set.elements a_s)) | _ -> raise (Because ("map: Function expected as second argument", Type_error)) end | List l -> begin match v2 with | Thunk f -> List (List.map f l) | _ -> raise (Because ("map: Function expected as second argument", Type_error)) end | _ -> raise (Because ("map: Set or list expected as first argument", Type_error)) end;; (* ***) (*** exists *) let exists v1 v2 = begin end;; (* ***) (*** comparison *) let rec comparison it op v1 v2 = let rpmcmp it vn1 r1 vn2 r2 = let vcmp = Version_index.compare_versions (Rapids.get_version_index it.db) in let rcmp = Release_index.compare_versions (Rapids.get_release_index it.db) in begin if vcmp vn1 vn2 < 0 then -1 else if vcmp vn1 vn2 > 0 then 1 else (* vcmp vn1 vn2 = 0 *) let rs1 = Release_index.get_version r1 and rs2 = Release_index.get_version r2 in begin if (rs1 = None) || (rs2 = None) then 0 else if rcmp r1 r2 < 0 then -1 else if rcmp r1 r2 > 0 then 1 else (* rcmp r1 r2 = 0 *) 0 end end in let fullcmp x = match op with Eq -> x = 0 | Lt -> x < 0 | Le -> x <= 0 | Ge -> x >= 0 | Gt -> x > 0 | Ne -> x <> 0 in let somecmp x = match op with Eq -> x = 0 | Ne -> x <> 0 | _ -> raise (Because ("This comparison has no meaning", Type_error)) in begin match v1, v2 with | Nothing, Nothing -> Bool true | String s1, String s2 -> Bool (fullcmp (compare s1 s2)) | Int i1, Int i2 -> Bool (fullcmp (compare i1 i2)) | Float f1, Float f2 -> Bool (fullcmp (compare f1 f2)) | Date d1, Date d2 -> Bool (fullcmp (compare d1 d2)) | Bool b1, Bool b2 -> Bool (fullcmp (compare b1 b2)) | Archive_id a1, Archive_id a2 -> Bool (somecmp (compare a1 a2)) | Unit_id u1, Unit_id u2 -> Bool (somecmp (compare u1 u2)) | Package_id p1, Package_id p2 -> Bool (somecmp (compare p1 p2)) | Source_id s1, Source_id s2 -> Bool (somecmp (compare s1 s2)) | Version (vn1, r1), Version (vn2, r2) -> Bool (if Rapids.get_liquid it.db = Some RPM then fullcmp (rpmcmp it vn1 r1 vn2 r2) else fullcmp (let x = Version_index.compare_versions (Rapids.get_version_index it.db) vn1 vn2 in if x = 0 then Release_index.compare_versions (Rapids.get_release_index it.db) r1 r2 else x)) | Date_set ds1, Date_set ds2 -> Bool (fullcmp (Date_set.compare ds1 ds2)) | Package_set ps1, Package_set ps2 -> Bool (fullcmp (Package_set.compare ps1 ps2)) | Unit_set us1, Unit_set us2 -> Bool (fullcmp (Unit_set.compare us1 us2)) | Source_set ss1, Source_set ss2 -> Bool (fullcmp (Source_set.compare ss1 ss2)) | Archive_set as1, Archive_set as2 -> Bool (fullcmp (Archive_set.compare as1 as2)) | List l1, List l2 -> begin match op with | Eq -> (try Bool (List.fold_left2 (fun old x1 x2 -> old && bool_of_value (comparison it Eq x1 x2)) true l1 l2) with Invalid_argument _ -> Bool false) | Ne -> (try Bool (List.fold_left2 (fun old x1 x2 -> old || bool_of_value (comparison it Ne x1 x2)) false l1 l2) with Invalid_argument _ -> Bool true) | _ -> raise Type_error end | _, _ -> raise Type_error end;; (* ***) let table = Hashtbl.create 1009;; (*** resolve *) let resolve it = function | Binary_operator(name, q) -> begin match !q with | None -> begin try let f = Hashtbl.find table in q := Some f; f with | Not_found -> raise (Unbound_value name) end | Some f -> f end | Intersection -> intersection it | Union -> union it | Diff -> diff it | Member -> member | Match -> regexp_match it | Find_source -> find_source it | Contents -> contents it | Check -> check it | Check_together -> check_together it | Install -> install it | Forall -> iterate andify_value_list | Exists -> iterate orify_value_list | Filter -> filter | Map -> map | Comparison x -> comparison it x | _ -> raise Not_implemented ;; (* ***) end ;; (* ***) (*** Ternary_library *) module Ternary_library = struct (*** build_versioned *) let build_versioned it u_id' op' v' = let u_id = unit_id_of_value u_id' in Versioned begin match op' with | Nothing -> if v' = Nothing then Unit_version (u_id, Sel_ANY) else raise (Because ("Comparison operator expected", Type_error)) | String op -> begin let v = version_of_value v' in match op with | "<" -> Unit_version (u_id, Sel_LT v) | "<=" -> Unit_version (u_id, Sel_LEQ v) | "=" -> Unit_version (u_id, Sel_EQ v) | ">=" -> Unit_version (u_id, Sel_GEQ v) | ">" -> Unit_version (u_id, Sel_GT v) | _ -> raise (Sorry(sf "Unknown version comparison operator %S" op)) end | _ -> raise (Because("Bad type for op", Type_error)) end ;; (* ***) (*** find_package *) let find_package it v1 v2 v3 = let db = it.db in let architecture_index = get_architecture_index db in let package_index = get_package_index db in let version_index = get_version_index db in let release_index = get_release_index db in let unit_index = get_unit_index db in let (u,x,a) = match (v1,v2,v3) with | String u, String x, String a -> (u, x, a) | String u, String x, Nothing -> (u, x, it.cx.ctx_default_architecture) | _ -> raise Type_error in let (v, r) = Rapids.split_version x in try let u_id = Unit_index.search unit_index u in try let a_id = Architecture_index.search architecture_index a in try let v_id = Version_index.get_id (Version_index.search version_index v) in try let r_id = Release_index.get_id (Release_index.search release_index r) in try let p_id = Package_index.search1 package_index (u_id, v_id, r_id, a_id) in Package_id p_id with | Not_found -> raise (Sorry(sf "Can't find package %s'%s@%s" u x a)) with | Not_found -> raise (Sorry(sf "Can't find version %S" x)) with | Not_found -> raise (Sorry(sf "Can't find version %S" x)) with | Not_found -> raise (Sorry(sf "Can't find architecture %S" a)) with | Not_found -> raise (Sorry(sf "Can't find unit %S" u)) ;; (* ***) (*** check_strong_dependency *) let check_strong_dependency it vs v1 v2 = begin let ps = package_set_of_value vs and p1 = package_id_of_value v1 and p2 = package_id_of_value v2 in Bool (Installability.strong_dep it.db ps p1 p2) end;; let dependency_path it vs v1 v2 = begin let ps = package_set_of_value vs and p1 = package_id_of_value v1 and p2 = package_id_of_value v2 in match Functions.dependency_path it.db ps p1 p2 with | None -> Nothing | Some l -> List (List.map (fun p -> Package_id p) l) end;; let table = Hashtbl.create 1009;; (*** resolve *) let resolve it = function | Ternary_operator(name, q) -> begin match !q with | None -> begin try let f = Hashtbl.find table in q := Some f; f with | Not_found -> raise (Unbound_value name) end | Some f -> f end | Find_package -> find_package it | Build_versioned -> build_versioned it | Strong_dep -> check_strong_dependency it | Dep_path -> dependency_path it (* | _ -> raise Not_implemented *) ;; (* ***) end ;; (* ***) (*** replace_free_variables *) let replace_free_variables_of_expression ~bound ~env ~expression = let rec loop bound = function | Content(Variable v) as x -> begin if SS.mem v bound then x else try Constant(SM.find v env) with | Not_found -> raise (Unbound_value v) end | Ternary(op,x1,x2,x3) -> Ternary(op, loop bound x1, loop bound x2, loop bound x3) | Content(Index(x1,x2)) -> Content(Index(loop bound x1, loop bound x2)) | Binary(op,x1,x2) -> Binary(op, loop bound x1, loop bound x2) | Apply(x1,x2) -> Apply(loop bound x1, loop bound x2) | Constant _ | Nonary _ as x -> x | Unary(op, x) -> Unary(op, loop bound x) | List_constructor xl -> List_constructor(List.map (fun x -> loop bound x) xl) | Set_constructor xl -> Set_constructor(List.map (fun x -> loop bound x) xl) | Formula_constructor f -> Formula_constructor(Formula.map (fun x -> loop bound x) f) | Lambda(n,x) -> Lambda(n, loop (SS.add n bound) x) in loop bound expression ;; (* ***) (*** eval_expression *) let rec eval_expression it env x = tick it; match x with | Constant r -> r | Nonary b -> let f = Nonary_library.resolve it b in f () | Unary(b, x) -> let f = Unary_library.resolve it b in let y = eval_expression it env x in f y | Binary(b, x1, x2) -> let f = Binary_library.resolve it b in let y1 = eval_expression it env x1 in let y2 = eval_expression it env x2 in f y1 y2 | Ternary(b, x1, x2, x3) -> let f = Ternary_library.resolve it b in let y1 = eval_expression it env x1 in let y2 = eval_expression it env x2 in let y3 = eval_expression it env x3 in f y1 y2 y3 | Apply(x1,x2) -> let y1 = eval_expression it env x1 in let y2 = eval_expression it env x2 in begin match y1 with | Thunk f -> f y2 | _ -> raise (Because ("Type error in function application", Type_error)) end | Content(Variable n) -> begin try SM.find n env with | Not_found -> raise (Unbound_value n) end (*| Content(Index(x1, x2)) ->*) | Lambda(x,f) -> let f' = replace_free_variables_of_expression ~bound:(SS.singleton x) ~env ~expression:f in (Thunk(fun v -> let env' = SM.add x v env in eval_expression it env' f')) | List_constructor xl -> List(List.map (eval_expression it env) xl) | Formula_constructor f -> Formula(Formula.map (eval_expression it env) f) | Set_constructor xl -> let yl = List.map (eval_expression it env) xl in begin match yl with | [] -> Nothing | y1 :: _ -> match y1 with | Unit_id _ -> Unit_set(List.fold_left (fun set y -> Unit_set.add (unit_id_of_value y) set) Unit_set.empty yl) | Package_id _ -> Package_set(List.fold_left (fun set y -> Package_set.add (package_id_of_value y) set) Package_set.empty yl) | Source_id _ -> Source_set(List.fold_left (fun set y -> Source_set.add (source_id_of_value y) set) Source_set.empty yl) | Archive_id _ -> Archive_set(List.fold_left (fun set y -> Archive_set.add (archive_id_of_value y) set) Archive_set.empty yl) | Date _ -> Date_set(List.fold_left (fun set y -> Date_set.add (date_of_value y) set) Date_set.empty yl) | _ -> raise (Because ("Type error in set construction", Type_error)) end | _ -> raise Not_implemented ;; (* ***) (*** display_value *) let display_value it v = let db = it.db in let cd = it.cd in let oc = cd.cd_out_channel in let fp = cd.cd_print in let p_package_id oc p_id = let default_architecture = try Some(Architecture_index.search (get_architecture_index db) it.cx.ctx_default_architecture) with | Not_found -> None in Functions.scribe_package_from_id db cd oc ?default_architecture p_id in let p_set iter set scribe = let first = ref true in fp oc "{"; begin try iter begin fun id -> tick_out it; if !first then first := false else fp oc ","; fp oc " %a" (scribe db cd) id end set; fp oc " }"; with | Output_limit_exceeded -> fp oc ", ... }" end in let rec p_value oc v = tick_out it; match v with | Bool b -> fp oc "%b" b | String u -> fp oc "%S" u | Date j -> scribe_date cd oc j | Int i -> fp oc "%d" i | Float f -> fp oc "%g" f | Version v_n -> Functions.scribe_version_from_number db cd oc v_n | Unit_id u_id -> Functions.scribe_unit_from_id db cd oc u_id | Archive_id a_id -> Functions.scribe_archive_from_id db cd oc a_id | Package_id p_id -> p_package_id oc p_id | Source_id s_id -> Functions.scribe_source_from_id db cd oc s_id | Thunk _ -> fp oc "" | List [] -> fp oc "[]" | Formula f -> fp oc "<< %a >>" (p_formula ~nervous:false) f | List(v1 :: vr) -> fp oc "[%a" p_value v1; begin try List.iter begin fun v -> tick_out it; fp oc ";%a" p_value v end vr with | Output_limit_exceeded -> fp oc "; ..." end; fp oc "]" | Nothing -> fp oc "{ }" | Archive_set ars -> p_set Archive_set.iter ars Functions.scribe_archive_from_id | Package_set ps -> p_set Package_set.iter ps (fun _ cd oc p_id -> p_package_id oc p_id) | Unit_set us -> p_set Unit_set.iter us Functions.scribe_unit_from_id | Source_set ss -> p_set Source_set.iter ss Functions.scribe_source_from_id | Date_set ss -> p_set Date_set.iter ss (fun _ cd oc -> scribe_date cd oc) | Versioned spec -> begin match spec with | Unit_version (u_id, s) -> begin fp oc "[. %a" (Functions.scribe_unit_from_id db cd) u_id; match s with | Sel_ANY -> fp oc " .]" | Sel_LT v -> fp oc " (< %a) .]" (Functions.scribe_version_from_number db cd) v | Sel_LEQ v -> fp oc " (<= %a) .]" (Functions.scribe_version_from_number db cd) v | Sel_EQ v -> fp oc " (= %a) .]" (Functions.scribe_version_from_number db cd) v | Sel_GEQ v -> fp oc " (>= %a) .]" (Functions.scribe_version_from_number db cd) v | Sel_GT v -> fp oc " (> %a) .]" (Functions.scribe_version_from_number db cd) v end | Glob_pattern g -> fp oc "%s .]" g end | Diagnosis dg -> fp oc "" dg.dg_closure_size (Array.length dg.dg_failures) | Diagnosis_list dg -> fp oc "" dg.dg_closure_size (Array.length dg.dg_failures) | _ -> fp oc "" and p_formula ?(nervous=false) oc f = tick_out it; match f with | True|And[] -> fp oc "true" | False|Or[] -> fp oc "false" | And[f]|Or[f] -> p_formula ~nervous oc f | And(f1 :: fr) -> fp oc "%a " (p_formula ~nervous:true) f1; List.iter begin fun f -> fp oc "and %a" (p_formula ~nervous:true) f; end fr | Or(f1 :: fr) -> if nervous then fp oc "("; fp oc "%a " (p_formula ~nervous:false) f1; List.iter begin fun f -> fp oc "or %a" (p_formula ~nervous:false) f; end fr; if nervous then fp oc ")" | Not f -> fp oc "not "; fp oc "%a" (p_formula ~nervous:true) f | Atom v -> fp oc "%a" p_value v (* XXX *) in p_value oc v; fp oc "\n" ;; (* ***) (*** display_diagnosis *) let display_diagnosis it dg = let db = it.db in let cd = it.cd in let oc = cd.cd_out_channel in let fp = cd.cd_print in fp oc "Diagnosis:\n"; fp oc " Conflicts: %d\n" dg.dg_conflicts; fp oc " Disjunctions: %d\n" dg.dg_disjunctions; fp oc " Dependencies: %d\n" dg.dg_dependencies; fp oc " Failures (total %d):\n" (Array.length dg.dg_failures); let print_package oc p_id = Functions.scribe_package_from_id db cd oc p_id in let show_range spec = begin match spec with | Unit_version (u_id, s) -> begin fp oc "%a" (Functions.scribe_unit_from_id db cd) u_id; match s with | Sel_ANY -> () | Sel_LT v -> fp oc " (< %a)" (Functions.scribe_version_from_number db cd) v | Sel_LEQ v -> fp oc " (<= %a)" (Functions.scribe_version_from_number db cd) v | Sel_EQ v -> fp oc " (= %a)" (Functions.scribe_version_from_number db cd) v | Sel_GEQ v -> fp oc " (>= %a)" (Functions.scribe_version_from_number db cd) v | Sel_GT v -> fp oc " (> %a)" (Functions.scribe_version_from_number db cd) v end | Glob_pattern g -> fp oc "%s" g end in Array.iter begin fun (p_id, rl) -> fp oc " Package %a cannot be installed:\n" print_package p_id; List.iter begin function | Not_available p_id' -> fp oc " %a is not available\n" print_package p_id' | Requested p_id' -> fp oc " %a has been requested\n" print_package p_id' | Conflict(p_id',p_id'') -> fp oc " %a and %a conflict\n" print_package p_id' print_package p_id'' | Empty_disjunction(p_id', rl) -> fp oc " %a depends on missing:\n" print_package p_id'; List.iter begin fun r -> fp oc " - "; show_range r; fp oc "\n" end rl | Dependency(p_id', dl) -> fp oc " %a depends on one of:\n" print_package p_id'; List.iter begin fun p_id'' -> fp oc " - %a\n" print_package p_id'' end dl end rl end dg.dg_failures ;; (* ***) (*** display_diagnosis *) let display_diagnosis_list it dg = let db = it.db in let cd = it.cd in let oc = cd.cd_out_channel in let fp = cd.cd_print in fp oc "Diagnosis:\n"; fp oc " Conflicts: %d\n" dg.dg_conflicts; fp oc " Disjunctions: %d\n" dg.dg_disjunctions; fp oc " Dependencies: %d\n" dg.dg_dependencies; fp oc " Failures (total %d):\n" (Array.length dg.dg_failures); let print_package oc p_id = Functions.scribe_package_from_id db cd oc p_id in let rec print_package_list oc p_ids = match p_ids with | [] -> fp oc "" | [h] -> print_package oc h | h::t -> (print_package oc h; fp oc " and "; print_package_list oc t) in let show_range spec = begin match spec with | Unit_version (u_id, s) -> begin fp oc "%a" (Functions.scribe_unit_from_id db cd) u_id; match s with | Sel_ANY -> () | Sel_LT v -> fp oc " (< %a)" (Functions.scribe_version_from_number db cd) v | Sel_LEQ v -> fp oc " (<= %a)" (Functions.scribe_version_from_number db cd) v | Sel_EQ v -> fp oc " (= %a)" (Functions.scribe_version_from_number db cd) v | Sel_GEQ v -> fp oc " (>= %a)" (Functions.scribe_version_from_number db cd) v | Sel_GT v -> fp oc " (> %a)" (Functions.scribe_version_from_number db cd) v end | Glob_pattern g -> fp oc "%s" g end in Array.iter begin fun (p_ids, rl) -> fp oc " Packages %a cannot be installed together:\n" print_package_list p_ids; List.iter begin function | Not_available p_id' -> fp oc " %a is not available\n" print_package p_id' | Requested p_id' -> fp oc " %a has been requested\n" print_package p_id' | Conflict(p_id',p_id'') -> fp oc " %a and %a conflict\n" print_package p_id' print_package p_id'' | Empty_disjunction(p_id', rl) -> fp oc " %a depends on missing:\n" print_package p_id'; List.iter begin fun r -> fp oc " - "; show_range r; fp oc "\n" end rl | Dependency(p_id', dl) -> fp oc " %a depends on one of:\n" print_package p_id'; List.iter begin fun p_id'' -> fp oc " - %a\n" print_package p_id'' end dl end rl end dg.dg_failures ;; (* ***) (*** Directives *) module Directives = struct (*** d_dump *) let d_dump it = function | [String fn; v] -> Util.with_output_to_file fn begin fun oc -> let cd = conduit_of_channel oc in let it' = { it with cx = { it.cx with ctx_output_limit = max_int; ctx_interactive = false }; cd = cd } in reset_output_limit it'; display_value it' v; cd.cd_flush oc; close_out oc end | _ -> raise (Because ("#dump: Filename expected as first argument", Type_error)) ;; (* ***) (*** d_help *) let d_help it yl = if yl = [] then it.cd.cd_print it.cd.cd_out_channel "%s" Help.help_string else match (List.hd yl) with | String s -> begin if s = "functions" then it.cd.cd_print it.cd.cd_out_channel "%s" Help.help_functions_string else if s = "directives" then it.cd.cd_print it.cd.cd_out_channel "%s" Help.help_directives_string else it.cd.cd_print it.cd.cd_out_channel "%s" Help.help_string end | _ -> it.cd.cd_print it.cd.cd_out_channel "%s" Help.help_string ;; (* ***) (*** d_exit *) let d_exit _it _yl = raise Quit;; (* ***) (*** d_merge *) let d_merge it yl = match yl with | [] -> it.cd.cd_print it.cd.cd_out_channel "No waterways to merge.\n" | _ -> List.iter begin function | String ww -> it.cd.cd_print it.cd.cd_out_channel "Merging %S...\n%!" ww; let s = Waterway.specification_of_string ww in Waterway.merge it.db s | _ -> raise (Because ("#merge: Waterway expected", Type_error)) end yl ;; (* ***) (*** d_show *) let d_show it yl = List.iter begin function | Diagnosis dg -> display_diagnosis it dg | Diagnosis_list dg -> display_diagnosis_list it dg | v -> display_value it v end yl ;; (* ***) (*** d_type *) let d_type it _yl = let oc = it.cd.cd_out_channel in let fp = it.cd.cd_print in match (get_liquid it.db) with None -> fp oc "undetermined" | Some Debian -> fp oc "debian" | Some RPM -> fp oc "rpm" | Some Pkgsrc -> fp oc "ps" ;; (* ***) (*** d_abundance *) let d_abundance it yl = let oc = it.cd.cd_out_channel in let fp = it.cd.cd_print in List.iter begin function | Package_set p -> begin match Installability.abundance it.db p with | None -> fp oc "Abundance condition fulfilled.\n" | Some p_id -> begin fp oc "Abundance condition NOT fulfilled by package: "; Functions.scribe_package_from_id it.db it.cd oc p_id; fp oc "\n" end end | _ -> raise (Because ("#abundance: Package set expected", Type_error)) end yl ;; (* ***) (*** definitions *) let definitions = [ "exit", d_exit; "quit", d_exit; "merge", d_merge; "help", d_help; "dump", d_dump; "show", d_show; "type", d_type; "abundance", d_abundance; ];; (* ***) (*** resolve *) let resolve it d = try List.assoc d definitions with | Not_found -> raise (Unknown_directive d) ;; (* ***) end ;; (* ***) (*** assign *) let assign it env l y = match l with | Variable n -> it.env <- SM.add n y it.env | Index(x1,x2) -> let y1 = eval_expression it env x1 and y2 = eval_expression it env x2 in let i = int_of_value y2 in match y1 with | Array a -> if i < 0 or i > Array.length a then raise (Sorry(sf "Index %d out of bounds" i)) else a.(i) <- y | _ -> raise Type_error ;; (* ***) (*** execute_statement *) let execute_statement it = function | Nop -> () | Assignment(l, x) -> if it.cx.ctx_modify_environment then begin let y = eval_expression it it.env x in assign it it.env l y end else raise Access_denied | Directive(d,xl) -> let f = Directives.resolve it d in let yl = List.map (eval_expression it it.env) xl in f it yl ;; (* ***) (*** execute_query *) let execute_query it q = reset_limits it; match q with | Expression x -> display_value it (eval_expression it it.env x) | Statement s -> execute_statement it s ;; (* ***) pkglab-1.4.2/dql/interpreter.mli000066400000000000000000000100401121467321100165750ustar00rootroot00000000000000(* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) (** This module interpets queries in the DQL language, given a [Rapids] database. *) (** The exception [Parse_error(i,j,msg)] is raised when [parse_query] or [parse_expression] have been called with a string [u] having a syntax error described by [msg] and identified to be between positions [i] and [j] where [0 <= i <= j <= String.length u]. *) exception Parse_error of int * int * string exception Unbound_value of string exception Unknown_directive of string exception Sorry of string exception Type_error exception Because of string * exn exception Time_limit_exceeded exception Space_limit_exceeded exception Output_limit_exceeded exception Access_denied exception Not_implemented exception Quit (** The interpreter can run in a variety of environments: as an interactive command-line tool, in batch mode, as a backend for web server, in various scripts, and so on. Each such environment has its own specific requirements. For instance, in batch mode, the interpreter must not ask any interactive questions. In web mode, it should not print anything on stdout or stderr; it should not allow access or modification of local files. And so on. A [context] is a record aggregating information on how the queries interact with the environment. *) type context = { ctx_space_limit : int; (** Memory limit for evaluating expressions *) ctx_time_limit : int; (** Time limit for evaluating expressions *) ctx_output_limit : int; (** Output limit *) ctx_filesystem_access : bool; (** Access to local files allowed? *) ctx_modify_database : bool; (** Can the Rapids database be modified? *) ctx_modify_environment : bool; (** Can modify the toplevel environment *) ctx_interactive : bool; (** Can the interpreter do interactive prompts? *) ctx_default_architecture : string; (** Default architecture *) } (** Default context for command-line interactions *) val default_cli_context : ?architecture:string -> unit -> context (** Default context for unauthenticated web interactions *) val default_web_context : ?architecture:string -> unit -> context (** Default context for batch processing *) val default_batch_context : ?architecture:string -> unit -> context (** An interpreter. *) type 'a t (** The type of variable environments *) type env (** The default environment *) val env0 : env (** Given a [Rapids] database and a context, create an interpreter. *) val create_interpreter : Rapids.db -> context -> 'a Conduit.conduit -> 'a t (** Parse the given DQL expression. Thread-safe & reentrant. *) val parse_expression : string -> Query.expression (** Parse the given DQL query. Thread-safe & reentrant. *) val parse_query : string -> Query.query (** Parse the given DQL program. Thread-safe & reentrant. *) val parse_program : string -> Query.program (** Evaluate the given expression inside the interpreter. NOT reentrant. WON'T modify the database. *) val eval_expression : 'a t -> env -> Query.expression -> Query.value_ (** Evaluate the given statement inside the interpreter. NOT reentrant. MAY modify the database or access the filesystem depending on the context used to create the interpreter. *) val execute_statement : 'a t -> Query.statement -> unit (** Evaluate the given query. *) val execute_query : 'a t -> Query.query -> unit pkglab-1.4.2/dql/lexic.mli000066400000000000000000000002101121467321100153340ustar00rootroot00000000000000exception Parse_error of int * int * string val lexical_error : Lexing.lexbuf -> string -> 'a val token : Lexing.lexbuf -> Syntax.token pkglab-1.4.2/dql/lexic.mll000066400000000000000000000122771121467321100153570ustar00rootroot00000000000000(* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) { open Syntax exception Parse_error of int * int * string let lexical_error l s = raise (Parse_error(Lexing.lexeme_start l, Lexing.lexeme_end l,s)) let keywords = [ "archives", ARCHIVES; "and", AND; "begin", BEGIN; "check", CHECK; "check_together", CHECK_TOGETHER; "closure", CLOSURE; "conflict_list", CONFLICT_LIST; "conflicts", CONFLICTS; "contents", CONTENTS; "count", COUNT; "depends", DEPENDS; "dep_closure", DEP_CLOSURE; "dep_path", DEP_PATH; "difficulty", DIFFICULTY; "elements", ELEMENTS; "end", END; "encode", ENCODE; "exists", EXISTS; "false", FALSE; "filter", FILTER; "forall", FORALL; "from_source", FROM_SOURCE; "from_unit", FROM_UNIT; "strong_dep", STRONG_DEP; "in", IN; "install", INSTALL; "is_essential", IS_ESSENTIAL; "is_empty", IS_EMPTY; "is_build_essential", IS_BUILD_ESSENTIAL; "in", IN; "installed_size", INSTALLED_SIZE; "latest", LATEST; "let", LET; "map", MAP; "member", MEMBER; "not", NOT; "or", OR; "packages", PACKAGES; "pre_depends", PRE_DEPENDS; "pre_closure", PRE_CLOSURE; "load_packages", LOAD_PACKAGES; "provides", PROVIDES; "range", RANGE; "replaces", REPLACES; "requires", REQUIRES; "select", SELECT; "singleton", SINGLETON; "size", SIZE; "solve", SOLVE; "source", SOURCE; "sources", SOURCES; "success", SUCCESS; "temperature", TEMPERATURE; "treat", TREAT; "trim", TRIM; "true", TRUE; "unit", UNIT; "units", UNITS; "versions", VERSIONS; "what_provides", WHAT_PROVIDES; ];; let keywords_table = let h = Hashtbl.create 64 in List.iter (fun (kwd,tok) -> Hashtbl.add h kwd tok) keywords; h ;; } let blancs = [' ' '\n' '\t' '\r']+ let upperalpha = ['A'-'Z'] let alpha = ['a'-'z''A'-'Z'] let alphanum = alpha | ['0'-'9'] let decimaldigit = ['0'-'9'] let sign = '+'|'-' let space = [' ''\t''\r''\n'] rule token = parse (* Operators *) (* Various non-alphabetic symbols *) | "(" { LPAREN } | ")" { RPAREN } | "[." { LBRACKDOT } | ".]" { RDOTBRACK } | "[" { LBRACK } | "]" { RBRACK } | "{" { LBRACE } | "}" { RBRACE } | "<<" { LANGLE } | ">>" { RANGLE } | "," { COMMA } | "," { COMMA } (*| "+" { PLUS }*) (*| "*" { STAR }*) | "~" { TILDE } | ":" { COLON } | ";" { SEMICOLON } | "<-" { ASSIGN } | "->" { MAPTO } | "<>" { NEQ } | "!=" { NEQ } | "=" { EQ } | "<=" { LEQ } | ">=" { GEQ } | "<" { LT } | ">" { GT } | "," { COMMA } (*| "=~" { MATCHES } | "!~" { DOESNT_MATCH }*) | "&" { AND } | "|" { OR } | "!" { NOT } | "\\" { DIFF } | "@" { AT } | "#" ((alphanum|'_')+ as w) { DIRECTIVE w } | "'" ((alphanum | '.'|'+'|'-'|':'|'~'|'*'|'['|']'|'?')+ as w) { VERSION_NAME w } | "@" (alphanum+ as a) { ARCHITECTURE a } | "`" ((alphanum | '.'|'+'|'-'|':'|'~'|'*'|'['|']'|'?')+ as w) { SOURCE_VERSION_NAME w } | "\"" { STRING(readstr lexbuf) } | "/" { REGEXP(readregexp lexbuf) } | "$"((alphanum|'_')+ as w) { IDENT w } | decimaldigit+ as w { INT(int_of_string w) } | (['0'-'9'] ['0'-'9'] ['0'-'9'] ['0'-'9'] as y) '-' (['0'-'9'] ['0'-'9'] as m) '-' (['0'-'9'] ['0'-'9'] as d) { DATE(int_of_string y, int_of_string m, int_of_string d) } | '_'((alphanum|'_'|'-'|'.'|'+'|':'|'/')+ as w) { UNIT_NAME w } | ['a'-'z']['a'-'z' '_']*['a'-'z'] as w { try Hashtbl.find keywords_table w with | Not_found -> UNIT_NAME w } | (alphanum|'_'|'-'|'.'|'+'|':')+ as w { UNIT_NAME w } | "{"((alphanum|'_'|'-'|'.'|'+'|':'|'('|')'|'/')+ as w)"}" { UNIT_NAME w } | '%'((alphanum|'_'|'-'|'.'|'+'|':'|'/')+ as w) { ARCHIVE_NAME w } (* Comments, space, strings and end of file *) | "(*" { eat_comment lexbuf; token lexbuf } | space+ { token lexbuf } | eof { EOF } | _ as c { lexical_error lexbuf (Printf.sprintf "Unexpected %C" c) } and eat_comment = parse "(*" { eat_comment lexbuf; eat_comment lexbuf } | "*)" { } | [^'(' '*']+ { eat_comment lexbuf } | _ { eat_comment lexbuf } and readstr = parse "\"" { "" } | "\\\"" { "\""^(readstr lexbuf) } | [^'"' '\\']+ { let s = Lexing.lexeme lexbuf in s^(readstr lexbuf) } and readregexp = parse "/" { ("",readregexpoptions lexbuf) } | "\\/" { let (s,o) = readregexp lexbuf in ("/"^s,o) } | ([^'/' '\\']+ | '\\'[^'/'][^'/' '\\']*) as s { let (s',o) = readregexp lexbuf in (s^s',o) } and readregexpoptions = parse (['w' 'i']* as w) { let rec loop r i = if i = String.length w then r else loop ((match w.[i] with 'w' -> `Word_boundary | 'i' -> `Case_insensitive | _ -> assert false)::r) (i + 1) in loop [] 0 } and readident = parse alpha (alphanum|'_')* as id { id } { (* Epilogue. *) } pkglab-1.4.2/dql/query.ml000066400000000000000000000151171121467321100152400ustar00rootroot00000000000000(* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) (* TODO: Add Lifetime as a built-in datatype. *) open Rapids ;; module Formula = struct type 'a formula = | And of 'a formula list | Or of 'a formula list | Not of 'a formula | True | False | Atom of 'a ;; let rec map g = function | And fl -> And(List.map (map g) fl) | Or fl -> Or(List.map (map g) fl) | Not f -> Not(map g f) | True -> True | False -> False | Atom x -> Atom(g x) ;; end ;; open Formula;; module Date_set = Set.Make( struct type t = Lifetime.day let compare = compare end) ;; type date_set = Date_set.t;; type value_ = | Nothing | String of string | Int of int | Float of float | Date of Lifetime.day | Archive_id of archive_id | Unit_id of unit_id | Package_id of package_id | Source_id of source_id | Version of (version_number * release_number) | Date_set of date_set | Package_set of package_set | Unit_set of unit_set | Source_set of source_set | Archive_set of archive_set | Bool of bool | Formula of value_ formula | Array of value_ array | List of value_ list | Thunk of (value_ -> value_) | Regexp of Pcre.regexp | Record of (string * value_) list | Versioned of (unit_id, version_number * release_number, glob) Napkin.versioned | Diagnosis of (Package_set.elt, Package_set.elt, (unit_id, version_number * release_number, glob) Napkin.versioned) Diagnosis.diagnosis | Diagnosis_list of (Package_set.elt list, Package_set.elt, (unit_id, version_number * release_number, glob) Napkin.versioned) Diagnosis.diagnosis ;; type variable_name = string;; type comparison = | Eq | Le | Lt | Gt | Ge | Ne ;; type 'a resolution = string * 'a option ref;; type ternary = | Ternary_operator of (value_ -> value_ -> value_ -> value_) resolution | Find_package | Build_versioned | Strong_dep | Dep_path ;; type binary = | Binary_operator of (value_ -> value_ -> value_) resolution | Comparison of comparison | Union | Intersection | Diff | Find_source | Match | Filter | Forall | Exists | Member | Treat | Map | Check (** Returns a diagnosis for a set of packages [indivitually] *) | Check_together (** Returns a diagnostic for a set of packages [together] *) | Install (** Returns an installation for a given set of packages *) | Encode (** Returns an encoding for the installation for a given set of packages *) | Difficulty (** Returns an integer indicating the computational difficulty of finding an installation for a given set of packages *) | Contents (** Contents of an archive *) ;; type unary = | Unary_operator of (value_ -> value_) resolution | Complement | Select (** Select the packages matching a versioned *) | Find_unit (** Find a unit of a given name *) | Find_version (** Find a version *) | Find_archive (** Find an archive *) | Unit (** Set of units of a set of packages or of a set of sources *) | From_unit (** Set of packages of a set of units *) | Source (** Set of sources of a set of packages *) | Success | From_source (** Set of packages of a set of sources *) | Provides (** Returns the set of units this package provides *) | Versions (** Returns the set of packages implementing directly this unit *) | Conflicts (** Returns the set of packages this package conflicts with *) | Conflict_list (** Returns the list of conflicts *) | Replaces (** Returns the set of packages this package replaces *) | Latest (** Returns the latest version of a unit *) | Count (** Returns the cardinality of a set or the length of a list *) | Depends (** Returns the dependencies of a package *) | Pre_depends (** Returns the pre-dependencies of a package *) | Range (** Range of dates of an archive *) | Closure (** Returns the pre-dependency or dependency closure of a package *) | Dep_closure (** Returns the dependency closure of a package *) | Pre_closure (** Returns the pre-dependency closure of a package *) | What_provides (** Returns the set of packages that provide a given unit *) | Singleton (** Create a singleton set *) | Requires (** Set of packages *possibly* requiring a given set of packages *) | Is_empty (** Returns true iff. the set is empty *) | Is_essential (** Returns true iff. package is essential *) | Is_build_essential (** Returns true iff. package is build-essential *) | Load_packages (** Load set of packages from file *) | Temperature (** Temperature and statistics of a CNF formula *) | Size (** Size of a package *) | Installed_size (** Installed size of a package *) | Solve (** Solve a formula *) | Trim (** Returns the set of installable packages *) | Elements (** elements of a list *) ;; type nonary = | Nonary_operator of (unit -> value_) resolution | Packages (** Set of all packages *) | Units (** Set of all units *) | Sources (** Set of all sources *) | Archives (** Set of all archives *) ;; type expression = | Content of location | Nonary of nonary | Unary of unary * expression | Binary of binary * expression * expression | Ternary of ternary * expression * expression * expression | Constant of value_ | Apply of expression * expression | List_constructor of expression list | Set_constructor of expression list | Formula_constructor of expression formula | Lambda of variable_name * expression and location = | Variable of variable_name | Index of expression * expression ;; type statement = | Assignment of location * expression | Directive of string * expression list | Nop ;; type program = statement list;; type query = | Statement of statement | Expression of expression ;; pkglab-1.4.2/dql/reason.ml000066400000000000000000000022441121467321100153570ustar00rootroot00000000000000(* Copyright 2005-2007 Berke DURAK, INRIA Rocquencourt and the EDOS Project. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) class reason1 : reason = object(self) method print fmt = Format.fprintf fmt "shit" end ;; class reason2 : reason = object(self) method print fmt = Format.fprintf fmt "shit" end ;; exception Conflict of reason;; class solver () = object(self) val mutable stuff = [] method add r = stuff <- r :: stuff method get = stuff method shit = match stuff with | r1::_ -> raise (Conflict r1) | _ -> false end ;; pkglab-1.4.2/dql/syntax.mly000066400000000000000000000225351121467321100156140ustar00rootroot00000000000000(* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, the EDOS Project and Jaap Boender. This file is part of Dose2. Dose2 is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Dose2 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . *) %{ (* Prolog *) open Query open Formula let str s = Constant(String s);; %} %token EOF %token AND %token ARCHIVES %token ASSIGN %token AT %token BEGIN %token CHECK %token CHECK_TOGETHER %token CLOSURE %token COLON %token COMMA %token CONFLICT_LIST %token CONFLICTS %token CONTENTS %token COUNT %token DEP_CLOSURE %token DEP_PATH %token DEPENDS %token DIFF %token DIFFICULTY %token DOT %token ELEMENTS %token ENCODE %token END %token EQ %token EXISTS %token FALSE %token FILTER %token FORALL %token FROM_SOURCE %token FROM_UNIT %token GEQ %token GT %token IN %token INSTALL %token INSTALLED_SIZE %token IS_BUILD_ESSENTIAL %token IS_EMPTY %token IS_ESSENTIAL %token LANGLE %token LATEST %token LBRACE %token LBRACK %token LBRACKDOT %token LEQ %token LET %token LOAD_PACKAGES %token LPAREN %token LT %token MAP %token MAPTO %token MEMBER %token NEQ %token NOT %token OR %token PACKAGES %token PRE_CLOSURE %token PRE_DEPENDS %token PROVIDES %token RANGE %token RANGLE %token RBRACE %token RBRACK %token RDOTBRACK %token REPLACES %token REQUIRES %token RPAREN %token SELECT %token SEMICOLON %token SINGLETON %token SIZE %token SOLVE %token SOURCE %token SOURCES %token STRONG_DEP %token SUCCESS %token TEMPERATURE %token TILDE %token TREAT %token TRIM %token TRUE %token UNIT %token UNITS %token VERSIONS %token WHAT_PROVIDES %token INT %token DATE %token ARCHIVE_NAME %token VERSION_NAME %token SOURCE_VERSION_NAME %token ARCHITECTURE %token DIRECTIVE %token IDENT %token UNIT_NAME %token STRING %token REGEXP %type expression %type query %type program %start expression %start query %start program /* Priorities */ %nonassoc APPLY %nonassoc IDENT %nonassoc LBRACK %left DOT %left TILDE %nonassoc WHAT_PROVIDES %nonassoc VERSIONS %left SEMICOLON %left OR %left AND %left DIFF %nonassoc NOT %left NEQ %left LEQ %left GEQ %left EQ %left GT %left LT %nonassoc IN %right MAPTO %nonassoc LETPREC %% program : | statement EOF { [$1] } | statement SEMICOLON program { $1::$3 } statement : | location ASSIGN expression { Assignment($1,$3) } | DIRECTIVE { Directive($1,[]) } | DIRECTIVE simple_expression_list { Directive($1, List.rev $2) } | { Nop } query : | expression EOF { Expression($1) } | statement EOF { Statement($1) } (*prefix_ternary : | RANGE { Range }*) prefix_ternary : | STRONG_DEP { Strong_dep } | DEP_PATH { Dep_path } prefix_binary : | CHECK { Check } | CHECK_TOGETHER { Check_together } | CONTENTS { Contents } | DIFFICULTY { Difficulty } | ENCODE { Encode } | EXISTS { Exists } | FILTER { Filter } | FORALL { Forall } | INSTALL { Install } | MEMBER { Member } | TREAT { Treat } | MAP { Map } prefix_unary : | CLOSURE { Closure } | CONFLICT_LIST { Conflict_list } | CONFLICTS { Conflicts } | COUNT { Count } | DEP_CLOSURE { Dep_closure } | DEPENDS { Depends } | ELEMENTS { Elements } | FROM_SOURCE { From_source } | FROM_UNIT { From_unit } | INSTALLED_SIZE { Installed_size } | IS_BUILD_ESSENTIAL { Is_build_essential } | IS_EMPTY { Is_empty } | IS_ESSENTIAL { Is_essential } | LATEST { Latest } | LOAD_PACKAGES { Load_packages } | PRE_CLOSURE { Pre_closure } | PRE_DEPENDS { Pre_depends } | PROVIDES { Provides } | RANGE { Range } | REPLACES { Replaces } | REQUIRES { Requires } | SELECT { Select } | SINGLETON { Singleton } | SIZE { Size } | SOURCE { Source } | SUCCESS { Success } | TEMPERATURE { Temperature } | TRIM { Trim } | UNIT { Unit } | VERSIONS { Versions } | WHAT_PROVIDES { What_provides } nonary : | ARCHIVES { Archives } | PACKAGES { Packages } | SOURCES { Sources } | UNITS { Units } simple_expression_list : | simple_expression { [ $1 ] } | simple_expression_list simple_expression { $2::$1 } booleable_expression_list : | booleable_expression { [ $1 ] } | booleable_expression_list booleable_expression { $2::$1 } list_constructor : | expression SEMICOLON list_constructor { $1::$3 } | expression { [$1] } set_constructor : | expression COMMA set_constructor { $1::$3 } | expression { [$1] } location : | IDENT { Variable $1 } | simple_expression DOT LBRACK expression RBRACK { Index($1,$4) } formula : | simple_expression { Atom $1 } | formula AND formula { And[$1; $3] } | formula OR formula { Or[$1; $3] } | NOT formula { Not $2 } | TRUE { True } | FALSE { False } | LPAREN formula RPAREN { $2 } | LANGLE booleable_expression RANGLE { Atom $2 } booleable_expression : | NOT simple_expression { Unary(Complement, $2) } | LPAREN expression RPAREN { $2 } | simple_expression AND expression { Binary(Intersection, $1, $3) } | simple_expression OR expression { Binary(Union, $1, $3) } | simple_expression { $1 } simple_expression : | TRUE { Constant(Bool true) } | FALSE { Constant(Bool false) } | IDENT { Content(Variable $1) } | simple_expression DOT LBRACK expression RBRACK { Content(Index($1,$4)) } | simple_expression TILDE simple_expression { Binary(Match,$3,$1) } | nonary { Nonary $1 } | simple_expression LT expression { Binary(Comparison Lt,$1,$3) } | simple_expression LEQ expression { Binary(Comparison Le,$1,$3) } | simple_expression EQ expression { Binary(Comparison Eq,$1,$3) } | simple_expression GEQ expression { Binary(Comparison Ge,$1,$3) } | simple_expression GT expression { Binary(Comparison Gt,$1,$3) } | simple_expression NEQ expression { Binary(Comparison Ne,$1,$3) } | simple_expression DIFF expression { Binary(Diff,$1,$3) } | IDENT MAPTO expression { Lambda($1, $3) } | LBRACKDOT expression RDOTBRACK { Ternary(Build_versioned, $2, Constant Nothing, Constant Nothing) } | LBRACKDOT u = simple_expression LPAREN LT v = simple_expression RPAREN RDOTBRACK { Ternary(Build_versioned, u, str "<", v) } | LBRACKDOT u = simple_expression LPAREN LEQ v = simple_expression RPAREN RDOTBRACK { Ternary(Build_versioned, u, str "<=", v) } | LBRACKDOT u = simple_expression LPAREN EQ v = simple_expression RPAREN RDOTBRACK { Ternary(Build_versioned, u, str "=", v) } | LBRACKDOT u = simple_expression LPAREN GEQ v = simple_expression RPAREN RDOTBRACK { Ternary(Build_versioned, u, str ">=", v) } | LBRACKDOT u = simple_expression LPAREN GT v = simple_expression RPAREN RDOTBRACK { Ternary(Build_versioned, u, str ">", v) } | LBRACK list_constructor RBRACK { List_constructor $2 } | LBRACK RBRACK { List_constructor[] } | LBRACE set_constructor RBRACE { Set_constructor $2 } | LBRACE RBRACE { Set_constructor[] } | LANGLE formula RANGLE { Formula_constructor $2 } (* | BEGIN expression END { $2 } *) | LPAREN expression RPAREN { $2 } | INT { Constant(Int $1) };; | STRING { str $1 } | DATE { Constant(Date(Lifetime.day_of_ymd $1)) } | ARCHIVE_NAME { Unary(Find_archive, str $1) } | UNIT_NAME { Unary(Find_unit, str $1) } | UNIT_NAME VERSION_NAME ARCHITECTURE { Ternary(Find_package, str $1, str $2, str $3) } | UNIT_NAME VERSION_NAME { Ternary(Find_package, str $1, str $2, Constant Nothing) } | UNIT_NAME SOURCE_VERSION_NAME { Binary(Find_source, str $1, str $2) } | VERSION_NAME { Unary(Find_version, str $1) } | prefix_unary LPAREN expression RPAREN { Unary($1, $3) } | REGEXP { Constant(Regexp begin let (r,o) = $1 in let r = if List.mem `Word_boundary o then "\\b"^r^"\\b" else r in let flags = if List.mem `Case_insensitive o then [`CASELESS] else [] in Pcre.regexp ~study:true ~flags r end) } expression : | LET IDENT EQ expression IN expression %prec LETPREC { Apply(Lambda($2,$6),$4) } | booleable_expression { $1 } | booleable_expression booleable_expression_list %prec APPLY {let l = List.rev $2 in List.fold_left (fun res f -> Apply(res,f)) $1 l } | prefix_ternary LPAREN expression COMMA expression COMMA expression RPAREN { Ternary($1,$3,$5,$7) } | prefix_binary LPAREN expression COMMA expression RPAREN { Binary($1,$3,$5) } pkglab-1.4.2/examples/000077500000000000000000000000001121467321100145725ustar00rootroot00000000000000pkglab-1.4.2/examples/README000066400000000000000000000004361121467321100154550ustar00rootroot00000000000000- demo2: the famous 'package recompilation' example. Basically, it checks whether a new way of generating dependencies does not result in loss of installability - demo3: find the packages that have both Provides: X and Conflicts: X (which results in a special Debian syntax case) pkglab-1.4.2/examples/demo2.pkglab000066400000000000000000000055241121467321100167700ustar00rootroot00000000000000#merge "dose:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/recompiled_dose #merge "dose:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/recompiled_dose" #merge "dose:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/stable_dose" #merge "dose:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/unstable_dose" #help %archives archives $recompiled <- contents(%recompiled, 2007-06-19) $rec_all <- $recompiled ~ /@all$/ $rec_all $recompiled $unstable <- contents(%debian/unstable/main/i386, 2007-06-19) $unstable_all <- $unstable ~ /@all$/ $new_all_pkgs <- $unstable_all \ $rec_all $recompiled <- $recompiled | $new_all_pkgs $stable <- contents(%debian/stable/main/i386, 2007-06-19) $common_units <- (begin map($recompiled, $x->unit($x)) end & map($unstable, $x->unit($x))) $rec2 <- filter ($recompiled, $x->member(unit($x), $common_units)) $co_recompiled <- $p->filter($recompiled,$x->source($x)=source($p)) $co_unstable <- $p->filter($unstable,$x->source($x)=source($p)) $stable_rest <- $x->filter($stable,$y->not begin member(unit($y),map($x,$z->unit($z))) end) $filt1 <- $z->let $co=$co_recompiled($z) in let $er=$stable_rest($co) in success(check({$z},$co|$er)) $filt2 <- $z->let $co=$co_unstable($z) in let $er=$stable_rest($co) in not begin success(check(filter($unstable,$q->unit($q)=unit($z)),$co|$er)) end $result <- filter($rec2 ~/^a/ ,$x->(begin $filt1($x) end & $filt2($x))) #merge "doserpm:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/hdlist_dose" $disk0 <- load_packages ("demo.disk0") $disk1 <- load_packages ("demo.disk1") $disk2 <- load_packages ("demo.disk2") #abundance $disk0 #help #help "directives" #help "functions" #quit #exit #merge "doserpm:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/hdlist_dose" $disk0 <- load_packages ("demo.disk0") $disk1 <- load_packages ("demo.disk1") $disk2 <- load_packages ("demo.disk2") #abundance $disk0 #quit #merge "doserpm:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/hdlist_dose" $disk0 <- load_packages ("demo.disk0") $disk1 <- load_packages ("demo.disk1") $disk2 <- load_packages ("demo.disk2") #abundance $disk0 #quit #merge "doserpm:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/hdlist_dose" $disk0 <- load_packages ("demo.disk0") $disk1 <- load_packages ("demo.disk1") $disk2 <- load_packages ("demo.disk2") #abundance $disk0 #abundance $disk0|$disk1 #abundance ($disk0|$disk1) #abundance ($disk0 | $disk1) $d01 <- $disk0|$disk1 $d012 <- $disk0|$disk1|$disk2 #abundance $d01 #abundance $d012 #abundance $disk1 #abundance $disk2 #quit #merge "doserpm:/home/dicosmo/Projects/MDK/REVIEW/2007-09-12/DEMO/hdlist_dose" #help archives %hdlist units versions sources packages #help functions #help #help "functions" $oc <- packages ~ /^oca/ $oc closure($oc) check({ocaml'3.09.2-4mdv2007.0@i586},$oc) $diag <- check({ocaml'3.09.2-4mdv2007.0@i586},$oc) success($diag) #help #help "functions" #help "directives" #help #quit pkglab-1.4.2/examples/demo3.pkglab000066400000000000000000000002161121467321100167620ustar00rootroot00000000000000$f<-$x->let $c = conflicts({$x}) in filter($c,$y->member($x,what_provides(unit($y)))) $d<-filter(packages,$z->not is_empty($f($z))) count($d) pkglab-1.4.2/pkgdiff/000077500000000000000000000000001121467321100143665ustar00rootroot00000000000000pkglab-1.4.2/pkgdiff/Makefile000066400000000000000000000007271121467321100160340ustar00rootroot00000000000000SRCS= pkgdiff.ml OBJS= $(SRCS:.ml=.cmo) XBJS= $(SRCS:.ml=.cmx) PACKAGES= dose2.rapids OCAMLC= ocamlfind ocamlc -package $(PACKAGES) OCAMLOPT= ocamlfind ocamlopt -package $(PACKAGES) all: pkgdiff pkgdiff.opt pkgdiff: $(OBJS) $(OCAMLC) -linkpkg -o $@ $^ pkgdiff.opt: $(XBJS) $(OCAMLOPT) -linkpkg -o $@ $^ install: pkgdiff pkgdiff.opt ln -s pkgdiff debcheck ln -s pkgdiff.opt debcheck.opt %.cmo: %.ml $(OCAMLC) -o $@ -c $^ %.cmx: %.ml $(OCAMLOPT) -o $@ -c $^ pkglab-1.4.2/pkgdiff/pkgdiff.ml000066400000000000000000000136751121467321100163460ustar00rootroot00000000000000open Napkin open Rapids open Waterway let db = create_database ();; let archive_index = get_archive_index db;; let unit_index = get_unit_index db;; let package_name ?(version_only=false) pkg = let unit_name = Unit_index.find unit_index pkg.pk_unit in let (v, r) = pkg.pk_version in let version_name = Version_index.get_version v in let release_name = Release_index.get_version r in Printf.sprintf "%s%s%s" (if version_only then "" else unit_name ^ "-") version_name (match release_name with | None -> "" | Some r -> "-" ^ r);; let _ = begin let spec = Sys.argv.(1) and archive = Sys.argv.(2) and (y1, m1, d1) = Scanf.sscanf Sys.argv.(3) "%d-%d-%d" (fun y m d -> (y, m, d)) and (y2, m2, d2) = Scanf.sscanf Sys.argv.(4) "%d-%d-%d" (fun y m d -> (y, m, d)) in merge db (specification_of_string spec); let a_id = Archive_index.search archive_index archive in let a_data = Archive_index.data archive_index a_id in prerr_endline "archive found."; let ps1 = get_archive_contents a_data (Lifetime.day_of_ymd (y1, m1, d1)) in prerr_endline "ps1 found."; let ps2 = get_archive_contents a_data (Lifetime.day_of_ymd (y2, m2, d2)) in prerr_endline "ps2 found."; let d12 = Package_set.diff ps2 ps1 in let d21 = Package_set.diff ps1 ps2 in Printf.printf "+ %d packages\n- %d packages\n" (Package_set.cardinal d12) (Package_set.cardinal d21); let u12 = ref Unit_set.empty in let u21 = ref Unit_set.empty in Package_set.iter (fun p_id -> u12 := Unit_set.add (Functions.get_package_from_id db p_id).pk_unit !u12 ) d12; Package_set.iter (fun p_id -> u21 := Unit_set.add (Functions.get_package_from_id db p_id).pk_unit !u21 ) d21; let depsum = ref 0 and predepsum = ref 0 and recmsum = ref 0 and sugsum = ref 0 and enhsum = ref 0 and replsum = ref 0 and cflsum = ref 0 and provsum = ref 0 in Unit_set.iter (fun u_id -> let ps = Functions.unit_id_to_package_set db u_id in let p1 = List.hd (List.map (Functions.get_package_from_id db) (Package_set.elements (Package_set.inter ps ps1))) in let p2 = List.hd (List.map (Functions.get_package_from_id db) (Package_set.elements (Package_set.inter ps ps2))) in let dep = List.length (List.flatten p2.pk_depends) - List.length (List.flatten p1.pk_depends) and predep = List.length (List.flatten p2.pk_pre_depends) - List.length (List.flatten p1.pk_pre_depends) and recm = List.length (List.flatten p2.pk_recommends) - List.length (List.flatten p2.pk_recommends) and sug = List.length (List.flatten p2.pk_suggests) - List.length (List.flatten p2.pk_suggests) and enh = List.length (List.flatten p2.pk_enhances) - List.length (List.flatten p2.pk_enhances) and repl = List.length p2.pk_replaces - List.length p2.pk_replaces and cfl = List.length p2.pk_conflicts - List.length p2.pk_conflicts and prov = List.length p2.pk_provides - List.length p2.pk_provides in depsum := !depsum + dep; predepsum := !predepsum + predep; recmsum := !recmsum + recm; sugsum := !sugsum + sug; enhsum := !enhsum + enh; replsum := !replsum + repl; cflsum := !cflsum + cfl; provsum := !provsum + prov; Printf.printf "%s: %s > %s\nD %+4d PD %+4d RC %+4d S %+4d E %+4d RP %+4d C %+4d PV %+4d [%+6d]\n" (Unit_index.find unit_index u_id) (package_name ~version_only:true p1) (package_name ~version_only:true p2) dep predep recm sug enh repl cfl prov (dep+predep+recm+sug+enh+repl+cfl+prov) ) (Unit_set.inter !u12 !u21); Unit_set.iter (fun u_id -> let ps = Functions.unit_id_to_package_set db u_id in let p = List.hd (List.map (Functions.get_package_from_id db) (Package_set.elements (Package_set.inter ps ps2))) in let dep = List.length (List.flatten p.pk_depends) and predep = List.length (List.flatten p.pk_pre_depends) and recm = List.length (List.flatten p.pk_recommends) and sug = List.length (List.flatten p.pk_suggests) and enh = List.length (List.flatten p.pk_enhances) and repl = List.length p.pk_replaces and cfl = List.length p.pk_conflicts and prov = List.length p.pk_provides in depsum := !depsum + dep; predepsum := !predepsum + predep; recmsum := !recmsum + recm; sugsum := !sugsum + sug; enhsum := !enhsum + enh; replsum := !replsum + repl; cflsum := !cflsum + cfl; provsum := !provsum + prov; Printf.printf "new package: %s\nD %+4d PD %+4d RC %+4d S %+4d E %+4d RP %+4d C %+4d PV %+4d [%+6d]\n" (package_name p) dep predep recm sug enh repl cfl prov (dep+predep+recm+sug+enh+repl+cfl+prov) ) (Unit_set.diff !u12 !u21); Unit_set.iter (fun u_id -> let ps = Functions.unit_id_to_package_set db u_id in let p = List.hd (List.map (Functions.get_package_from_id db) (Package_set.elements (Package_set.inter ps ps1))) in let dep = -(List.length (List.flatten p.pk_depends)) and predep = -(List.length (List.flatten p.pk_pre_depends)) and recm = -(List.length (List.flatten p.pk_recommends)) and sug = -(List.length (List.flatten p.pk_suggests)) and enh = -(List.length (List.flatten p.pk_enhances)) and repl = -(List.length p.pk_replaces) and cfl = -(List.length p.pk_conflicts) and prov = -(List.length p.pk_provides) in depsum := !depsum + dep; predepsum := !predepsum + predep; recmsum := !recmsum + recm; sugsum := !sugsum + sug; enhsum := !enhsum + enh; replsum := !replsum + repl; cflsum := !cflsum + cfl; provsum := !provsum + prov; Printf.printf "removed package: %s\nD %+4d PD %+4d RC %+4d S %+4d E %+4d RP %+4d C %+4d PV %+4d [%+6d]\n" (package_name p) dep predep recm sug enh repl cfl prov (dep+predep+recm+sug+enh+repl+cfl+prov) ) (Unit_set.diff !u21 !u12); Printf.printf "D %+4d PD %+4d RC %+4d S %+4d E %+4d RP %+4d C %+4d PV %+4d [%+6d]\n" !depsum !predepsum !recmsum !sugsum !enhsum !replsum !cflsum !provsum (!depsum + !predepsum + !recmsum + !sugsum + !enhsum + !replsum + !cflsum + !provsum) end;; pkglab-1.4.2/pkglab.1000066400000000000000000000022441121467321100143000ustar00rootroot00000000000000.TH pkglab 1 "April 20, 2009" "Version 1.4.2" "USER COMMANDS" .SH NAME pkglab \- explore package repositories .SH SYNOPSIS .B pkglab [OPTION]... .SH DESCRIPTION Pkglab is an interactive, console-based environment to explore package repositories of package-based software distributions. A pkglab session typically starts by loading a package repository in the dose format produced by the ceve parser. Then, pkglab can check given package combinations for co-installability according to inter-package relationships. .SH OPTIONS .TP .BI "\-architecture " architecture Default architecture to use when accessing packages from a package repository. By default the current host architecture is used. .TP .BI "\-history " filename Use the file .I filename to load and save command-line history. Defaults to .IR $HOME/.pkglab-history . .TP .BI "\-script " filename Execute commands from the file .IR filename . .TP .BI "\-merge " directory Start by merging the dose archive found in .IR directory . .TP .BR \-help ", " \-\-help Display basic help information. .SH SEE ALSO .BR ceve (1). .SH AUTHORS Pkglab was written by Berke Durak and Jaap Boender for the EDOS and Mancoosi projects. pkglab-1.4.2/pkglab.ml000066400000000000000000000066751121467321100145640ustar00rootroot00000000000000(* Pkglab *) (* Copyright 2005-2009 Berke DURAK, INRIA Rocquencourt, the EDOS Project and * Jaap Boender. *) (* Released under the GNU GPL version 3 *) open Conduit open Rapids open Interpreter let sf = Printf.sprintf;; let db = create_database ();; (*** Opt *) module Opt = struct let architecture = ref "i386" (* let workspace = ref ".pkglab-workspace" *) let history = ref (Filename.concat (Sys.getenv "HOME") ".pkglab-history") let script_file = ref None let merge_file = ref None end ;; (* ***) (*** Specs *) module Specs = struct open Opt let string key var desc = (key, Arg.String((:=) var), sf "%s (%S)" desc !var);; let int key var desc = (key, Arg.Int((:=) var), sf "%s (%d)" desc !var);; let string_option key var desc = (key, Arg.String(fun x -> var := Some x), sf "%s" desc);; let int_option key var desc = (key, Arg.Int(fun x -> var := Some x), sf "%s" desc);; let specs = Arg.align [ string "-architecture" architecture " Default architecture"; (* string "-workspace" workspace " Use given file to load and save workspace"; *) string "-history" history " Use given file to load and save command-line history"; string_option "-script" script_file " Execute commands from given file"; string_option "-merge" merge_file " Start with merging the given archive"; ] ;; end ;; (* ***) (*** what *) let what x = Printf.printf "Unwanted argument %S\n" x; exit 1 ;; (* ***) let banner = "pkglab version 1.4.2 by the MANCOOSI Project\n";; (*** execute_script *) let execute_script (filename: string) = let cd = stdoutcd in let cx = default_batch_context () in let it = create_interpreter db cx cd in begin try let f = open_in filename in while true do try let l = input_line f in let q = parse_query l in execute_query it q with | End_of_file -> Printf.printf "\n"; raise Quit | Interpreter.Quit -> raise Quit | x -> Printf.printf "Exception: %s\n%!" (Printexc.to_string x) done with | Sys_error x -> Printf.printf "Error: %s \n%!" x | Quit -> exit 0 end;; (* ***) let read_line = let b = Buffer.create 128 in fun () -> Buffer.clear b; let rec loop () = let c = Ledit.input_char stdin in if c = "\n" then Buffer.contents b else begin Buffer.add_string b c; loop () end in loop () (*** interactive *) let interactive () = Sys.catch_break true; let cx = default_cli_context () in let cd = stdoutcd in let it = create_interpreter db cx cd in (* Ledit.init (); *) Ledit.open_histfile false !Opt.history; print_string banner; flush stdout; Ledit.set_prompt "> "; try while true do try let l = read_line () in let q = parse_query l in execute_query it q; flush stdout with | End_of_file -> Printf.printf "\n"; raise Quit | Interpreter.Quit -> raise Quit | x -> Printf.printf "Exception: %s\n%!" (Printexc.to_string x) done with | Quit -> Ledit.close_histfile (); Printf.printf "Bye.\n%!"; exit 0 ;; (* ***) let _ = Arg.parse Specs.specs what ((Filename.basename Sys.argv.(0)) ^ " [options]"); (*if !Opt.queries <> [] then Actions.batch ()*) (match !Opt.merge_file with None -> () | Some x -> Waterway.merge db (Waterway.specification_of_string x)); match !Opt.script_file with None -> interactive () | Some x -> execute_script x ;;