pax_global_header00006660000000000000000000000064112313777710014523gustar00rootroot0000000000000052 comment=ca4223447769114cb94516ecf24dd449fdacb1f6 ceve-1.4/000077500000000000000000000000001123137777100123115ustar00rootroot00000000000000ceve-1.4/.depend000066400000000000000000000027731123137777100135620ustar00rootroot00000000000000tools.cmo: tools.cmi tools.cmx: tools.cmi options.cmo: tools.cmi options.cmi options.cmx: tools.cmx options.cmi egraph_reader.cmo: egraph_reader.cmi egraph_reader.cmx: egraph_reader.cmi pretty_print.cmo: options.cmi pretty_print.cmi pretty_print.cmx: options.cmx pretty_print.cmi egraph_writer.cmo: egraph_writer.cmi egraph_writer.cmx: egraph_writer.cmi dose_writer.cmo: tools.cmi options.cmi dose_writer.cmi dose_writer.cmx: tools.cmx options.cmx dose_writer.cmi dependencies.cmo: tools.cmi options.cmi dependencies.cmi dependencies.cmx: tools.cmx options.cmx dependencies.cmi cnf_writer.cmo: tools.cmi options.cmi dependencies.cmi cnf_writer.cmi cnf_writer.cmx: tools.cmx options.cmx dependencies.cmx cnf_writer.cmi oz_writer.cmo: tools.cmi options.cmi dependencies.cmi oz_writer.cmi oz_writer.cmx: tools.cmx options.cmx dependencies.cmx oz_writer.cmi graphviz_writer.cmo: options.cmi dependencies.cmi graphviz_writer.cmi graphviz_writer.cmx: options.cmx dependencies.cmx graphviz_writer.cmi ceve.cmo: pretty_print.cmi oz_writer.cmi options.cmi graphviz_writer.cmi \ egraph_writer.cmi egraph_reader.cmi dose_writer.cmi dependencies.cmi \ cnf_writer.cmi ceve.cmx: pretty_print.cmx oz_writer.cmx options.cmx graphviz_writer.cmx \ egraph_writer.cmx egraph_reader.cmx dose_writer.cmx dependencies.cmx \ cnf_writer.cmx tools.cmi: options.cmi: egraph_reader.cmi: pretty_print.cmi: egraph_writer.cmi: dose_writer.cmi: dependencies.cmi: cnf_writer.cmi: graphviz_writer.cmi: oz_writer.cmi: ceve-1.4/COPYING000066400000000000000000000354061123137777100133540ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) 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 this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. 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. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the 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 a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE 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. ceve-1.4/INSTALL000066400000000000000000000005271123137777100133460ustar00rootroot00000000000000- A (possibly incomplete) list of debian packages needed for compilation: libzip-ocaml-dev librpm-dev libgdbm-dev libexpat-ocaml-dev Do not forget to look at Makefile.config, and change the settings if necessary! If you do not have ocamlduce available you have to change the setting in Makefile.config. [Ralf/Jaap, last update 2009/01/25] ceve-1.4/Makefile000066400000000000000000000045721123137777100137610ustar00rootroot00000000000000include Makefile.config ifdef USE_OCAMLDUCE OCAMLFIND = ocamlducefind OCAML_SOURCES = tools.ml options.ml egraph.ml \ egraph_reader.ml pretty_print.ml \ egraph_writer.ml dose_writer.ml dependencies.ml \ cnf_writer.ml oz_writer.ml graphviz_writer.ml ceve.ml else OCAMLFIND = ocamlfind OCAML_SOURCES = tools.ml options.ml \ egraph_reader.ml pretty_print.ml \ egraph_writer.ml dose_writer.ml dependencies.ml \ cnf_writer.ml oz_writer.ml graphviz_writer.ml ceve.ml endif OCAML_MLIS = tools.mli options.mli \ egraph_reader.mli pretty_print.mli \ egraph_writer.mli dose_writer.mli dependencies.mli \ cnf_writer.mli graphviz_writer.mli oz_writer.mli OBJS = $(OCAML_SOURCES:.ml=.cmo) XBJS = $(OCAML_SOURCES:.ml=.cmx) CMIS = $(OCAML_MLIS:.mli=.cmi) PACKAGES = -package dose2.lifetime,dose2.ocamlpkgsrc,dose2.ocamlrpm,dose2.ocamldeb,dose2.dosebase,str,$(CAMLZIP_NAME) #ifdef USE_OCAMLDUCE #PACKAGES+= ,ocamlduce,expat #DUCEDIR=$(shell ocamlfind query ocamlduce) #endif ceve: $(OBJS) $(OCAMLFIND) ocamlc -I $(DUCEDIR) -thread -custom -o $@ -linkpkg $(PACKAGES) $(C_LIBRARIES) $(CCOPTFLAGS) $(OBJS) ceve.opt: $(XBJS) # bug in ocamlducefind ifdef USE_OCAMLDUCE ocamlfind ocamlopt -thread -o $@ -linkpkg $(PACKAGES),ocamlduce $(C_LIBRARIES) $(CCOPTFLAGS) $(XBJS) else $(OCAMLFIND) ocamlopt -thread -o $@ -linkpkg $(PACKAGES) $(C_LIBRARIES) $(CCOPTFLAGS) $(XBJS) endif ifdef USE_OCAMLDUCE egraph_writer.cmo egraph_writer.cmi: ceveduce/egraph_writer.ml egraph_writer.mli $(OCAMLFIND) ocamlc -I $(DUCEDIR) $(PACKAGES) -o $@ -c $< egraph_reader.cmo egraph_reader.cmi: ceveduce/egraph_reader.ml egraph_reader.mli $(OCAMLFIND) ocamlc -I $(DUCEDIR) $(PACKAGES) -o $@ -c $< egraph_writer.cmx: ceveduce/egraph_writer.ml $(OCAMLFIND) ocamlopt -I $(DUCEDIR) $(PACKAGES) -o $@ -c $< egraph_reader.cmx: ceveduce/egraph_reader.ml $(OCAMLFIND) ocamlopt -I $(DUCEDIR) $(PACKAGES) -o $@ -c $< endif %.cmo: %.ml $(OCAMLFIND) ocamlc $(PACKAGES) -c $< %.cmx: %.ml $(OCAMLFIND) ocamlopt $(PACKAGES) -c $< %.cmi: %.mli $(OCAMLFIND) ocamlopt $(PACKAGES) -c $< doc: $(CMIS) @rm -rf doc @mkdir doc $(OCAMLFIND) ocamldoc -html -d doc $(SOURCES) .PHONY: clean install clean: @rm -rf ceve ceve.opt doc $(OBJS) $(XBJS) $(CMIS) $(OCAML_SOURCES:.ml=.o) install: ceve { test ! -f ceve.opt || install ceve.opt $(BINDIR); }; \ install ceve $(BINDIR) depend: $(OCAMLFIND) ocamldep $(OCAML_SOURCES) $(OCAML_MLIS) > .depend include .depend ceve-1.4/Makefile.config000066400000000000000000000006271123137777100152220ustar00rootroot00000000000000# if USE_OCAMLDUCE is set to any value, use ocamlduce. Comment the following # line to disable ocamlduce. # USE_OCAMLDUCE=yes # name of zip package # for FreeBSD CAMLZIP_NAME= zip # for GODI # CAMLZIP_NAME= camlzip # Directory to install stuff in BINDIR= $(HOME)/bin # CFLAGS # Linux: # CFLAGS+= -I/usr/include/rpm # FreeBSD: CFLAGS+= -I/usr/local/include -I/usr/local/include/rpm -I/usr/local/lib/ocaml ceve-1.4/README000066400000000000000000000015141123137777100131720ustar00rootroot00000000000000Ceve - parse package dependencies as set of constraints ------------------------------------------------------- Ceve is a command line utility used to parse package metadata information (in particular package interrelationships such as dependencies) and convert them to set of constraints that need to be satisfied by a proper package installation. Supported input formats for package metadata are: - .deb packages - Debian package lists (i.e. as in Packages.gz) - .rpm packages - RPM package lists - EGraph (XML based format, derived from GraphML) Supported output formats for set of constraints are: - pretty printed format for human consumption - EGraph - Dose base, suitable as input for the Pkglab tool - Oz (a programming language supporting constraint programming) - Graphviz - Tart, suitable as input for the Tart media partitioner ceve-1.4/ceve.1000066400000000000000000000076601123137777100133260ustar00rootroot00000000000000.TH ceve 1 "October 28, 2008" "Version 1.2" "USER COMMANDS" .SH NAME ceve \- parse package metadata .SH SYNOPSIS .B ceve [\-output-type .IR output-type ] [\-output-file .IR output-file ] [\-input-type .IR input-type ] [\-extract-cone .IR package=version ] [\-cone-dep-types .IR code-dependency-types ] [\-stop-extraction .IR package=version ] [\-dose-date .IR yyyy-mm-dd ] [\-dose-archive .IR archive-name ] [\-resolve-dependencies] [\-rpm-versions] [\-debian-versions] [\-verbose] [\-help] .I files [\-ignore-file-deps .IR file ] .SH DESCRIPTION Ceve is a generalized metadata parser. It reads package specifications, extracts package metadata from them, performs some manipulations, and outputs the package metadata in one of several formats. .SH OPTIONS .TP .BI "\-cone-dep-types " list A comma-separated list of dependency types to use for dependency closure generation. By default, all dependency types are used. Possible values are: .RS .IP \(bu 4 conflicts .IP \(bu 4 depends .IP \(bu 4 enhances .IP \(bu 4 predepends .IP \(bu 4 recommends .IP \(bu 4 replaces .IP \(bu 4 suggests .RE .TP .B \-debian-versions Force usage of the Debian version numbering scheme, as well as the Debian syntax for virtual packages (dependencies with a version specification cannot be satisfied by a virtual package). .TP .BI "\-dose-architecture " architecture Use .I architecture as the default Dose architecture. .TP .BI "\-dose-archive " archive Use .I archive as the default Dose archive name. .TP .BI "\-dose-date " date Set .I date as the lifetime for the packages to add to a Dose database. .TP .BI "\-extract-cone " package Only output the package .I package and its dependency closure. The package specification can be either a package name, or a package name and version in the form .IR name = version . This option can be abbreviated as .BR \-x . .TP .B \-help Not particularly useful, given that you're already reading this manpage. .TP .BI "\-input-type " input-type The input type. Possible values are: .RS .IP \(bu 4 .B debian One Debian package (.deb) .IP \(bu 4 .B debian-pool A Debian pool or cache file .IP \(bu 4 .B rpm One RPM package .IP \(bu 4 .B hdlist An uncompressed RPM hdlist file .IP \(bu 4 .B pkgsrc A pkgsrc pkg_summary file .IP \(bu 4 .B egraph A n EGraph file (GraphML-based) .IP \(bu 4 .B synthesis-hdlist An RPM synthesis hdlist (uncompressed) .RE This option can be abbreviated as .BR \-p . .TP .BI "\-output-dir " directory Set the directory to output to. This is only useful when using the .B dose output type. .TP .BI "\-output-file " file Set the file to output to. This option can be abbreviated as .BR \-o . .TP .BI "\-output-type " output-type Set the type of output to produce. Possible values are: .RS .IP \(bu 4 .B prettyprint Pretty printer. .IP \(bu 4 .B egraph EGraph format (GraphML-based) .IP \(bu 4 .B dose Dose database format (use the \-output-dir option to specify which directory to write to) .IP \(bu 4 .B oz Oz data structure .IP \(bu 4 .B graphviz GraphVIZ graph .IP \(bu 4 .BR tart " or " cnf CNF formula, readable by Tart .RE This option can be abbreviated as .BR \-t . .TP .B \-resolve-dependencies If specified, resolve dependencies so that a dependency on a virtual package is replaced by the disjunction of all packages that provide the virtual package. .TP .B \-rpm-versions Force usage of the RPM version numbering scheme, as well as the RPM semantics for virtual packages (all provides have versions). This is default when using the .B rpm or .B hdlist input types. .TP .BI "\-stop-extraction " package When computing the dependency closure, stop at package .I package (i.e. do not take its dependencies into account). Specification is the same as for the .B \-extract-cone option. .TP .B \-verbose Be verbose (mostly useful for debugging). .TP .BI "\-ignore-file-deps " file .I file should countain a list of file dependencies that are assumed to be available, and thus will not generate a warning during dependency resolution if not provided by any package. ceve-1.4/ceve.ml000066400000000000000000000062301123137777100135660ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Main module @author Jaap Boender *) open Napkin open Options (** Read the input (whatever type it is) into a list of package metadata @param files The list of files to be read @return a list of package metadata *) let read_input (files: string list): default_package list = begin match !input_type with | Debian -> List.map (fun f -> Napkin.to_default_package (Ocamldeb.read_deb_file f)) files | DebianCache -> List.flatten (List.map (fun f -> Ocamldeb.read_pool_file f Progress.dummy) files) | RPM -> List.map Napkin.to_default_package (Ocamlrpm.add_file_provides Progress.dummy (List.map (fun f -> Ocamlrpm.read_package "" f) files)) | HDList -> List.map Napkin.to_default_package (Ocamlrpm.add_file_provides Progress.dummy (List.flatten (List.map (Ocamlrpm.read_hdlist "") files))) | SynHDList -> List.map Napkin.to_default_package (List.flatten (List.map (Ocamlrpm.read_synthesis_hdlist) files)) | Pkgsrc -> List.flatten (List.map Ocamlpkgsrc.read_summary_file files) | EGraphIn -> List.flatten (List.map Egraph_reader.read_egraph_file files) end;; (** Output the metadata in the right format @param metadata The metadata *) let do_output (metadata: default_package list): unit = begin match !output_type with | PrettyPrint -> Pretty_print.pretty_print metadata | EGraphOut -> Egraph_writer.output_egraph metadata (* | RPMFind -> Rpmfind_writer.output_rpmfind metadata *) | Dose -> Dose_writer.output_dose metadata | Oz -> Oz_writer.output_oz metadata | Graphviz -> Graphviz_writer.output_graphviz metadata | TartCNF -> Cnf_writer.output_tart_cnf metadata | TartSize -> Pretty_print.print_sizes metadata | DimacsCNF -> Cnf_writer.output_dimacs_cnf metadata end;; (** main function *) let _ = let pkgs = ref [] in begin if !verbose then prerr_endline "[Main] Starting ceve."; parse_options; if !verbose then prerr_endline "[Main] Options parsed."; pkgs := read_input (!input_files); if !verbose then prerr_endline "[Main] Input read."; (* if !version_type = RPMVersions then pkgs := Ocamlrpm.add_file_provides !pkgs; *) if !version_type = DebianVersions then ignore (Ocamldeb.detect_pre_dependency_cycle !pkgs); if !resolve_dependencies then pkgs := Dependencies.resolve_dependencies !pkgs; if !explicit_conflicts then pkgs := Dependencies.generate_explicit_conflicts !pkgs; begin match !cone_package with | Some p -> pkgs := (Dependencies.extract_cone !pkgs p) | _ -> () end; do_output !pkgs; if !verbose then prerr_endline "[Main] Output written." end;; ceve-1.4/ceveduce/000077500000000000000000000000001123137777100140745ustar00rootroot00000000000000ceve-1.4/ceveduce/egraph_reader.ml000066400000000000000000000220431123137777100172170ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Egraph open Napkin {{ namespace "http://graphml.graphdrawing.org/xmlns/1.0rc" }} {{ namespace edos = "http://www.edos-project.org/egraph" }} type pkg_hashtable = (string, (string, default_package) Hashtbl.t) Hashtbl.t let empty_metadata = { pk_extra = (); pk_unit = ""; pk_version = ""; pk_architecture = ""; pk_source = ("", ""); pk_essential = false; pk_build_essential = false; pk_size = 0L; pk_installed_size = 0L; pk_provides = []; pk_conflicts = []; pk_replaces = []; pk_depends = []; pk_pre_depends = []; pk_suggests = []; pk_recommends = []; pk_enhances = [] };; let parse_egraph_file (filename: string): {{ graphml_type }} = let buflen = 1024 in let buf = String.create buflen and ic = open_in filename and expat_parser = Expat.parser_create ~encoding:None and od_loader = Ocamlduce.Load.make () in let rec loop p = let n = input ic buf 0 buflen in if n > 0 then (p buf 0 n; loop p) in begin Expat.set_start_element_handler expat_parser (Ocamlduce.Load.start_elem od_loader); Expat.set_end_element_handler expat_parser (Ocamlduce.Load.end_elem od_loader); Expat.set_character_data_handler expat_parser (Ocamlduce.Load.text od_loader); ignore (Expat.set_param_entity_parsing expat_parser Expat.ALWAYS); loop (Expat.parse_sub expat_parser); close_in ic; Expat.final expat_parser; {{ ({{ Ocamlduce.Load.get od_loader }} :? graphml_type) }} end;; let add_node_information (ht: pkg_hashtable) (xml: {{ node_type }}): unit = begin match xml with {{ [_* data::node_data_type _*] }} -> begin let pkg_ht = try Hashtbl.find ht {: pkg_name :} with Not_found -> Hashtbl.create 1 in begin match data with {{ [versions] }} -> List.iter (fun pkg_version -> let metadata = try Hashtbl.find pkg_ht pkg_version with Not_found -> { empty_metadata with pk_unit = {: pkg_name :}; pk_version = pkg_version } in Hashtbl.replace pkg_ht pkg_version { metadata with pk_unit = {: pkg_name :}; pk_version = pkg_version } ) {: map versions with [] -> [nr] :} end; Hashtbl.replace ht {: pkg_name :} pkg_ht end | {{ _ }} -> () end;; let create_dependency (op: string) (tgt_name: string) (tgt_version: string): (string, string, 'a) versioned = begin Unit_version (tgt_name, if op = "all" then Sel_ANY else if op = "lt" then Sel_LT tgt_version else if op = "le" then Sel_LEQ tgt_version else if op = "eq" then Sel_EQ tgt_version else if op = "ge" then Sel_GEQ tgt_version else if op = "gt" then Sel_GT tgt_version else raise (Failure ("Unknown version operator: " ^ op))) end;; let add_edge_information (ht: pkg_hashtable) (xml: {{ edge_type }}): unit = begin match xml with {{ [_* data::edge_data_type _*] }} -> begin match data with {{ [versions] }} -> List.iter (fun (src_version, op, tgt_version) -> let pkg_dependency = create_dependency op {: tgt_name :} tgt_version in let pkg_ht = try Hashtbl.find ht {: src_name :} with Not_found -> Hashtbl.create 1 in let metadata = try Hashtbl.find pkg_ht src_version with Not_found -> { empty_metadata with pk_unit = {: src_name :}; pk_version = src_version } in let new_metadata = if {: tp :} = "run" then { metadata with pk_depends = [pkg_dependency]::metadata.pk_depends } else if {: tp :} = "install" then { metadata with pk_pre_depends = [pkg_dependency]::metadata.pk_pre_depends } else if {: tp :} = "recommend" then { metadata with pk_recommends = [pkg_dependency]::metadata.pk_recommends } else if {: tp :} = "suggest" then { metadata with pk_suggests = [pkg_dependency]::metadata.pk_suggests } else if {: tp :} = "enhance" then { metadata with pk_enhances = [pkg_dependency]::metadata.pk_enhances } else if {: tp :} = "conflict" then { metadata with pk_conflicts = pkg_dependency::metadata.pk_conflicts } else if {: tp :} = "replace" then { metadata with pk_replaces = pkg_dependency::metadata.pk_replaces } else if {: tp :} = "provide" then { metadata with pk_provides = pkg_dependency::metadata.pk_provides } else raise (Failure ("Unknown dependency type " ^ {: tp :})) in Hashtbl.replace pkg_ht src_version new_metadata ) {: map versions with [] -> [(src_version, op, tgt_version)] :} end | {{ _ }} -> () end;; let add_hyperedge_information (ht: pkg_hashtable) (xml: {{ hyperedge_type }}): unit = let dep_type = ref "" and src_name = ref "" and disj_ht = Hashtbl.create 1 in begin match xml with {{ [(e::endpoint_type|_)*] }} -> dep_type := {: tp :}; List.iter (fun (e: {{ endpoint_type }}) -> begin match e with {{ _ }} -> src_name := {: src :}; | {{ [_* data::endpoint_data_type _*] }} -> begin match data with {{ [versions] }} -> begin List.iter (fun ((src_version, op, tgt_version): string * string * string) -> let deps = try Hashtbl.find disj_ht src_version with Not_found -> [] in let new_deps = (create_dependency op {: tgt_name :} tgt_version)::deps in Hashtbl.replace disj_ht src_version new_deps ) {: map versions with [] -> [(src_version, op, tgt_version)] :} end end | {{ _ }} -> raise (Failure ("Unknown endpoint type " ^ {: etp :})) end; ) {: e :}; Hashtbl.iter (fun src_version disj -> let versions_ht = try Hashtbl.find ht !src_name with Not_found -> Hashtbl.create 1 in let metadata = try Hashtbl.find versions_ht src_version with Not_found -> { empty_metadata with pk_unit = !src_name; pk_version = src_version } in let new_metadata = if !dep_type = "run" then { metadata with pk_depends = disj::metadata.pk_depends } else if !dep_type = "install" then { metadata with pk_pre_depends = disj::metadata.pk_pre_depends } else if !dep_type = "recommend" then { metadata with pk_recommends = disj::metadata.pk_recommends } else if !dep_type = "suggest" then { metadata with pk_suggests = disj::metadata.pk_suggests } else if !dep_type = "enhance" then { metadata with pk_enhances = disj::metadata.pk_enhances } else if (!dep_type = "conflict") || (!dep_type = "replace") || (!dep_type = "provide") then raise (Failure ("hyperedge for non-disjunctive dependency type " ^ !dep_type)) else raise (Failure ("unknown edge type " ^ !dep_type)) in Hashtbl.replace versions_ht src_version new_metadata ) disj_ht end;; let read_graph (xml: {{ graph_type }}): default_package list = let result = ref [] and ht = Hashtbl.create 1024 in begin begin match xml with {{ [(items::(node_type|edge_type|hyperedge_type)|_)*] }} -> if !Options.version_type = Options.Unspecified then begin if {: vt :} = "rpm" then Options.version_type := Options.RPMVersions else if {: vt :} = "debian" then Options.version_type := Options.DebianVersions else raise (Failure ("Unknown version type: " ^ {: vt :})) end; List.iter (fun (item: {{ node_type | edge_type | hyperedge_type }}) -> match item with {{ node_type & n }} -> add_node_information ht {: n :} | {{ edge_type & e }} -> add_edge_information ht {: e :} | {{ hyperedge_type & h }} -> add_hyperedge_information ht {: h :} ) {: items :} | {{ _ }} -> raise (Failure "graph is not directed") end; Hashtbl.iter (fun name pht -> Hashtbl.iter (fun version metadata -> result := metadata::!result ) pht ) ht; !result end;; (** Filter tags from contents *) let read_graphml (xml: {{ graphml_type }}): default_package list = begin match xml with {{ [ (graphs::graph_type | _)* ] }} -> List.flatten (List.map read_graph {: graphs :}) end;; let read_egraph_file (filename: string): default_package list = begin prerr_endline ("[EGraph] Reading EGraph file " ^ filename); let xml_contents = parse_egraph_file filename in read_graphml (xml_contents); end;; ceve-1.4/ceveduce/egraph_writer.ml000066400000000000000000000217311123137777100172740ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Writer for the EGraph format. @author Jaap Boender *) open Egraph open Napkin {{ namespace "http://graphml.graphdrawing.org/xmlns/1.0rc" }} {{ namespace edos = "http://www.edos-project.org/egraph" }} let node_from_package (pkg: default_package): {{ node_type }} = begin {{ [ (* {: pkg.summary :} *) [ [] ] ] }} end;; let edges_from_packages (pkgs: default_package list): {{ edge_type | hyperedge_type }} list = let operator_of vs = begin match vs with | Sel_ANY -> "all" | Sel_LT _ -> "lt" | Sel_LEQ _ -> "le" | Sel_EQ _ -> "eq" | Sel_GEQ _ -> "ge" | Sel_GT _ -> "gt" end and target_of vs = begin match vs with | Sel_ANY -> "" | Sel_LT v | Sel_LEQ v | Sel_EQ v | Sel_GT v | Sel_GEQ v -> v end and source_ht = Hashtbl.create (List.length pkgs) in let result = ref [] in begin List.iter (fun pkg -> (* Depends: *) let run_ht = try Hashtbl.find source_ht (pkg.pk_unit, "run") with Not_found -> Hashtbl.create (List.length pkg.pk_depends) in List.iter (fun disj -> let targets = List.map (fun x -> match x with | Unit_version (y, _) -> y | Glob_pattern _ -> raise (Failure "ARGH XIII") ) disj in let version_list = try Hashtbl.find run_ht targets with Not_found -> List.map (fun x -> []) disj in Hashtbl.replace run_ht targets (List.map2 (fun old add -> add::old ) version_list (List.map (fun x -> match x with | Unit_version (_, y) -> (pkg.pk_version, y) | Glob_pattern _ -> raise (Failure "ARGH XIV") ) disj)) ) pkg.pk_depends; Hashtbl.replace source_ht (pkg.pk_unit, "run") run_ht; (* Pre-Depends: *) let install_ht = try Hashtbl.find source_ht (pkg.pk_unit, "install") with Not_found -> Hashtbl.create (List.length pkg.pk_pre_depends) in List.iter (fun disj -> let targets = List.map (fun x -> match x with | Unit_version (y, _) -> y | Glob_pattern _ -> raise (Failure "ARGH XV") ) disj in let version_list = try Hashtbl.find install_ht targets with Not_found -> List.map (fun x -> []) disj in Hashtbl.replace install_ht targets (List.map2 (fun old add -> add::old ) version_list (List.map (fun x -> match x with | Unit_version (_, y) -> (pkg.pk_version, y) | Glob_pattern _ -> raise (Failure "ARGH XVI") ) disj)) ) pkg.pk_pre_depends; Hashtbl.replace source_ht (pkg.pk_unit, "install") install_ht; (* Recommends: *) let recommend_ht = try Hashtbl.find source_ht (pkg.pk_unit, "recommend") with Not_found -> Hashtbl.create (List.length pkg.pk_recommends) in List.iter (fun disj -> let targets = List.map (fun x -> match x with | Unit_version (y, _) -> y | Glob_pattern _ -> raise (Failure "ARGH XVII") ) disj in let version_list = try Hashtbl.find recommend_ht targets with Not_found -> List.map (fun x -> []) disj in Hashtbl.replace recommend_ht targets (List.map2 (fun old add -> add::old ) version_list (List.map (fun x -> match x with | Unit_version (_, y) -> (pkg.pk_version, y) | Glob_pattern _ -> raise (Failure "ARGH XVII") ) disj)) ) pkg.pk_recommends; Hashtbl.replace source_ht (pkg.pk_unit, "recommend") recommend_ht; (* Suggests: *) let suggest_ht = try Hashtbl.find source_ht (pkg.pk_unit, "suggest") with Not_found -> Hashtbl.create (List.length pkg.pk_suggests) in List.iter (fun disj -> let targets = List.map (fun x -> match x with | Unit_version (y, _) -> y | Glob_pattern _ -> raise (Failure "ARGH XVIII") ) disj in let version_list = try Hashtbl.find suggest_ht targets with Not_found -> List.map (fun x -> []) disj in Hashtbl.replace suggest_ht targets (List.map2 (fun old add -> add::old ) version_list (List.map (fun x -> match x with | Unit_version (_, y) -> (pkg.pk_version, y) | Glob_pattern _ -> raise (Failure "ARGH XIX") ) disj)) ) pkg.pk_suggests; Hashtbl.replace source_ht (pkg.pk_unit, "suggest") suggest_ht; (* Enhances: *) let enhance_ht = try Hashtbl.find source_ht (pkg.pk_unit, "enhance") with Not_found -> Hashtbl.create (List.length pkg.pk_enhances) in List.iter (fun disj -> let targets = List.map (fun x -> match x with | Unit_version (y, _) -> y | Glob_pattern _ -> raise (Failure "ARGH XX") ) disj in let version_list = try Hashtbl.find enhance_ht targets with Not_found -> List.map (fun x -> []) disj in Hashtbl.replace enhance_ht targets (List.map2 (fun old add -> add::old ) version_list (List.map (fun x -> match x with | Unit_version (_, y) -> (pkg.pk_version, y) | Glob_pattern _ -> raise (Failure "ARGH XXI") ) disj)) ) pkg.pk_enhances; Hashtbl.replace source_ht (pkg.pk_unit, "enhance") enhance_ht; (* Conflicts: *) let conflict_ht = try Hashtbl.find source_ht (pkg.pk_unit, "conflict") with Not_found -> Hashtbl.create (List.length pkg.pk_conflicts) in List.iter (fun dep -> let targets = match dep with | Unit_version (x, _) -> [x] | Glob_pattern _ -> raise (Failure "ARGH XXII") in let version_list = try Hashtbl.find conflict_ht targets with Not_found -> [[]] in Hashtbl.replace conflict_ht targets (List.map2 (fun old add -> add::old ) version_list [(pkg.pk_version, match dep with | Unit_version (_, x) -> x | Glob_pattern _ -> raise (Failure "ARGH XXIII"))]) ) pkg.pk_conflicts; Hashtbl.replace source_ht (pkg.pk_unit, "conflict") conflict_ht; (* Replaces: *) let replace_ht = try Hashtbl.find source_ht (pkg.pk_unit, "replace") with Not_found -> Hashtbl.create (List.length pkg.pk_replaces) in List.iter (fun dep -> let targets = match dep with | Unit_version (x, _) -> [x] | Glob_pattern _ -> raise (Failure "ARGH XXIV") in let version_list = try Hashtbl.find replace_ht targets with Not_found -> [[]] in Hashtbl.replace replace_ht targets (List.map2 (fun old add -> add::old ) version_list [(pkg.pk_version, match dep with | Unit_version (_, x) -> x | Glob_pattern _ -> raise (Failure "ARGH XXV"))]) ) pkg.pk_replaces; Hashtbl.replace source_ht (pkg.pk_unit, "replace") replace_ht; (* Provides: *) let provide_ht = try Hashtbl.find source_ht (pkg.pk_unit, "provide") with Not_found -> Hashtbl.create (List.length pkg.pk_provides) in List.iter (fun dep -> let targets = match dep with | Unit_version (x, _) -> [x] | Glob_pattern _ -> raise (Failure "ARGH XXVI") in let version_list = try Hashtbl.find provide_ht targets with Not_found -> [[]] in Hashtbl.replace provide_ht targets (List.map2 (fun old add -> add::old ) version_list [(pkg.pk_version, match dep with | Unit_version (_, x) -> x | Glob_pattern _ -> raise (Failure "ARGH XXVII"))]) ) pkg.pk_provides; Hashtbl.replace source_ht (pkg.pk_unit, "provide") provide_ht ) pkgs; Hashtbl.iter (fun (sn, tp) tns_versions -> Hashtbl.iter (fun tns versions -> if List.length tns = 1 then result := {{ [ {: List.map (fun (sv, tv) -> {{ [] }} ) (List.hd versions) :} ]}}::!result else result := {{ ( [[]] @ {: List.map2 (fun tn stvs -> {{ [ ( {: List.map (fun (sv, tv) -> {{ [] }}) stvs :} )]}} ) tns versions :} )}}::!result ) tns_versions ) source_ht; !result end;; let output_egraph (pkgs: default_package list): unit = let vt_name (vt: Options.version_types): string = begin match vt with Options.Unspecified -> "unspecified" | Options.RPMVersions -> "rpm" | Options.DebianVersions -> "debian" end and packages = List.rev_map node_from_package pkgs and edges = edges_from_packages pkgs in begin prerr_endline "[XML] Outputting EGraph file..."; let (output: {{ graphml_type }}) = {{ [ ( {: packages :} @ {: edges :} ) ] }} in Ocamlduce.Print.print_xml (output_string !Options.output_channel) output end;; ceve-1.4/cnf_writer.ml000066400000000000000000000105261123137777100150110ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Module to output data in CNF format (for either tart or a SAT solver @author Jaap Boender *) open Napkin let output_tart_dependencies (ht: Dependencies.pkg_hashtable) (pkg: default_package): unit = let var_name (n: string) (v: string) (a: string): string = begin n ^ "'" ^ v ^ "@" ^ a end in begin let dep_str = Tools.uniq (List.sort compare (List.map (fun disj -> let deps = List.flatten (List.map (fun d -> match d with | Unit_version (target, spec) -> List.map (fun (v, m) -> var_name target v m.pk_architecture) (List.filter (fun (v, m) -> Dependencies.can_provide (Sel_EQ v) spec) (Hashtbl.find_all ht target)) | Glob_pattern _ -> raise (Failure "ARGH V")) disj) in if deps <> [] then "!" ^ (var_name pkg.pk_unit pkg.pk_version pkg.pk_architecture) ^ " " ^ (String.concat " " (Tools.uniq (List.sort compare deps))) ^ "\n" else "" ) (pkg.pk_depends @ pkg.pk_pre_depends))) in let cfl_str = Tools.uniq (List.sort compare (List.flatten (List.map (fun c -> match c with | Unit_version (cfl_t, cfl_s) -> (List.map (fun (v, m) -> "!" ^ (var_name pkg.pk_unit pkg.pk_version pkg.pk_architecture) ^ " !" ^ (var_name cfl_t v m.pk_architecture)) (List.filter (fun (v, m) -> Dependencies.can_provide (Sel_EQ v) cfl_s && ((m.pk_unit <> pkg.pk_unit) || (m.pk_version <> pkg.pk_version))) (Hashtbl.find_all ht cfl_t))) | Glob_pattern _ -> raise (Failure "ARGH VI") ) pkg.pk_conflicts))) in if ((dep_str = []) || (dep_str = [""])) && (cfl_str = []) then output_string !Options.output_channel ((var_name pkg.pk_unit pkg.pk_version pkg.pk_architecture) ^ " !" ^ (var_name pkg.pk_unit pkg.pk_version pkg.pk_architecture) ^ "\n") else begin if dep_str <> [] then output_string !Options.output_channel (String.concat "" dep_str); if cfl_str <> [] then output_string !Options.output_channel ((String.concat "\n" cfl_str) ^ "\n") end end;; let output_tart_cnf (pkgs: default_package list): unit = let ht = Dependencies.create_pkgs_hashtable pkgs in begin prerr_endline "[CNF] Outputting Tart CNF lines..."; List.iter (output_tart_dependencies ht) pkgs end;; let output_dimacs_cnf (pkgs: default_package list): unit = let ht = Dependencies.create_pkgs_hashtable pkgs in let vars = Hashtbl.create (List.length pkgs) in let clauses = ref [] in let get_variable pkg = try Hashtbl.find vars (pkg.pk_unit, pkg.pk_version, pkg.pk_architecture) with Not_found -> begin let n = Hashtbl.length vars + 1 in Hashtbl.add vars (pkg.pk_unit, pkg.pk_version, pkg.pk_architecture) n; n end in begin List.iter (fun pkg -> let p_var = get_variable pkg in List.iter (fun disj -> let dcl = -p_var::(List.map (fun (_, m) -> get_variable m) (List.flatten (List.map (function | Unit_version (target, spec) -> List.filter (fun (v, m) -> Dependencies.can_provide (Sel_EQ v) spec && pkg.pk_unit <> m.pk_unit) (Hashtbl.find_all ht target) | Glob_pattern _ -> raise (Failure "ARGH VII") ) disj))) in clauses := dcl::!clauses; ) (pkg.pk_depends @ pkg.pk_pre_depends); List.iter (function | Unit_version (target, spec) -> List.iter (fun (_, m) -> clauses := [-p_var; -(get_variable m)]::!clauses ) (List.filter (fun (v, m) -> Dependencies.can_provide (Sel_EQ v) spec && ((m.pk_unit <> pkg.pk_unit) || (m.pk_version <> pkg.pk_version))) (Hashtbl.find_all ht target)) | Glob_pattern _ -> raise (Failure "ARGH VIII") ) pkg.pk_conflicts ) pkgs; let oc = !Options.output_channel in Printf.fprintf oc "p cnf %d %d\n" (Hashtbl.length vars) (List.length !clauses); List.iter (fun c -> Printf.fprintf oc "%s 0\n" (String.concat " " (List.map string_of_int c)) ) !clauses end;; ceve-1.4/cnf_writer.mli000066400000000000000000000014441123137777100151610ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val output_tart_cnf: Napkin.default_package list -> unit val output_dimacs_cnf: Napkin.default_package list -> unit ceve-1.4/dependencies.ml000066400000000000000000000305161123137777100152760ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Options open Napkin type vp_hashtable = (string, (string selector) * (string * (string selector))) Hashtbl.t type pkg_hashtable = (string, string * default_package) Hashtbl.t let ifd = Hashtbl.create 256 (* file dependencies to be ignored (no warning) *);; let version_of (spec: (string) selector): string = begin match spec with Sel_ANY -> "" | Sel_LT x | Sel_LEQ x | Sel_EQ x | Sel_GEQ x | Sel_GT x -> x end;; let split_version (v: string): string * string * string = let split_epoch (v: string): string * string = begin try let colon_index = String.index v ':' in (String.sub v 0 colon_index, String.sub v (colon_index+1) ((String.length v)-colon_index-1)) with Not_found -> ("0", v) end and split_release (v: string): string * string = begin try let hyphen_index = String.rindex v '-' in (String.sub v 0 hyphen_index, String.sub v (hyphen_index+1) ((String.length v)-hyphen_index-1)) with Not_found -> (v, "") end in begin let (epoch, rest) = split_epoch v in let (upstream, release) = split_release rest in (epoch, upstream, release) end;; let compare_versions = match !version_type with | DeweyVersions -> Ocamlpkgsrc.compare_versions | RPMVersions -> Ocamlrpm.compare_versions | _ -> Ocamldeb.compare_versions;; (** Find out whether a package (with a certain version) can provide a dependency. For example: [can_provide (Equal "6.3") (Less "6.4")] returns true, since version 6.3 satisfies the condition "less than 6.4". *) let can_provide (provider: (string) selector) (dependency: (string) selector): bool = begin match dependency with | Sel_ANY -> true (* any version can be satisfied by anything *) | Sel_EQ d -> (match provider with | Sel_ANY -> true | Sel_EQ p -> compare_versions d p = 0 | Sel_LT p -> compare_versions d p < 0 | Sel_LEQ p -> compare_versions d p <= 0 | Sel_GT p -> compare_versions d p > 0 | Sel_GEQ p -> compare_versions d p >= 0) | Sel_LT d -> (match provider with | Sel_ANY -> true | Sel_EQ p -> compare_versions p d < 0 | Sel_LT p | Sel_LEQ p -> true | Sel_GT p | Sel_GEQ p -> compare_versions p d < 0) | Sel_LEQ d -> (match provider with | Sel_ANY -> true | Sel_EQ p -> compare_versions p d <= 0 | Sel_LT p | Sel_LEQ p -> true | Sel_GT p -> compare_versions p d < 0 | Sel_GEQ p -> compare_versions p d <= 0) | Sel_GT d -> (match provider with | Sel_ANY -> true | Sel_EQ p -> compare_versions p d > 0 | Sel_LT p | Sel_LEQ p -> compare_versions p d > 0 | Sel_GT p | Sel_GEQ p -> true) | Sel_GEQ d -> (match provider with | Sel_ANY -> true | Sel_EQ p -> compare_versions p d >= 0 | Sel_LT p -> compare_versions p d > 0 | Sel_LEQ p -> compare_versions p d >= 0 | Sel_GT p | Sel_GEQ p -> true) end;; let create_vp_hashtable (pkgs: default_package list): vp_hashtable = let ht = Hashtbl.create (List.length pkgs) in begin if !verbose then prerr_endline "[Deps] Creating virtual package hashtable..."; List.iter (fun pkg -> List.iter (fun p -> match p with | Unit_version (pu, ps) -> Hashtbl.add ht pu (ps, (pkg.pk_unit, Sel_EQ pkg.pk_version)) | Glob_pattern g -> raise (Failure "ARGH I") ) pkg.pk_provides; (* And for Debian, packages provide themselves *) if !Options.version_type = Options.DebianVersions then Hashtbl.add ht pkg.pk_unit (Sel_EQ pkg.pk_version, (pkg.pk_unit, Sel_EQ pkg.pk_version)) ) pkgs; ht end;; let create_pkgs_hashtable (pkgs: default_package list): pkg_hashtable = let ht = Hashtbl.create (List.length pkgs) in begin if !verbose then prerr_endline "[Deps] Creating package hashtable..."; List.iter (fun pkg -> Hashtbl.add ht pkg.pk_unit (pkg.pk_version, pkg)) pkgs; ht end;; let get_dependencies (pkg: default_package): (string, string, string) versioned list = let result = ref [] in begin List.iter (fun x -> match x with Conflicts -> result := !result @ pkg.pk_conflicts | Depends -> result := !result @ (List.flatten pkg.pk_depends) | Enhances -> result := !result @ (List.flatten pkg.pk_enhances) | PreDepends -> result := !result @ (List.flatten pkg.pk_pre_depends) | Recommends -> result := !result @ (List.flatten pkg.pk_recommends) | Replaces -> result := !result @ pkg.pk_replaces | Suggests -> result := !result @ (List.flatten pkg.pk_suggests) ) !Options.cone_types; !result end;; let replace_virtual_dependencies (name, version) (dep_type: string) (pht: pkg_hashtable) (vht: vp_hashtable) (deps: (string, string, string) versioned list list): (string, string, string) versioned list list = begin List.map (fun disj -> List.flatten (List.map (fun d -> match d with | Unit_version (target, spec) -> if Tools.starts_with "rpmlib" target then [] else if (!Options.version_type = Options.DebianVersions) && (spec <> Sel_ANY) then [Unit_version (target, spec)] (* Debian provide resolution ONLY if dependency is not versioned *) else let possible_providers = Hashtbl.find_all vht target in (* if !verbose then Printf.eprintf "[Deps] %s possibly provided by: %s\n" (string_of_ts (target, spec)) (String.concat "|" (List.map (fun (vs, d) -> "[" ^ (string_of_versioned d) ^ "]") possible_providers)); *) if possible_providers = [] && (target.[0] <> '/' || not (Hashtbl.mem ifd target)) then begin Printf.eprintf "[Deps] WARNING: package %s-%s has a %s on %s, but %s does not exist.\n" name version dep_type (string_of_versioned (Unit_version (target, spec))) target; Printf.eprintf "[Deps] Dropping %s, which might lead to inaccurate results (see manual).\n" dep_type end; let providers = List.filter (fun (vs, _) -> can_provide vs spec) possible_providers in (* if !verbose then Printf.eprintf "[Deps] %s finally provided by: %s\n" (string_of_versioned (target, spec)) (String.concat "|" (List.map (fun (vs, d) -> "[" ^ (string_of_versioned d) ^ "]") providers)); *) Tools.uniq (List.sort compare (List.map (fun p -> Unit_version (snd p)) providers)) | Glob_pattern _ -> raise (Failure "ARGH II") ) disj) ) deps end;; let replace_virtual_conflicts (pht: pkg_hashtable) (vht: vp_hashtable) (pname: string) (cfls: (string, string, string) versioned list): (string, string, string) versioned list = begin List.flatten (List.map (fun d -> match d with | Unit_version (target, spec) -> if Tools.starts_with "rpmlib" target then [] else if (!Options.version_type = Options.DebianVersions) && (spec <> Sel_ANY) then [Unit_version (target, spec)] (* Debian provide resolution ONLY if dependency is not versioned *) else let possible_providers = Hashtbl.find_all vht target in let providers = List.filter (fun (vs, (t, s)) -> can_provide vs spec && (if !Options.version_type = Options.DebianVersions then (t <> pname) && (target <> pname) else true)) possible_providers in let pkgs = Hashtbl.find_all pht target in let providers_plus = if !Options.version_type = Options.DebianVersions then (List.map snd providers) @ (List.map (fun (v, m) -> (target, Sel_EQ v)) (List.filter (fun (v, _) -> can_provide (Sel_EQ v) spec) pkgs)) else List.map snd providers in Tools.uniq (List.sort compare (List.map (fun d -> Unit_version d) providers_plus)) | Glob_pattern g -> raise (Failure "ARGH III") ) cfls) end;; let resolve_dependencies (pkgs: default_package list): default_package list = begin prerr_endline "[Deps] Resolving dependencies..."; if !verbose then prerr_endline ("[Deps] Using " ^ (match !version_type with RPMVersions -> "RPM" | _ -> "Debian") ^ " versions..."); if !Options.ignore_file_deps <> "" then begin let f = open_in !Options.ignore_file_deps in try while true do Hashtbl.add ifd (input_line f) true; done; with End_of_file -> close_in f end; let pht = create_pkgs_hashtable pkgs and vht = create_vp_hashtable pkgs in List.map (fun pkg -> { pkg with pk_depends = replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "dependency" pht vht pkg.pk_depends; pk_pre_depends = replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "pre-dependency" pht vht pkg.pk_pre_depends; pk_conflicts = replace_virtual_conflicts pht vht pkg.pk_unit pkg.pk_conflicts; pk_recommends = replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "recommendation" pht vht pkg.pk_recommends; pk_suggests = replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "suggestion" pht vht pkg.pk_suggests; pk_enhances = replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "enhancement" pht vht pkg.pk_enhances } ) pkgs end;; let enlarge_cone (ht: pkg_hashtable) (vht: vp_hashtable) (units: (string * string * bool) list) : (string * string * bool) list = let rec cone_uniq (x: (string * string * bool) list) (b: bool): (string * string * bool) list = begin match x with | [] -> [] | y::ys -> begin match ys with | [] -> let (ny, vy, dy) = y in [(ny, vy, b)] | z::zs -> let (ny, vy, dy) = y and (nz, vz, dz) = z in if ny = nz && vy = vz then cone_uniq ys (b || (dy || dz)) else (ny, vy, dy)::(cone_uniq ys (b || dy)) end end in begin let res = (List.flatten (List.flatten (List.map (fun (n, v, d) -> if not d then begin if (not (List.exists (fun (x, y) -> n = x && v = y) !Options.cone_stops)) then begin try let versions = Hashtbl.find_all ht n in let pkgs = List.map snd (if v = "" then versions else List.filter (fun (x, _) -> x = v) versions) in let deps = Tools.uniq (List.sort compare (List.flatten (List.map get_dependencies pkgs))) in List.map (fun d -> match d with | Unit_version (target, spec) -> let av_versions = Hashtbl.find_all ht target in let providers = Hashtbl.find_all vht target in List.flatten (List.map (fun (av_version, av_md) -> if can_provide (Sel_EQ av_version) spec then [(av_md.pk_unit, av_md.pk_version, false)] else [] ) av_versions) @ (List.flatten (List.map (fun (vs, (t, s)) -> if can_provide spec vs then [(t, version_of s, false)] else []) providers)) | Glob_pattern _ -> raise (Failure "ARGH IV") ) deps with Not_found -> [] end else begin prerr_endline ("[Deps] not enlarging for " ^ n ^ "/" ^ v ^ " because not allowed by user"); [] end end else (* d is true *) [] ) units))) in let new_units = List.map (fun (n,v,_) -> (n,v,true)) units in cone_uniq (List.sort (fun (n1,v1,d1) (n2,v2,d2) -> compare (n1,v1) (n2,v2)) (res @ new_units)) false end;; let extract_cone (pkgs: default_package list) (spec: string * string): default_package list = let name, version = spec in begin Printf.eprintf "[Deps] Extracting dependency cone for %s %s...\n" name (if version <> "" then " (version " ^ version ^")" else ""); let pht = create_pkgs_hashtable pkgs and vht = create_vp_hashtable pkgs in let units = Tools.fixpoint [(name,version,false)] (enlarge_cone pht vht) in let result = List.flatten (List.map (fun (n, v, _) -> let versions = Hashtbl.find_all pht n in List.map snd (if v = "" then versions else List.filter (fun (x, _) -> x = v) versions) ) units) in prerr_endline ("[Deps] Cone size: " ^ (string_of_int (List.length result))); result end;; let generate_explicit_conflicts (pkgs: default_package list): default_package list = begin Printf.eprintf "[Deps] Generating explicit conflicts...\n%!"; let pht = create_pkgs_hashtable pkgs in let units = Tools.uniq (List.sort compare (List.map (fun p -> p.pk_unit) pkgs)) in let res = ref [] in List.iter (fun u -> match Hashtbl.find_all pht u with | [] -> () (* no packages for unit u - this should not be the case *) | [v, pkg] -> res := pkg::!res | l -> List.iter (fun (v, pkg) -> let new_pkg = { pkg with pk_conflicts = pkg.pk_conflicts @ (List.map (fun (_, c) -> Unit_version (c.pk_unit, Sel_EQ c.pk_version)) (List.filter (fun (_, x) -> x <> pkg) l)) } in res := new_pkg::!res ) l ) units; !res end;; ceve-1.4/dependencies.mli000066400000000000000000000023031123137777100154400ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Napkin type pkg_hashtable = (string, string * default_package) Hashtbl.t val version_of: (string) selector -> string val compare_versions: string -> string -> int val can_provide: (string) selector -> (string) selector -> bool val resolve_dependencies: default_package list -> default_package list val create_pkgs_hashtable: default_package list -> pkg_hashtable val extract_cone: default_package list -> string * string -> default_package list val generate_explicit_conflicts: default_package list -> default_package list ceve-1.4/dose_writer.ml000066400000000000000000000070761123137777100152030ustar00rootroot00000000000000(* This file is part of Ceve. Ceve 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. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 52 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Napkin open Options let dose_of_field (name: string) (contents: string): string * string * string list = begin try let newline_index = String.index contents '\n' in let first_line = String.sub contents 0 newline_index in let next_lines = Str.split (Str.regexp_string "\n") (String.sub contents (newline_index + 1) ((String.length contents) - newline_index - 1)) in (name, first_line, next_lines) with Not_found -> (name, contents, []) end;; let dose_of_dependencies (deps: (string, string, string) versioned list): string = begin String.concat ", " (List.sort compare (Tools.uniq (List.map string_of_versioned (List.filter ( fun d -> match d with | Unit_version (u, _) -> not (Tools.starts_with "rpmlib" u) | Glob_pattern g -> true) deps)))) end;; let dose_of_dep_expression (deps: (string, string, string) versioned list list): string = begin String.concat ", " (List.sort compare (Tools.uniq (List.filter (fun z -> z <> "") (List.map (fun x -> String.concat " | " (List.sort compare (Tools.uniq (List.map string_of_versioned (List.filter (fun d -> match d with | Unit_version (u, _) -> not (Tools.starts_with "rpmlib" u) | Glob_pattern g -> true ) x)))) ) deps)))) end let to_dose (pkg: default_package): (string * string * string list) list = begin [ ("Architecture", pkg.pk_architecture, []); ("Conflicts", dose_of_dependencies pkg.pk_conflicts, []); ("Depends", dose_of_dep_expression pkg.pk_depends, []); ("Enhances", dose_of_dep_expression pkg.pk_enhances, []); ("Essential", (if pkg.pk_essential then "yes" else "no"), []); ("Installed-Size", Int64.to_string pkg.pk_installed_size, []); dose_of_field "Package" pkg.pk_unit; ("Pre-Depends", dose_of_dep_expression pkg.pk_pre_depends, []); ("Provides", dose_of_dependencies (List.filter (fun d -> match d with | Unit_version (u, _) -> not (Tools.starts_with "rpmlib" u) | Glob_pattern g -> true) pkg.pk_provides), []); ("Recommends", dose_of_dep_expression pkg.pk_recommends, []); ("Replaces", dose_of_dependencies pkg.pk_replaces, []); ("Size", Int64.to_string pkg.pk_size, []); ("Source", (let (x, y) = pkg.pk_source in x ^ " " ^ y), []); ("Suggests", dose_of_dep_expression pkg.pk_suggests, []); dose_of_field "Version" pkg.pk_version ] end;; let output_dose (pkgs: default_package list): unit = let module DBO = Dosebase.Out in let set_type = if !dose_type <> "" then !dose_type else match !input_type with | Debian | DebianCache -> "debian" | RPM | HDList -> "rpm" | Pkgsrc -> "pkgsrc" | _ -> "unknown" in let db = DBO.open_out ~set_type !output_dir in begin prerr_endline "[Dose] adding packages..."; List.iter (fun pkg -> if !verbose then begin prerr_endline ("[Dose] adding package " ^ pkg.pk_unit ^ ")") end; DBO.add_package db ~archive:!dose_archive ~day:(Lifetime.day_of_ymd !dose_date) (to_dose pkg) ) pkgs; prerr_endline "[Dose] closing database..."; DBO.close_out db end;; ceve-1.4/dose_writer.mli000066400000000000000000000013451123137777100153450ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val output_dose: Napkin.default_package list -> unit ceve-1.4/egraph.ml000066400000000000000000000050561123137777100141170ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Datatypes for the EGraph format. @author Jaap Boender *) {{ namespace "http://graphml.graphdrawing.org/xmlns/1.0rc" }} {{ namespace xlink = "http://www.w3.org/1999/xlink" }} {{ namespace edos = "http://www.edos-project.org/egraph" }} type desc_type = {{ (Latin1) }} type locator_type = {{ [] }} type node_data_type = {{ [ []* ] }} type edge_data_type = {{ [ []* ] }} type endpoint_data_type = {{ [ []* ] }} type data_type = {{ [] }} type default_type = {{ (Latin1) }} (* TODO own extensions *) type port_type = {{ [ desc_type? (data_type | port_type)* ] }} type key_type = {{ [ desc_type? default_type? ] }} type endpoint_type = {{ [ desc_type? endpoint_data_type? ] }} type graph_type = {{ [ desc_type? ( (data_type | node_type | edge_type | hyperedge_type)* | locator_type ) ] }} and node_type = {{ [ desc_type? ( ( port_type* node_data_type? port_type* graph_type? ) | locator_type ) ] }} and edge_type = {{ [ desc_type? edge_data_type? graph_type? ] }} and hyperedge_type = {{ [ desc_type? (data_type | endpoint_type)* graph_type? ] }} type graphml_type = {{ [ desc_type? key_type* (graph_type|data_type)* ] }} ceve-1.4/egraph_reader.ml000066400000000000000000000015401123137777100154330ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Napkin let read_egraph_file (filename: string): default_package list = begin prerr_endline "ERROR: Ceve was not compiled with support for the EGraph format."; [] end;; ceve-1.4/egraph_reader.mli000066400000000000000000000013621123137777100156060ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Napkin val read_egraph_file: string -> default_package list ceve-1.4/egraph_writer.ml000066400000000000000000000016151123137777100155100ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Writer for the EGraph format. @author Jaap Boender *) open Napkin let output_egraph (pkgs: default_package list): unit = begin prerr_endline "ERROR: Ceve was not compiled with support for the EGraph format." end;; ceve-1.4/egraph_writer.mli000066400000000000000000000013471123137777100156630ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val output_egraph: Napkin.default_package list -> unit ceve-1.4/graphviz_writer.ml000066400000000000000000000104151123137777100160720ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Writer for the Graphviz (DOT) format. @author Jaap Boender *) open Napkin let output_node (oc: out_channel) (pkg: default_package): unit = begin output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" [shape=record, color=black, label=\"{" ^ pkg.pk_unit ^ "|" ^ pkg.pk_version ^ "}\"];\n") end;; let output_provides (oc: out_channel) (pkg: default_package): unit = begin List.iter (fun d -> match d with | Unit_version (t, s) -> output_string oc ("\"" ^ t ^ "\" -> \"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" [style=dashed];\n") | Glob_pattern _ -> raise (Failure "ARGH XI") ) pkg.pk_provides end;; let get_depname (ht: Dependencies.pkg_hashtable) (dep: (string, string, string) versioned): string = match dep with | Glob_pattern _ -> raise (Failure "ARGH XII") | Unit_version (target, spec) -> begin let res = String.concat "/" (let versions = Hashtbl.find_all ht target in List.flatten (List.map (fun (v, md) -> if Dependencies.can_provide spec (Sel_EQ v) then [md.pk_unit ^ "=" ^ md.pk_version] else [] ) versions)) in if res = "" then target else res end let get_disjname (ht: Dependencies.pkg_hashtable) (disj: (string, string, string) versioned list): string = begin String.concat "/" (List.map (get_depname ht) disj) end;; let output_disjunctions (oc: out_channel) (ht: Dependencies.pkg_hashtable) (pkg: default_package): unit = let output_disj (disj: (string, string, string) versioned list) = begin if List.length disj > 1 then let disjname = get_disjname ht disj in output_string oc ("\"" ^ disjname ^ "\" [shape=point, color=black];\n"); List.iter (fun dep -> output_string oc ("\"" ^ disjname ^ "\" -> \"" ^ (get_depname ht dep) ^ "\" [style=dotted];\n") ) disj end in begin List.iter output_disj pkg.pk_depends; List.iter output_disj pkg.pk_pre_depends; end;; let output_dependencies (oc: out_channel) (ht: Dependencies.pkg_hashtable) (pkg: default_package): unit = let output_with_disjs (e: (string, string, string) versioned list list) (style: string) = begin List.iter (fun disj -> if List.length disj > 1 then let disjname = get_disjname ht disj in output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" -> \"" ^ disjname ^ "\" [" ^ style ^ "];\n") else List.iter (fun dep -> output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" -> \"" ^ (get_depname ht dep) ^ "\" [" ^ style ^ "];\n") ) disj ) e end and output_without_disjs (e: (string, string, string) versioned list) (style: string) = begin List.iter (fun dep -> output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" -> \"" ^ (get_depname ht dep) ^ "\" [" ^ style ^ "];\n") ) e end in begin output_with_disjs pkg.pk_depends "color=black"; output_with_disjs pkg.pk_pre_depends "color=blue"; output_without_disjs pkg.pk_conflicts "color=red"; output_without_disjs pkg.pk_replaces "color=orange"; output_with_disjs pkg.pk_enhances "color=green"; output_with_disjs pkg.pk_recommends "color=yellow"; output_with_disjs pkg.pk_suggests "color=yellow, style=dashed" end;; let output_graphviz (pkgs: default_package list): unit = begin prerr_endline "[Graphviz] Outputting Graphviz file..."; let ht = Dependencies.create_pkgs_hashtable pkgs in output_string !Options.output_channel "digraph G {\n"; output_string !Options.output_channel "node [shape=ellipse, color=red];\n"; List.iter (output_node !Options.output_channel) pkgs; List.iter (output_provides !Options.output_channel) pkgs; List.iter (output_disjunctions !Options.output_channel ht) pkgs; List.iter (output_dependencies !Options.output_channel ht) pkgs; output_string !Options.output_channel "}\n" end;; ceve-1.4/graphviz_writer.mli000066400000000000000000000013511123137777100162420ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val output_graphviz: Napkin.default_package list -> unit ceve-1.4/options.ml000066400000000000000000000253311123137777100143420ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** This module deals with options. It contains references that are filled according to the command options and can be used by the other modules @author Jaap Boender *) type input_types = Debian | DebianCache | RPM | HDList | SynHDList | Pkgsrc | EGraphIn type output_types = PrettyPrint | EGraphOut | (* RPMFind | *) Dose | Oz | Graphviz | TartCNF | TartSize | DimacsCNF type version_types = Unspecified | DebianVersions | RPMVersions | DeweyVersions type db_types = MySQL type db_info_type = { db_type: db_types; db_hostname: string; db_name: string; db_port: int; db_user: string; db_password: string } type dep_types = Conflicts | Depends | Enhances | PreDepends | Recommends | Replaces | Suggests ;; let output_channel = ref stdout (** global reference to output channel *) let output_dir = ref "" (** global reference to output directory *) let input_type = ref Debian (** global reference to type of input *) let input_files = ref [] (** global reference to input files *) let output_type = ref PrettyPrint (** global reference to type of output *) let version_type = ref Unspecified (** global reference to version comparison type *) let resolve_dependencies = ref false (** resolve dependencies or not *) let database_info = ref {db_type = MySQL; db_hostname = ""; db_name = ""; db_port = 5432; db_user = ""; db_password = ""} (** database information *) let create_tables = ref true (** create non-present tables *) let verbose = ref false (** verbosity *) let cone_package = ref None (** extract cone for package *) let cone_types = ref [Conflicts; Depends; Enhances; PreDepends; Recommends; Replaces; Suggests] (** cone types to extract *) let cone_stops = ref [] (** do not cone-extract these packages *) let dose_date = ref (0, 0, 0) (** Interval for Dose *) let dose_archive = ref "" (** Dose archive name *) let dose_type = ref "" (** Dose type name *) let ignore_unknown_fields = ref false (** Ignore unknown metadata fields *) let explicit_conflicts = ref false (** Add explicit conflicts *) let ignore_file_deps = ref "" ;; (** Set the output file *) let set_output_file (filename: string): unit = begin output_channel := open_out filename end;; (** Set the output directory *) let set_output_dir (dirname: string): unit = begin output_dir := dirname end;; (** Set the input type *) let set_input_type (type_name: string): unit = let t = String.lowercase type_name in begin if t = "debian" then begin input_type := Debian; if !version_type = Unspecified then version_type := DebianVersions; explicit_conflicts := true; end else if t = "debian-cache" || t = "debian-pool" then begin input_type := DebianCache; if !version_type = Unspecified then version_type := DebianVersions; explicit_conflicts := true; end else if t = "rpm" then begin input_type := RPM; if !version_type = Unspecified then version_type := RPMVersions end else if t = "hdlist" then begin input_type := HDList; if !version_type = Unspecified then version_type := RPMVersions end else if t = "synthesis-hdlist" then begin input_type := SynHDList; if !version_type = Unspecified then version_type := RPMVersions end else if t = "pkgsrc" then begin input_type := Pkgsrc; if !version_type = Unspecified then version_type := DeweyVersions end else if t = "egraph" then input_type := EGraphIn else raise (Failure ("Unknown input type " ^ type_name)) end;; (** Add a file for input *) let add_input_file (filename: string): unit = begin input_files := (filename::!input_files) end;; (** Set the output type *) let set_output_type (type_name: string): unit = let t = String.lowercase type_name in begin if t = "prettyprint" then output_type := PrettyPrint else if t = "dgraph" || t = "egraph" then output_type := EGraphOut (* else if t = "rpmfind" || t = "sql-rpmfind" then output_type := RPMFind *) else if t = "dose" then output_type := Dose else if t = "oz" then output_type := Oz else if t = "graphviz" || t = "dot" then output_type := Graphviz else if t = "tart" || t = "tart-cnf" || t = "cnf" then begin output_type := TartCNF; resolve_dependencies := true (* necessary! *) end else if t = "tart-size" then output_type := TartSize else if t = "dimacs" || t = "dimacs-cnf" then begin output_type := DimacsCNF; resolve_dependencies := true (* necessary! *) end else raise (Failure ("Unknown output type " ^ type_name)) end;; (** Set SQL database information *) let set_database_info (info_string: string): unit = let info_parts = Str.split_delim (Str.regexp_string ":") info_string in begin if List.length info_parts = 5 then database_info := { db_type = MySQL; db_hostname = List.nth info_parts 0; db_name = List.nth info_parts 1; db_user = List.nth info_parts 3; db_password = List.nth info_parts 4; db_port = let port_string = List.nth info_parts 2 in if port_string = "" then 5432 else int_of_string port_string } else raise (Failure ("Invalid database string " ^ info_string)); end;; (** Force usage of Debian versions *) let set_debian_versions (_: unit): unit = begin version_type := DebianVersions; explicit_conflicts := true; end;; (** Force usage of RPM versions *) let set_rpm_versions (_: unit): unit = begin version_type := RPMVersions end;; (** Extract cone *) let set_cone_package (spec: string): unit = begin try let eq_index = String.index spec '=' in let name = String.sub spec 0 eq_index in let version = String.sub spec (eq_index + 1) (String.length spec - eq_index - 1) in cone_package := Some (name, version) with Not_found -> cone_package := Some (spec, "") end;; (** set cone types *) let set_cone_types (spec: string): unit = let specs = List.map (fun x -> String.lowercase (Tools.truncate x)) (Str.split (Str.regexp_string ",") spec) in begin cone_types := []; List.iter (fun s -> if s = "conflicts" then cone_types := Conflicts::!cone_types else if s = "depends" then cone_types := Depends::!cone_types else if s = "enhances" then cone_types := Enhances::!cone_types else if s = "predepends" || s = "pre-depends" || s = "install" then cone_types := PreDepends::!cone_types else if s = "recommends" then cone_types := Recommends::!cone_types else if s = "replaces" then cone_types := Replaces::!cone_types else if s = "suggests" then cone_types := Suggests::!cone_types else raise (Failure ("Unknown dependency type: " ^ s)) ) specs; cone_types := Tools.uniq (List.sort compare !cone_types) end;; let set_cone_stops (spec: string): unit = let specs = List.map Tools.truncate (Str.split (Str.regexp_string ",") spec) in begin cone_stops := []; List.iter (fun s -> try let eq_index = String.index s '=' in let name = String.sub s 0 eq_index in let version = String.sub s (eq_index + 1) (String.length s - eq_index - 1) in cone_stops := (name, version)::!cone_stops with Not_found -> cone_stops := (s, "")::!cone_stops ) specs; cone_stops := Tools.uniq (List.sort compare !cone_stops) end;; (** Set DOSE date *) let set_dose_date (opt_string: string): unit = begin Scanf.sscanf opt_string "%[0-9]-%[0-9]-%[0-9]" (fun y m d -> prerr_endline ("Year " ^ y ^ ", month: " ^ m ^ ", date: " ^ d); dose_date := (int_of_string y, int_of_string m, int_of_string d)) end;; (** command line options *) let options_spec = [("-o", Arg.String set_output_file, "Set output file (default stdout)"); ("-output-file", Arg.String set_output_file, "Set output file (default stdout)"); ("-output-dir", Arg.String set_output_dir, "Set output directory (for dose)"); ("-p", Arg.String set_input_type, "Set type of input (default debian)"); ("-input-type", Arg.String set_input_type, "Set type of input (default debian)"); ("-t", Arg.String set_output_type, "Set type of output (default prettyprint)"); ("-output-type", Arg.String set_output_type, "Set type of output (default prettyprint)"); ("-x", Arg.String set_cone_package, "Extract dependency cone for a given package (and possibly version)"); ("-extract-cone", Arg.String set_cone_package, "Extract dependency cone for a given package (and possibly version)"); ("-cone-dep-types", Arg.String set_cone_types, "Dependency types to follow for cone extraction (default: all)"); ("-stop-extraction", Arg.String set_cone_stops, "Set packages to not extract for cone extraction"); ("-r", Arg.Set resolve_dependencies, "Resolve virtual dependencies"); ("-resolve-dependencies", Arg.Set resolve_dependencies, "Resolve virtual dependencies"); ("-vr", Arg.Unit set_rpm_versions, "Force usage of RPM version comparisons"); ("-rpm-versions", Arg.Unit set_rpm_versions, "Force usage of RPM version comparisons"); ("-vd", Arg.Unit set_debian_versions, "Force usage of Debian version comparisons"); ("-debian-versions", Arg.Unit set_debian_versions, "Force usage of Debian version comparisons"); ("-d", Arg.String set_database_info, "Set database info (SQL only; format: hostname:database:port:user:password)"); ("-database-info", Arg.String set_database_info, "Set database info (SQL only; format: hostname:database:port:user:password)"); ("-create-tables", Arg.Set create_tables, "Create SQL tables if not present already (default behaviour)"); ("-no-create-tables", Arg.Clear create_tables, "Do not create SQL tables"); ("-dose-date", Arg.String set_dose_date, "Set DOSE date (format: )"); ("-dose-archive", Arg.Set_string dose_archive, "Set DOSE archive name"); ("-dose-type", Arg.Set_string dose_type, "Override DOSE archive type (determined automatically by default)"); ("-v", Arg.Set verbose, "Verbose output to stderr for debugging purposes"); ("-verbose", Arg.Set verbose, "Verbose output to stderr for debugging purposes"); ("-ignore-unknown-fields", Arg.Set ignore_unknown_fields, "Do not emit warnings on unknown fields in package metadata"); ("-generate-explicit-conflicts", Arg.Set explicit_conflicts, "Generate explicit conflicts between different versions of same package"); ("-ignore-file-deps", Arg.Set_string ignore_file_deps, "Ignore file dependencies from this file"); ];; (** Fill the global references with command line options *) let parse_options: unit = begin Arg.parse options_spec add_input_file "Ceve version 1.4" end;; ceve-1.4/options.mli000066400000000000000000000035441123137777100145150ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) type input_types = Debian | DebianCache | RPM | HDList | SynHDList | Pkgsrc | EGraphIn type output_types = PrettyPrint | EGraphOut | (* RPMFind | *) Dose | Oz | Graphviz | TartCNF | TartSize | DimacsCNF type version_types = Unspecified | DebianVersions | RPMVersions | DeweyVersions type db_types = MySQL type db_info_type = { db_type: db_types; db_hostname: string; db_name: string; db_port: int; db_user: string; db_password: string } type dep_types = Conflicts | Depends | Enhances | PreDepends | Recommends | Replaces | Suggests val output_channel: out_channel ref val output_dir: string ref val input_type: input_types ref val input_files: string list ref val version_type: version_types ref val output_type: output_types ref val resolve_dependencies: bool ref val database_info: db_info_type ref val create_tables: bool ref val verbose: bool ref val cone_package: (string * string) option ref val cone_types: dep_types list ref val cone_stops: (string * string) list ref val dose_date: (int * int * int) ref val dose_archive: string ref val dose_type: string ref val parse_options: unit val ignore_unknown_fields: bool ref val explicit_conflicts: bool ref val ignore_file_deps: string ref ceve-1.4/oz_writer.ml000066400000000000000000000130321123137777100146660ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Napkin type pkg_dep_list = (string, string, string) versioned list list * (string, string, string) versioned list * (string, string, string) versioned list;; type pkg_hashtable = (string, (string * pkg_dep_list option) list) Hashtbl.t;; let create_pkg_hashtable (pkgs: default_package list): pkg_hashtable = let result = Hashtbl.create (List.length pkgs) in begin List.iter (fun pkg -> let pkg_versions = try Hashtbl.find result pkg.pk_unit with Not_found -> [] in Hashtbl.replace result pkg.pk_unit ((pkg.pk_version, Some (pkg.pk_depends, pkg.pk_conflicts, pkg.pk_provides))::pkg_versions); List.iter (fun disj -> List.iter (fun d -> match d with | Unit_version (target, spec) -> let vl = try Hashtbl.find result target with Not_found -> [] in let v = Dependencies.version_of spec in if v <> "" then Hashtbl.replace result target ((v, None)::vl) | Glob_pattern _ -> raise (Failure "ARGH VII") ) disj ) pkg.pk_depends; List.iter (fun d -> match d with | Unit_version (target, spec) -> let vl = try Hashtbl.find result target with Not_found -> [] in let v = Dependencies.version_of spec in if v <> "" then Hashtbl.replace result target ((v, None)::vl) | Glob_pattern _ -> raise (Failure "ARGH VIII") ) pkg.pk_conflicts; List.iter (fun d -> match d with | Unit_version (target, spec) -> let vl = try Hashtbl.find result target with Not_found -> [] in let v = Dependencies.version_of spec in if v <> "" then Hashtbl.replace result target ((v, None)::vl) | Glob_pattern _ -> raise (Failure "ARGH IX") ) pkg.pk_provides; ) pkgs; Hashtbl.iter (fun name vs -> Hashtbl.replace result name (Tools.uniq (List.sort (fun (x1, y1) (x2, y2) -> Dependencies.compare_versions x1 x2) vs)) ) result; result end;; let index_of (v: 'a) (vl: 'a list): int = let count = ref 0 and result = ref (-1) in begin List.iter (fun x -> if x = v then result := !count else incr count) vl; if !result = (-1) then raise Not_found else !result end;; let oz_identifier_of (s: string): string = begin "'" ^ s ^ "'" end;; let output_package (oc: out_channel) (ht: pkg_hashtable) (pkg_name: string) (pkg_versions: (string * pkg_dep_list option) list): unit = let oz_of_dependency (dep: (string, string, string) versioned): string = match dep with | Glob_pattern _ -> raise (Failure "ARGH X") | Unit_version (target, spec) -> let versions = List.map fst (try Hashtbl.find ht target with Not_found -> []) in begin "'" ^ target ^ "'#" ^ (match spec with Sel_ANY -> "gt(0)" | Sel_LT x -> ("lt(" ^ (string_of_int ((index_of x versions) + 1)) ^ ")") | Sel_LEQ x -> ("le(" ^ (string_of_int ((index_of x versions) + 1)) ^ ")") | Sel_EQ x -> ("eq(" ^ (string_of_int ((index_of x versions) + 1)) ^ ")") | Sel_GEQ x -> ("ge(" ^ (string_of_int ((index_of x versions) + 1)) ^ ")") | Sel_GT x -> ("gt(" ^ (string_of_int ((index_of x versions) + 1)) ^ ")")) end and count = ref 1 in begin if pkg_versions <> [] then begin output_string oc (" " ^ (oz_identifier_of pkg_name) ^ ": versions(\n"); List.iter (fun (pkg_version, deps) -> match deps with None -> (* begin output_string oc (" " ^ (string_of_int !count) ^ ": 'dep-only'\n"); *) incr count (* end *) | Some (d, c, p) -> begin output_string oc (" " ^ (string_of_int !count) ^ ": relations(\n"); output_string oc " depends: "; output_string oc (if d = [] then "nil\n" else ("[ " ^ (String.concat " " (List.map (fun x -> if List.length x = 1 then oz_of_dependency (List.hd x) else "[ " ^ (String.concat " " (List.map oz_of_dependency x)) ^ " ]") (List.sort (fun x y -> compare (List.length x) (List.length y)) d))) ^ " ]\n")); output_string oc " conflicts: "; output_string oc (if c = [] then "nil\n" else ("[ " ^ (String.concat " " (List.map oz_of_dependency c)) ^ " ]\n")); output_string oc " provides: "; output_string oc (if p = [] then "nil\n" else ("[ " ^ (String.concat " " (List.map oz_of_dependency p)) ^ " ]\n")); output_string oc " )\n"; end; incr count ) pkg_versions; output_string oc " )\n" end end;; let output_version_mappings (oc: out_channel) (ht: pkg_hashtable): unit = begin output_string oc "% Version mappings\n"; output_string oc "% ----------------\n"; Hashtbl.iter (fun name versions -> let count = ref 0 in output_string oc ("% " ^ name ^ ": {" ^ (String.concat ", " (List.map (fun x -> incr count; (fst x) ^ "=" ^ (string_of_int !count)) versions)) ^ "}\n"); ) ht; output_string oc "\n" end;; let output_oz (pkgs: default_package list): unit = let ht = create_pkg_hashtable pkgs in begin prerr_endline "[Oz] Outputting Oz file..."; output_version_mappings !Options.output_channel ht; output_string !Options.output_channel "Packages = packages(\n"; Hashtbl.iter (fun name versions -> output_package !Options.output_channel ht name versions ) ht; output_string !Options.output_channel ")\n" end;; ceve-1.4/oz_writer.mli000066400000000000000000000013431123137777100150410ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val output_oz: Napkin.default_package list -> unit ceve-1.4/pretty_print.ml000066400000000000000000000050251123137777100154100ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Pretty print module @author Jaap Boender *) open Napkin let out_string = output_string !Options.output_channel let pretty_print_dep_expression (dep_expr: (string, string, string) versioned list list): unit = begin out_string (String.concat ", " (List.map (fun disj -> String.concat " | " (List.map string_of_versioned disj)) dep_expr) ^ "\n") end;; let pretty_print_package (pkg: default_package): unit = begin out_string ("Package: " ^ pkg.pk_unit ^ " (" ^ pkg.pk_version ^ ")\n"); out_string ("Architecture: " ^ pkg.pk_architecture ^ "\n"); out_string ("Depends: "); pretty_print_dep_expression pkg.pk_depends; out_string ("Recommends: "); pretty_print_dep_expression pkg.pk_recommends; out_string ("Pre-Depends: "); pretty_print_dep_expression pkg.pk_pre_depends; out_string ("Suggests: "); pretty_print_dep_expression pkg.pk_suggests; out_string ("Conflicts: " ^ (String.concat ", " (List.map string_of_versioned pkg.pk_conflicts)) ^ "\n"); out_string ("Replaces: " ^ (String.concat ", " (List.map string_of_versioned pkg.pk_replaces)) ^ "\n"); out_string ("Provides: " ^ (String.concat ", " (List.map string_of_versioned pkg.pk_provides)) ^ "\n"); out_string ("Size: " ^ (Int64.to_string pkg.pk_size) ^ "\n"); out_string ("Installed-Size: " ^ (Int64.to_string pkg.pk_installed_size) ^ "\n"); (* out_string ("Files: " ^ (String.concat ", " (List.map (fun (f, s) -> f ^ " (" ^ s ^ ")") pkg.files)) ^ "\n"); *) flush !Options.output_channel end;; let pretty_print (pkgs: default_package list): unit = begin prerr_endline ("[PP] Pretty printing package metadata (" ^ (string_of_int (List.length pkgs)) ^ " packages)..."); List.iter pretty_print_package pkgs end;; let print_sizes (pkgs: default_package list): unit = begin List.iter (fun pkg -> out_string (Printf.sprintf "%s'%s@%s %Ld\n" pkg.pk_unit pkg.pk_version pkg.pk_architecture pkg.pk_size) ) pkgs end ceve-1.4/pretty_print.mli000066400000000000000000000014341123137777100155610ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val pretty_print: Napkin.default_package list -> unit val print_sizes: Napkin.default_package list -> unit ceve-1.4/rpmfind_writer.ml000066400000000000000000000120571123137777100157030ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Sql let create_tables (rpmfind_db: db_connection): unit = begin ignore (execute_query rpmfind_db "CREATE TABLE IF NOT EXISTS Packages ( \ ID INT(11) NOT NULL AUTO_INCREMENT,\ filename VARCHAR(255) NOT NULL,\ Name VARCHAR(255) NOT NULL,\ Version VARCHAR(50) NOT NULL, \ `Release` VARCHAR(50) NOT NULL, \ Arch VARCHAR(15) NOT NULL, \ Dist INT(11), \ URL VARCHAR(255), \ URLSrc VARCHAR(255), \ Vendor INT(11), \ Packager INT(11), \ Category VARCHAR(255), \ Summary VARCHAR(255), \ Description TEXT, \ Copyright VARCHAR(255), \ Date INT(11), \ Size INT(11), \ Os VARCHAR(12), \ PRIMARY KEY (ID), \ KEY filename (filename(80)), \ KEY Name (Name(15)) \ )"); ignore (execute_query rpmfind_db "CREATE TABLE IF NOT EXISTS Vendors ( \ ID int(11) NOT NULL auto_increment, \ Name VARCHAR(255) NOT NULL, \ URL VARCHAR(255), \ Key1 TEXT, \ Key2 TEXT, \ Key3 TEXT, \ Description TEXT, \ PRIMARY KEY (ID), \ KEY Name (Name(10)) \ )"); ignore (execute_query rpmfind_db "CREATE TABLE IF NOT EXISTS Distributions ( \ ID int(11) NOT NULL auto_increment, \ Name varchar(255) NOT NULL, \ URL varchar(255), \ Key1 text, \ Key2 text, \ Key3 text, \ Description text, \ PRIMARY KEY (ID), \ KEY Name (Name(10)) \ )") end;; let add_packages (rpmfind_db: db_connection) (pkgs: pkg_metadata list): unit = let package_add = prepare_statement rpmfind_db "INSERT INTO Packages (filename, Name, Version, `Release`, Arch, URL, URLSrc, Vendor, Packager, Category, Summary, Description, Copyright, Size, Os) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" and vendor_find = prepare_statement rpmfind_db "SELECT ID FROM Vendors WHERE Name = ?" and vendor_add = prepare_statement rpmfind_db "INSERT INTO Vendors (Name) VALUES (?)" and distribution_find = prepare_statement rpmfind_db "SELECT ID FROM Distributions WHERE Name = ?" and distribution_add = prepare_statement rpmfind_db "INSERT INTO Distributions (Name) VALUES (?)" in let get_vendor_id (vendor: string): int = begin execute_statement vendor_find [| DBString (255, vendor) |]; if !Options.verbose then begin prerr_endline ("[MySQL] fetching vendor for '" ^ vendor ^ "'...") end; let res = fetch_statement vendor_find in try match (List.hd res).(0) with DBInt x -> x | _ -> 73 with Failure _ -> execute_statement vendor_add [| DBString (255, vendor) |]; Int64.to_int (statement_insert_id vendor_add) end in let get_distribution_id (distribution: string): int = begin execute_statement distribution_find [| DBString (255, distribution) |]; if !Options.verbose then begin prerr_endline ("[MySQL] fetching distribution for '" ^ distribution ^ "'...") end; let res = fetch_statement distribution_find in try match (List.hd res).(0) with DBInt x -> x | _ -> 73 with Failure _ -> execute_statement distribution_add [| DBString (255, distribution) |]; Int64.to_int (statement_insert_id distribution_add) end in begin List.iter (fun pkg -> if !Options.verbose then begin prerr_endline ("[MySQL] Package: " ^ pkg.name ^ ", v" ^ pkg.version) end; let dash_index = String.rindex pkg.version '-' in let pkg_version = String.sub pkg.version 0 dash_index and pkg_release = String.sub pkg.version (dash_index + 1) ((String.length pkg.version) - dash_index - 1) and packager_id = get_vendor_id pkg.maintainer and vendor_id = get_distribution_id pkg.distribution in execute_statement package_add [| (* filename *) DBString (255, pkg.filename); (* Name *) DBString (255, pkg.name); (* Version *) DBString (50, pkg_version); (* Release *) DBString (50, pkg_release); (* Arch *) DBString (15, match pkg.architecture with Specific s -> s | _ -> "any"); (* URL *) DBString (255, pkg.url); (* URLSrc *) DBString (255, pkg.source_package); (* Vendor *) DBInt vendor_id; (* Packager *) DBInt packager_id; (* Category *) DBString (255, pkg.section); (* Summary *) DBString (255, pkg.summary); (* Description *) DBText pkg.description; (* Copyright *) DBString (255, pkg.license); (* Size *) DBInt (Int32.to_int pkg.installed_size); (* OS *) DBString (12, pkg.os) |] ) pkgs end let output_rpmfind (pkgs: pkg_metadata list): unit = begin prerr_endline "[RPMFind] Writing rpmfind data..."; let rpmfind_db = open_database () in begin if !Options.create_tables then create_tables rpmfind_db; add_packages rpmfind_db pkgs end end ceve-1.4/rpmfind_writer.mli000066400000000000000000000013551123137777100160530ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Metadata val output_rpmfind: pkg_metadata list -> unit ceve-1.4/sql.ml000066400000000000000000000055021123137777100134440ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** SQL wrapper module @author Jaap Boender *) open Options open Mysql type db_connection = MySQLConnection of dbd type db_result = MySQLResult of result type db_statement = MySQLStatement of stmt type db_parameter = DBString of int * string | DBInt of int | DBText of string let open_database (x: unit): db_connection = let db = { dbhost = if !database_info.db_hostname = "" then None else Some !database_info.db_hostname; dbname = Some !database_info.db_name; dbport = Some !database_info.db_port; dbpwd = if !database_info.db_password = "" then None else Some !database_info.db_password; dbuser = if !database_info.db_user = "" then None else Some !database_info.db_user } in begin prerr_endline ("[SQL] Opening database " ^ (!database_info.db_name) ^ " on host " ^ (!database_info.db_hostname) ^ " for user " ^ (!database_info.db_user) ^ "..."); MySQLConnection (connect db) end;; let to_mysql_bindings (bindings: db_parameter array): stmt_parameter array = begin Array.map (fun b -> match b with DBString (l, s) -> MySQLString (l, s) | DBInt i -> MySQLInt i | DBText t -> MySQLText t ) bindings end;; let from_mysql_bindings (bindings: stmt_parameter array): db_parameter array = begin Array.map (fun b -> match b with MySQLString (l, s) -> DBString (l, s) | MySQLInt i -> DBInt i | MySQLText t -> DBText t ) bindings end;; let execute_query (conn: db_connection) (query: string): db_result = begin match conn with MySQLConnection mc -> MySQLResult (exec mc query) end;; let prepare_statement (conn: db_connection) (query: string): db_statement = begin match conn with MySQLConnection mc -> MySQLStatement (prepare_statement mc query) end;; let execute_statement (stmt: db_statement) (bindings: db_parameter array): unit = begin match stmt with MySQLStatement s -> Mysql.execute_statement s (to_mysql_bindings bindings) end;; let fetch_statement (stmt: db_statement): db_parameter array list = begin match stmt with MySQLStatement s -> List.map from_mysql_bindings (Mysql.fetch_statement s) end;; let statement_insert_id (stmt: db_statement): int64 = begin match stmt with MySQLStatement s -> Mysql.statement_insert_id s end;; ceve-1.4/sql.mli000066400000000000000000000023471123137777100136210ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) open Options open Mysql type db_connection = MySQLConnection of dbd type db_result = MySQLResult of result type db_statement = MySQLStatement of stmt type db_parameter = DBString of int * string | DBInt of int | DBText of string val open_database: unit -> db_connection val execute_query: db_connection -> string -> db_result val prepare_statement: db_connection -> string -> db_statement val execute_statement: db_statement -> db_parameter array -> unit val fetch_statement: db_statement -> db_parameter array list val statement_insert_id: db_statement -> int64 ceve-1.4/tools.ml000066400000000000000000000032621123137777100140060ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (** Module with functions of general interest @author Jaap Boender *) (** Truncate a string (remove spaces and nulls from either end) @param s The string to truncate @return The truncated string *) let rec truncate (s: string): string = begin if s.[0] = ' ' || s.[0] = (Char.chr 0) then truncate (String.sub s 1 (String.length s - 1)) else if s.[String.length s - 1] = ' ' || s.[String.length s - 1] = (Char.chr 0) then truncate (String.sub s 0 (String.length s - 1)) else s end;; let rec fixpoint (start: 'a) (f: 'a -> 'a): 'a = let result = f start in begin if result = start then result else fixpoint result f end;; let starts_with (needle: string) (haystack: string): bool = begin if String.length haystack < String.length needle then false else String.sub haystack 0 (String.length needle) = needle end;; let rec uniq (x: 'a list): 'a list = begin match x with [] -> [] | y::ys -> begin match ys with [] -> [y] | z::zs -> if y = z then uniq ys else y::(uniq ys) end end;; ceve-1.4/tools.mli000066400000000000000000000014731123137777100141610ustar00rootroot00000000000000(* This file is part of Ceve. Ceve is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Ceve 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 Ceve; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) val truncate: string -> string val fixpoint: 'a -> ('a -> 'a) -> 'a val starts_with: string -> string -> bool val uniq: 'a list -> 'a list