pax_global_header 0000666 0000000 0000000 00000000064 13064235433 0014515 g ustar 00root root 0000000 0000000 52 comment=915184fff3534ea35ee2d902ff7472527f9231a4
cudf-0.9/ 0000775 0000000 0000000 00000000000 13064235433 0012306 5 ustar 00root root 0000000 0000000 cudf-0.9/.gitignore 0000664 0000000 0000000 00000000077 13064235433 0014302 0 ustar 00root root 0000000 0000000 _build/
*.byte
*.native
cudf_822_parser.ml
cudf_822_parser.mli
cudf-0.9/.headache.conf 0000664 0000000 0000000 00000000160 13064235433 0014752 0 ustar 00root root 0000000 0000000 ".*\\.ml[il]?" -> frame open:"(*" line:"*" close:"*)"
| ".*\\.mly" -> frame open:"/*" line:"*" close:"*/"
cudf-0.9/.ocamlinit-cudf 0000664 0000000 0000000 00000001000 13064235433 0015174 0 ustar 00root root 0000000 0000000 #use "topfind";;
#require "extlib";;
#require "oUnit";;
#load "_build/cudf.cma";;
#load "_build/tests.cmo";;
open ExtLib;;
open Cudf;;
open Cudf_checker;;
open Cudf_parser;;
open Cudf_printer;;
open Cudf_types_pp;;
let p = Cudf_parser.from_in_channel (open_in "tests/legacy.cudf")
let (pre, pkgs, req) as cudf_doc =
match Cudf_parser.parse_from_file "examples/legacy.cudf" with
| Some pre, pkgs, Some req -> pre, pkgs, req
| _ -> assert false ;;
let (univ, _) as cudf = Cudf.load_universe pkgs, req
cudf-0.9/BUGS 0000664 0000000 0000000 00000000140 13064235433 0012764 0 ustar 00root root 0000000 0000000 See issue tracker at:
https://gforge.inria.fr/tracker/?atid=13811&group_id=4385&func=browse
cudf-0.9/COPYING 0000664 0000000 0000000 00000021716 13064235433 0013350 0 ustar 00root root 0000000 0000000 This library is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
As a special exception to the GNU Lesser General Public License, you
may link, statically or dynamically, a "work that uses the Library"
with a publicly distributed version of the Library to produce an
executable file containing portions of the Library, and distribute
that executable file under terms of your choice, without any of the
additional requirements listed in clause 6 of the GNU Lesser General
Public License. By "a publicly distributed version of the Library",
we mean either the unmodified Library as distributed, or a modified
version of the Library that is distributed under the conditions
defined in clause 3 of the GNU Lesser General Public License. This
exception does not however invalidate any other reasons why the
executable file might be covered by the GNU Lesser General Public
License.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this program. If not, see
.
----------------------------------------------------------------------------
GNU LESSER GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
a) under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
b) under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
a) Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the object code with a copy of the GNU GPL and this license
document.
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the Combined Work with a copy of the GNU GPL and this license
document.
c) For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
d) Do one of the following:
0) Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
1) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
e) Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
5. Combined Libraries.
You may place library facilities that are a work based on the
Library side by side in a single library together with other library
facilities that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
a) Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
b) Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU Lesser General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the
Library as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.
cudf-0.9/ChangeLog 0000664 0000000 0000000 00000012125 13064235433 0014061 0 ustar 00root root 0000000 0000000 2017-03-21 Stefano Zacchiroli
* ALL release 0.9
* Build: remove spurious dependencies on no longer used camlp4
* Makefile: fix build issues on Windows
2015-03-31 Stefano Zacchiroli
* ALL release 0.8
* Cudf: performance improvement by allocating larger hashtbl
* Cudf: expose empty_universe
(Thanks to Pietro Abate for the above 2 patches)
* Makefile: inhibit parallel build (thanks to Roberto Di Cosmo)
* Cudf_parser: prevent in_channel leaks when using from_file
2014-04-29 Stefano Zacchiroli
* ALL release 0.7
* Cudf_checker: do not report as multi-upgrade error a package
providing itself
* Cudf refactoring: change name2pkgs and univ.features internal
structures to list ref from multi-binding hash table.
* Cudf: add iterators on packages grouped by name
* Cudf: allow add/remove imperative changes to universes
(Thanks Pietro Abate for the above 3 patches)
* test runner: port "make test" to ocamlbuild >= 4.x
* cudf-check: make exit code dependent on check result
* cudf-check: include a man page, available under doc/
2012-08-03 Stefano Zacchiroli
* ALL release 0.6.3
* Cudf: bugfix: ensure that Cudf.status sizes are non-bogus
* Cudf: new functions to lookup properties as typed values
lookup_typed_{package,request,preamble}_property
* Cudf: new functions to lookup type declarations
for both core and extra package properties
* Cudf_conf: offer direct access to per-stanza property schemata
* testsuite: add printers to better inspect test failures
* Cudf: refactoring, build raw property access on top of typed one
* Cudf_conf: refactoring, deduplicate "keep" property enums
2011-11-27 Stefano Zacchiroli
* ALL release 0.6.2
* ALL Cudf: add a new mapping between packages and unique integer
identifiers, useful to avoid external uid maps (patch by Pietro
Abate)
* ALL Cudf: who_provides is now more general and can query both
installed and available packages (patch by Pietro Abate)
* ALL Cudf_printer: expose generic higher order printers
2011-09-15 Stefano Zacchiroli
* ALL release 0.6.1
* ALL Cudf_parser: allow parsing of empty universes as well as
parsing of documents containing only a (possibly empty) request
2011-06-01 Stefano Zacchiroli
* ALL release 0.6
* ALL cudf-check: faster (~ 2x) -dump
* ALL Cudf_printer/Cudf_types_pp: speed improvement (~ 3.5x)
get rid of Format, output only on strings (_types_pp) or on
out_channel (_printer). [ API change ]
* ALL Cudf_printer: add IO.output based API
* ALL Cudf_types_pp: fix pretty printing of "enum[...]" type
* ALL Cudf_printer.pp_cudf: avoid extra blank line before request
* doc: clarify is_solution meaning wrt inconsistent universes
* c-lib: link caml_hash_variant with -ldl
2010-11-04 Stefano Zacchiroli
* ALL parser: add support for ExtLib IO channels
Thanks Pietro Abate for the patch. (Closes: #299)
* ALL add Cudf.mem_package (Closes: #307)
* ALL Development release 0.5.99
2010-06-25 Stefano Zacchiroli
* ALL bug fix: do not enforce Keep on uninstalled packages
Thanks Ralf Treinen for the patch! (Closes: #266)
* ALL bug fix: nicer error message for unknown packages found in
solution (Closes: #267)
* ALL bug fix: avoid pretty printing some malformed vpkgformulae
(Closes: #272)
* ALL bug fix: check for duplicate property in 822 stanzas
(Closes: #269)
* ALL bug fix: comments no longer split stanzas in two
(Closes: #250)
* ALL bug fix: perform string escape when pretty printing type
declarations (Closes: #271)
* ALL add several test cases to the test suite
* ALL Development release 0.5.98
2010-06-03 Stefano Zacchiroli
* ALL bug fix: optional/mandatory extra property management
* c-lib bug fix: add handling of vpkgformula extra properties
* ALL bug fix: allow empty vpkglist as default values
* ALL bug fix: do not accept trivial formulae as v(eq)pkglist
* ALL Development release 0.5.97
2010-06-01 Stefano Zacchiroli
* c-lib add structured accessors to request fields
(patch by Gustavo Gutierrez, thanks!)
* doc better explain the role of load_solution
* ALL simpler API for solutions: cudf_load_solution_from_file
* ALL bug fix: avoid losing ?typedecl in convenience functions
* c-lib add bindings for cudf_load_solution_from_file
* backward-compatibility enabling compilation with OCaml 3.10.2
* ALL bug fix: support heading '+' when parsing posint
* ALL Development release 0.5.96
2009-12-18 Stefano Zacchiroli
* c-lib Remove the need of OCaml devel stuff to use the C API
* c-lib Provide bindings to OCaml native code, if available
* c-lib Hide OCaml "value", it is way more safe (API change)
* c-lib O(n^2) -> O(n) speed-up in package list conversion
* ALL Development release 0.5.94
2009-11-25 Stefano Zacchiroli
* ALL Porting to CUDF 2.0
* ALL Development release 0.5.92
2009-02-24 Stefano Zacchiroli
* ALL First public release, version 0.4
cudf-0.9/INSTALL 0000664 0000000 0000000 00000002440 13064235433 0013337 0 ustar 00root root 0000000 0000000
To build
========
Build dependencies:
- ocaml >= 3.10.2 (Debian package: "ocaml-nox", RPM: "ocaml")
- findlib (Debian package: "ocaml-findlib", RPM: "ocaml-findlib")
- extlib (Debian package: "libextlib-ocaml-dev",
RPM: "ocaml-extlib-devel")
- oUnit (only needed to run the test suite
Debian package: "libounit-ocaml-dev",
RPM: "ocaml-ounit-devel")
- glib (only needed to build the C bindings
Debian package: "libglib2.0-dev",
RPM: "libglib2.0-devel")
- perl (for pod2man, to build cudf-check.1 man page)
To build run:
$ make all # build bytecode libs and executables
$ make opt # build native code libs and executables (if you have ocamlopt)
$ make test # run the test suite (need oUnit)
C bindings
----------
To build the C bindings to the OCaml library run:
$ make -C c-lib # build C bindings (to OCaml bytecode)
$ make -C c-lib-opt # build C bindings (to OCaml native code)
$ make -C c-lib test # run the test suite for C bindings
To install
==========
To install run, after compilation:
# make install # install libs and executables
To install under a non-standard location, say "/my/dest/dir":
$ make install DESTDIR=/my/dest/dir
To uninstall
============
# make uninstall
or:
$ make uninstall DESTDIR=/my/dest/dir
cudf-0.9/META 0000664 0000000 0000000 00000000202 13064235433 0012751 0 ustar 00root root 0000000 0000000 description = "CUDF library"
version = "placeholder"
archive(byte) = "cudf.cma"
archive(native) = "cudf.cmxa"
requires = "extlib"
cudf-0.9/Makefile 0000664 0000000 0000000 00000007377 13064235433 0013764 0 ustar 00root root 0000000 0000000 include Makefile.config
NAME = cudf
ifeq ("$(shell (ocamlc -config 2>/dev/null || ocamlopt -config) | fgrep os_type)","os_type: Win32")
EXE=.exe
OCAMLLIBDIR := $(shell cygpath $(OCAMLLIBDIR))
else
EXE=
endif
LIBS = _build/cudf.cma
LIBS_OPT = _build/cudf.cmxa
PROGS = _build/main_cudf_check _build/main_cudf_parse_822
PROGS_BYTE = $(addsuffix .byte,$(PROGS))
PROGS_OPT = $(addsuffix .native,$(PROGS))
DOC = doc/cudf-check.1
RESULTS = $(DOC) $(LIBS) $(PROGS_BYTE) _build/cudf_c.cmo
RESULTS_OPT = $(DOC) $(LIBS_OPT) $(PROGS_OPT) _build/cudf_c.cmx
SOURCES = $(wildcard *.ml *.mli *.mll *.mly)
C_LIB_DIR = c-lib
C_LIB_SOURCES = $(wildcard $(C_LIB_DIR)/*.c $(C_LIB_DIR)/*.h)
OCAMLBUILD = ocamlbuild
OBFLAGS =
OCAMLFIND = ocamlfind
ifeq ($(DESTDIR),)
INSTALL = $(OCAMLFIND) install
UNINSTALL = $(OCAMLFIND) remove
else
DESTDIR:=$(DESTDIR)/
INSTALL = $(OCAMLFIND) install -destdir $(DESTDIR)$(OCAMLLIBDIR)
UNINSTALL = $(OCAMLFIND) remove -destdir $(DESTDIR)$(OCAMLLIBDIR)
endif
DIST_DIR = $(NAME)-$(VERSION)
DIST_TARBALL = $(DIST_DIR).tar.gz
all: $(RESULTS)
opt: $(RESULTS_OPT)
$(RESULTS): $(SOURCES)
$(RESULTS_OPT): $(SOURCES)
doc/cudf-check.1: doc/cudf-check.pod
$(MAKE) -C doc/
.PHONY: c-lib c-lib-opt doc
c-lib:
make -C $(C_LIB_DIR) all
c-lib-opt:
make -C $(C_LIB_DIR) opt
clean:
make -C $(C_LIB_DIR) clean
make -C doc/ clean
$(OCAMLBUILD) $(OBFLAGS) -clean
rm -rf $(NAME)-*.gz $(NAME)_*.gz $(NAME)-*/
_build/%:
$(OCAMLBUILD) $(OBFLAGS) $*
@touch $@
# top-level: _build/cudf.cma _build/tests.cmo
top-level: _build/cudf.cma
ledit ocaml -I ./_build/ -init ./.ocamlinit-cudf
headers: header.txt .headache.conf
headache -h header.txt -c .headache.conf $(SOURCES) $(C_LIB_SOURCES)
test: test.byte
./$< -verbose
@echo
c-lib-test:
make -C $(C_LIB_DIR) test
test.byte: $(SOURCES)
ocamlbuild $@
tags: TAGS
TAGS: $(SOURCES)
otags $^
INSTALL_STUFF = META
INSTALL_STUFF += $(wildcard _build/*.cma _build/*.cmxa _build/cudf.a)
INSTALL_STUFF += $(wildcard _build/cudf_*.cmi) $(wildcard _build/*.mli)
INSTALL_STUFF += $(wildcard _build/cudf_*.cmx _build/cudf_*.o _build/cudf_*.a)
INSTALL_STUFF += $(wildcard _build/cudf.o _build/cudf.cmx _build/cudf.cmi)
install:
test -d $(DESTDIR)$(OCAMLLIBDIR) || mkdir -p $(DESTDIR)$(OCAMLLIBDIR)
$(INSTALL) -patch-version $(VERSION) $(NAME) $(INSTALL_STUFF)
test -d $(DESTDIR)$(BINDIR) || mkdir -p $(DESTDIR)$(BINDIR)
for p in $(notdir $(PROGS)) ; do \
tgt=`echo $$p | sed -e 's/^main.//' -e 's/_/-/g'`$(EXE) ; \
if [ -f _build/$$p.native ] ; then \
cp _build/$$p.native $(DESTDIR)$(BINDIR)/$$tgt ; \
else \
cp _build/$$p.byte $(DESTDIR)$(BINDIR)/$$tgt ; \
fi ; \
echo "Installed $(DESTDIR)$(BINDIR)/$$tgt" ; \
done
if [ -f $(C_LIB_DIR)/cudf.o ] ; then \
$(MAKE) -C c-lib/ -e install ; \
fi
uninstall:
$(UNINSTALL) $(NAME)
for p in $(notdir $(PROGS)) ; do \
tgt=`echo $$p | sed -e 's/^main.//' -e 's/_/-/g'`$(EXE) ; \
if [ -f $(DESTDIR)$(BINDIR)/$$tgt ] ; then \
rm $(DESTDIR)$(BINDIR)/$$tgt ; \
fi ; \
echo "Removed $(DESTDIR)$(BINDIR)/$$tgt" ; \
done
-rmdir -p $(DESTDIR)$(OCAMLLIBDIR) $(DESTDIR)$(BINDIR)
dist: ./$(DIST_TARBALL)
./$(DIST_TARBALL):
git archive --format=tar --prefix=$(DIST_DIR)/ HEAD | gzip > $@
@echo "Distribution tarball: ./$(DIST_TARBALL)"
rpm: ./$(DIST_TARBALL)
rpmbuild --nodeps -ta $<
distcheck: ./$(DIST_TARBALL)
tar xzf $<
$(MAKE) -C ./$(DIST_DIR) all
if which ocamlopt > /dev/null ; then $(MAKE) -C ./$(DIST_DIR) opt ; fi
$(MAKE) -C ./$(DIST_DIR) test
$(MAKE) -C ./$(DIST_DIR)/$(C_LIB_DIR)/ all
$(MAKE) -C ./$(DIST_DIR) install DESTDIR=$(CURDIR)/$(DIST_DIR)/tmp
rm -rf ./$(DIST_DIR)
doc:
$(OCAMLBUILD) $(OBFLAGS) cudf.docdir/index.html
world: all opt c-lib c-lib-opt doc
.PHONY: all opt world clean top-level headers test tags install uninstall
.PHONY: dep rpm c-lib c-lib-opt dist doc
.NOTPARALLEL:
cudf-0.9/Makefile.config 0000664 0000000 0000000 00000000417 13064235433 0015214 0 ustar 00root root 0000000 0000000 VERSION = 0.9
export DESTDIR =
# all the following variables will be prepended by $(DESTDIR) upon install
export OCAMLLIBDIR := $(shell ocamlc -where)
export BINDIR = /usr/bin
export LIBDIR = /usr/lib
export INCDIR = /usr/include
export PCDIR = $(LIBDIR)/pkgconfig
cudf-0.9/README 0000664 0000000 0000000 00000004144 13064235433 0013171 0 ustar 00root root 0000000 0000000 libCUDF - CUDF (Common Upgradeability Description Format) library
=================================================================
libCUDF is a library to manipulate so called CUDF documents. A CUDF
(Common Upgradeability Description Format) document describes an
"upgrade scenario", as faced by package managers in popular
package-based FOSS (Free and Open Source Software) distributions.
A CUDF document consists of an optional leading "preamble", a "package
universe", and a trailing "user request":
- The package universe describes all packages known to the package
manager, a subset of which (the "package status") denotes the
package being currently installed on a given machine.
- The user request denotes a change to the package status requested by
the user, e.g.: "install package foo", "remove package bar", ...
- The preamble contains meta-information such as a typing information
for custom package properties, checksums, document unique
identifiers, ...
A CUDF document is naturally complemented by a "solution" describing
the resulting package status (if any) that satisfies the user request,
as found by a package manager.
libCUDF enables manipulation of CUDF and related documents.
Development
-----------
Development happens on the INRIA Forge, in the [cudf project][1]. There you can
find:
* [releases][4]
* [Git repository][5]
* [bug reports][6]
[1]: https://gforge.inria.fr/projects/cudf/
[4]: https://gforge.inria.fr/frs/?group_id=4385
[5]: https://gforge.inria.fr/scm/?group_id=4385
[6]: https://gforge.inria.fr/tracker/?group_id=4385
Please report bugs using the forge [bug tracker][6] rather than mailing me
directly.
If you're in a hurry and just want to get the latest version of the code, here
is the command you're looking for:
$ git clone https://gforge.inria.fr/git/cudf/cudf.git
Reference
---------
libCUDF implements the Common Upgradeability Description Format (CUDF)
2.0 [specifications][2], edited by the [Mancoosi project][3].
[2]: http://www.mancoosi.org/reports/tr3.pdf
[3]: http://www.mancoosi.org
-- Stefano Zacchiroli Sun, 14 Oct 2012 16:28:32 +0100
cudf-0.9/TODO 0000664 0000000 0000000 00000000140 13064235433 0012771 0 ustar 00root root 0000000 0000000 See issue tracker at:
https://gforge.inria.fr/tracker/?atid=13811&group_id=4385&func=browse
cudf-0.9/_tags 0000664 0000000 0000000 00000000306 13064235433 0013325 0 ustar 00root root 0000000 0000000 or : pkg_oUnit
or : pkg_oUnit
<*.ml> or <*.mli> : pkg_extlib
<*.byte> or <*.native> : pkg_extlib
: not_hygienic
: not_hygienic
cudf-0.9/c-lib/ 0000775 0000000 0000000 00000000000 13064235433 0013274 5 ustar 00root root 0000000 0000000 cudf-0.9/c-lib/.gitignore 0000664 0000000 0000000 00000000074 13064235433 0015265 0 ustar 00root root 0000000 0000000 *.a
*.o
c-test
c-test-opt
caml_hash_variant
cudf-variants.h
cudf-0.9/c-lib/Makefile 0000664 0000000 0000000 00000004563 13064235433 0014744 0 ustar 00root root 0000000 0000000 include ../Makefile.config
all: libcudf.a c-test
opt: libcudf-opt.a c-test-opt
include Makefile.variants
ifneq ($(DESTDIR),)
DESTDIR:=$(DESTDIR)/
endif
NULL =
CFLAGS = -Wall -DG_LOG_DOMAIN=\"libCUDF\"
PROG_CFLAGS = -Wall
OCAML_LIBDIR := $(shell ocamlc -where)
INCLUDES = -I . -I $(OCAML_LIBDIR) $(shell pkg-config --cflags glib-2.0)
CUDF_LDFLAGS = -L$(OCAML_LIBDIR) -L$(CURDIR)
CUDF_CLIBS = -lcudf -lm -ldl -lunix -lncurses -lglib-2.0
OCAMLC = ocamlfind ocamlc -package unix,extlib
OCAMLOPT = ocamlfind ocamlopt -package unix,extlib
INSTALL_STUFF = libcudf.a cudf.h cudf.pc
libcudf.a: cudf-caml.o cudf.o
cp $(OCAML_LIBDIR)/libcamlrun.a $@
ar r $@ $^
libcudf-opt.a: cudf-caml-opt.o cudf.o
cp $(OCAML_LIBDIR)/libasmrun.a $@
ar r $@ $^
../_build/%:
cd .. && ocamlbuild $*
cudf-caml.o: ../_build/cudf.cma ../_build/cudf_c.cmo
$(OCAMLC) -linkpkg -output-obj -o $@ $^
cudf-caml-opt.o: ../_build/cudf.cmxa ../_build/cudf_c.cmx
$(OCAMLOPT) -linkpkg -output-obj -o $@ $^
cudf.o: cudf.c cudf.h cudf-variants.h
c-test.o: c-test.c cudf.o
$(CC) $(PROG_CFLAGS) $(INCLUDES) -c $<
c-test: c-test.o libcudf.a
$(CC) $(PROG_CFLAGS) -o $@ $(INCLUDES) $(CUDF_LDFLAGS) $< $(CUDF_CLIBS)
c-test-opt: c-test.o libcudf-opt.a
$(CC) $(PROG_CFLAGS) -o $@ $(INCLUDES) $(CUDF_LDFLAGS) $< \
$(subst -lcudf,-lcudf-opt,$(CUDF_CLIBS))
test: ../tests/legacy.cudf ../tests/legacy-sol.cudf c-test
./c-test ../tests/legacy.cudf ../tests/legacy-sol.cudf > /dev/null
cudf.pc: cudf.pc.in
cat $< | sed -e "s,@OCAMLLIBDIR@,$(OCAMLLIBDIR),g" \
-e "s,@VERSION@,$(VERSION),g" \
-e "s,@LIBDIR@,$(LIBDIR),g" \
-e "s,@INCDIR@,$(INCDIR),g" \
> $@
%.o: %.c
$(CC) $(CFLAGS) $(INCLUDES) -c $<
clean:
rm -f *.a *.o *.cmo *.cmi
rm -f c-test c-test-opt
rm -f cudf.pc
install: cudf.pc
test -d $(DESTDIR)$(LIBDIR) || mkdir -p $(DESTDIR)$(LIBDIR)
test -d $(DESTDIR)$(INCDIR) || mkdir -p $(DESTDIR)$(INCDIR)
test -d $(DESTDIR)$(PCDIR) || mkdir -p $(DESTDIR)$(PCDIR)
if [ -f libcudf-opt.a ] ; then \
cp libcudf-opt.a $(DESTDIR)$(LIBDIR)/libcudf.a ; \
else \
cp libcudf.a $(DESTDIR)$(LIBDIR)/libcudf.a ; \
fi
cp libcudf.a $(DESTDIR)$(LIBDIR)
cp cudf.h $(DESTDIR)$(INCDIR)
cp cudf.pc $(DESTDIR)$(PCDIR)
uninstall:
rm $(DESTDIR)$(LIBDIR)/libcudf.a
rm $(DESTDIR)$(INCDIR)/cudf.h
rm $(DESTDIR)$(PCDIR)/cudf.pc
-rmdir -p $(DESTDIR)$(LIBDIR) $(DESTDIR)$(INCDIR) $(DESTDIR)$(PCDIR)
.PHONY: all opt clean test install uninstall
cudf-0.9/c-lib/Makefile.variants 0000664 0000000 0000000 00000002556 13064235433 0016572 0 ustar 00root root 0000000 0000000 # OCaml (polymorphic) variants used by the bindings
# Will be used to generate cudf-variants.h
ML_VARIANTS = \
$(ML_RELOP_VARIANTS) \
$(ML_TYPE_VARIANTS) \
$(ML_KEEP_VARIANTS) \
$(ML_ITEM_VARIANTS) \
$(NULL)
ML_RELOP_VARIANTS = \
Eq \
Neq \
Geq \
Gt \
Leq \
Lt \
$(NULL)
ML_TYPE_VARIANTS = \
Int \
Posint \
Nat \
Bool \
String \
Enum \
Pkgname \
Ident \
Vpkg \
Vpkgformula \
Vpkglist \
Veqpkg \
Veqpkglist \
Typedecl \
$(NULL)
ML_KEEP_VARIANTS = \
Keep_version \
Keep_package \
Keep_feature \
Keep_none \
$(NULL)
ML_ITEM_VARIANTS = \
Preamble \
Package \
Request \
$(NULL)
cudf.o: cudf-variants.h
cudf-variants.h: caml_hash_variant Makefile.variants
@echo "/* THIS FILE IS GENERATED, DO NOT EDIT */" > $@
@echo "/* See Makefile.variants for generation logics */" >> $@
@echo >> $@
@echo "#ifndef _CUDF_VARIANTS_H" >> $@
@echo "#define _CUDF_VARIANTS_H" >> $@
@echo >> $@
@(for variant in $(ML_VARIANTS) ; do \
./$< $$variant ; \
done) >> $@
@echo >> $@
@echo "#endif\t/* end of cudf-variants.h */" >> $@
@echo >> $@
caml_hash_variant: caml_hash_variant.o
> dummy.ml
ocamlc -o dummy.o -output-obj dummy.ml
$(CC) $(CFLAGS) -o $@ $< dummy.o -L$(OCAML_LIBDIR) -lcamlrun -lm -lcurses -ldl
@rm -f dummy.*
clean: clean-variants
clean-variants:
rm -f caml_hash_variant cudf-variants.h
rm -f dummy.*
.PHONY: clean-variants
cudf-0.9/c-lib/c-test.c 0000664 0000000 0000000 00000016673 13064235433 0014654 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
/* Compile with:
cc -o c-test c-test.c `pkg-config --cflags cudf` `pkg-config --libs cudf`
*/
#include
#include
#include
#include
/* Print to stdout a relational operator (on versions) */
void print_relop(int relop) {
switch (relop) {
case RELOP_EQ : printf("=") ; break ;
case RELOP_NEQ : printf("!=") ; break ;
case RELOP_GEQ : printf(">=") ; break ;
case RELOP_GT : printf(">") ; break ;
case RELOP_LEQ : printf("<=") ; break ;
case RELOP_LT : printf("<") ; break ;
case RELOP_NOP :
default :
g_error("Unexpected integer, which is not a RELOP_*: %d",
relop);
}
}
/* Print to stdout a package version predicate */
void print_vpkg(cudf_vpkg_t *vpkg) {
if (vpkg == NULL)
return;
printf("%s", vpkg->name);
if (vpkg->relop) {
printf(" ");
print_relop(vpkg->relop);
printf(" %d", vpkg->version);
}
}
/* Print to stdout a list of package predicates, separated by a given
separator */
void print_vpkglist(cudf_vpkglist_t l, const char *sep) {
cudf_vpkg_t *vpkg;
GList *last;
last = g_list_last(l);
while (l != NULL) {
vpkg = g_list_nth_data(l, 0);
print_vpkg(vpkg);
if (l != last)
printf(sep);
l = g_list_next(l);
}
}
/* Print to stdout a package formula */
void print_vpkgformula(cudf_vpkgformula_t fmla) {
GList *last;
last = g_list_last(fmla);
while (fmla != NULL) {
print_vpkglist(g_list_nth_data(fmla, 0), " | ");
if (fmla != last)
printf(", ");
fmla = g_list_next(fmla);
}
}
/* Print to stdout a CUDF preamble */
void print_preamble(cudf_doc_t *doc) {
char *s;
char *props[] = { "preamble", "property", "univ-checksum",
"status-checksum", "req-checksum" };
int i;
if (! doc->has_preamble)
return;
for (i=0 ; i<5 ; i++) {
s = cudf_pre_property(doc->preamble, props[i]);
printf(" %s: %s\n", props[i], s);
free(s);
}
}
/* Print to stdout a CUDF request */
void print_request(cudf_doc_t *doc) {
char *s;
if (! doc->has_request)
return;
s = cudf_req_property(doc->request, "request");
printf(" request: %s\n", s);
free(s);
printf(" install: ");
print_vpkglist(cudf_req_install(doc->request), ", ");
printf("\n");
printf(" upgrade: ");
print_vpkglist(cudf_req_upgrade(doc->request), ", ");
printf("\n");
printf(" remove: ");
print_vpkglist(cudf_req_remove(doc->request), ", ");
printf("\n");
}
/* Print to stdout a possible value of the "keep" package property */
void print_keep(int keep) {
switch (keep) {
case KEEP_NONE : printf(" keep: version\n"); break;
case KEEP_VERSION : printf(" keep: version\n"); break;
case KEEP_PACKAGE : printf(" keep: package\n"); break;
case KEEP_FEATURE : printf(" keep: feature\n"); break;
default : g_error("Unexpected \"keep\" value: %d", keep);
}
}
void print_value(cudf_value_t *v) {
int typ;
if (v == NULL)
return;
typ = v->typ;
switch (typ) {
case TYPE_INT :
case TYPE_POSINT :
case TYPE_NAT :
printf("%d", v->val.i);
break;
case TYPE_BOOL :
printf("%s", v->val.i ? "true" : "false");
break;
case TYPE_STRING :
case TYPE_PKGNAME :
case TYPE_IDENT :
case TYPE_ENUM :
printf("%s", v->val.s);
break;
case TYPE_VPKG :
case TYPE_VEQPKG :
print_vpkg(v->val.vpkg);
break;
case TYPE_VPKGLIST :
case TYPE_VEQPKGLIST :
print_vpkglist(v->val.vpkgs, ", ");
break;
case TYPE_VPKGFORMULA :
print_vpkgformula(v->val.f);
break;
case TYPE_TYPEDECL :
break;
default :
g_error("Internal error: unexpected variant for type: %d", typ);
}
}
/* Print to stdout a generic property, i.e. a pair */
void print_property(gpointer k, gpointer v, gpointer user_data) {
printf(" %s: ", (char *) k);
print_value(v);
printf("\n");
}
/* Print to stdout a set of extra properties */
#define print_extra(e) (g_hash_table_foreach(e, print_property, NULL))
/* Print to stdout a CUDF package */
void print_pkg(cudf_package_t pkg) {
cudf_vpkgformula_t fmla;
cudf_vpkglist_t vpkglist;
cudf_extra_t extra;
printf(" package: %s\n", cudf_pkg_name(pkg));
printf(" version: %d\n", cudf_pkg_version(pkg));
printf(" installed: %s\n",
cudf_pkg_installed(pkg) ? "true" : "false");
printf(" was-installed: %s\n",
cudf_pkg_was_installed(pkg) ? "true" : "false");
fmla = cudf_pkg_depends(pkg);
printf(" depends: ");
print_vpkgformula(fmla);
printf("\n");
cudf_free_vpkgformula(fmla);
vpkglist = cudf_pkg_conflicts(pkg); /* conflicts */
printf(" conflicts: ");
print_vpkglist(vpkglist, ", ");
printf("\n");
cudf_free_vpkglist(vpkglist);
vpkglist = cudf_pkg_provides(pkg); /* provides */
printf(" provides: ");
print_vpkglist(vpkglist, ", ");
printf("\n");
cudf_free_vpkglist(vpkglist);
print_keep(cudf_pkg_keep(pkg)); /* keep */
extra = cudf_pkg_extra(pkg); /* extra properties */
print_extra(extra);
printf("\n");
cudf_free_extra(extra);
}
int main(int argc, char **argv) {
cudf_doc_t *doc = NULL;
cudf_t *cudf = NULL, *sol = NULL;
cudf_package_t pkg;
cudf_universe_t univ = NULL;
GList *l = NULL;
cudf_init();
if (argc < 2) {
printf("Usage: %s CUDF_FILE [ SOLUTION_FILE ]\n", argv[0]);
exit(2);
}
g_message("Parsing CUDF document %s ...", argv[1]);
doc = cudf_parse_from_file(argv[1]);
printf("Has preamble: %s\n", doc->has_preamble ? "yes" : "no");
if (doc->has_preamble) {
printf("Preamble: \n");
print_preamble(doc);
printf("\n");
}
printf("Has request: %s\n", doc->has_request ? "yes" : "no");
if (doc->has_request) {
printf("Request: \n");
print_request(doc);
printf("\n");
}
printf("Universe:\n");
l = doc->packages;
while (l != NULL) {
pkg = (cudf_package_t) g_list_nth_data(l, 0);
print_pkg(pkg);
l = g_list_next(l);
}
g_message("Try packages -> universe conversion ...");
univ = cudf_load_universe(doc->packages);
printf("Universe size: %d/%d (installed/total)\n",
cudf_installed_size(univ), cudf_universe_size(univ));
printf("Universe consistent: %s\n", cudf_is_consistent(univ) ?
"yes" : "no");
g_message("Freeing memory ...");
cudf_free_universe(univ);
cudf_free_doc(doc);
g_message("Try direct CUDF loading ...");
cudf = cudf_load_from_file(argv[1]);
printf("Universe size: %d/%d (installed/total)\n",
cudf_installed_size(cudf->universe),
cudf_universe_size(cudf->universe));
printf("Universe consistent: %s\n",
cudf_is_consistent(cudf->universe) ? "yes" : "no");
if (argc >= 3) {
g_message("Loading solution %s ...", argv[2]);
sol = cudf_load_solution_from_file(argv[2], cudf->universe);
printf("Is solution: %s\n",
cudf_is_solution(cudf, sol->universe) ? "yes" : "no");
}
g_message("Freeing memory (direct loading)...");
cudf_free_cudf(sol);
cudf_free_cudf(cudf);
g_message("All done.");
exit(0);
}
cudf-0.9/c-lib/caml_hash_variant.c 0000664 0000000 0000000 00000002505 13064235433 0017105 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
#include
#include
int main(int argc, char **argv)
{
char *shortname, *variant;
if (argc == 2) {
variant = argv[1];
shortname = argv[1];
} else if (argc == 3) {
variant = argv[1];
shortname = argv[2];
} else {
printf("Usage: hash_variant VARIANT [SHORT_NAME]\n");
exit(2);
}
printf("#define\tMLPVAR_%s\t(%d)\t/* caml hash for \"`%s\" */\n",
shortname, Int_val(caml_hash_variant(variant)), variant);
return 0;
}
cudf-0.9/c-lib/cudf-private.h 0000664 0000000 0000000 00000002535 13064235433 0016043 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
#ifndef _CUDF_PRIVATE_H
#define _CUDF_PRIVATE_H
/* Instantiation of OCaml-related abstract data types. To be used only libcudf
implementation itself. Rationale: all use of OCaml's values from C is very
subtle and should be avoided in final C applications; additionally, hiding
"value" type removes the need of having OCaml C headers installed. */
typedef value *cudf_preamble_t;
typedef value *cudf_request_t;
typedef value *cudf_universe_t;
typedef value *cudf_package_t;
#endif
cudf-0.9/c-lib/cudf.c 0000664 0000000 0000000 00000040566 13064235433 0014374 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
// TODO should check / handle exceptions for all invoked caml_callback-s
// TODO better management of g_error() (not all should be fatal)
// TODO property-by-property access for preamble (as per packages)
#include
#include
#include
#include
#include
#include
#include "cudf-private.h" // instantiate OCaml-related ADTs
#include "cudf-variants.h"
#include "cudf.h"
#define Val_none Val_int(0)
#define Some_val(v) Field(v,0)
/* field indexes in the return type of {!Cudf_parser.parse_from_file},
* {!Cudf_parser.load_from_file}, and {!Cudf_parser.load_solution_from_file} */
#define FIELD_PRE 0
#define FIELD_UNIV 1 // universe for load_*, package list for parse_*
#define FIELD_REQ 2 // unused for load_solution_from_file
/* field indexes in {!Cudf.package} */
#define FIELD_PKG 0
#define FIELD_VERSION 1
#define FIELD_DEPS 2
#define FIELD_CONFL 3
#define FIELD_PROV 4
#define FIELD_INST 5
#define FIELD_WASINST 6
#define FIELD_KEEP 7
#define FIELD_PKGEXTRA 8
/* field indexes in {!Cudf.request} */
#define FIELD_REQID 0
#define FIELD_REQINST 1
#define FIELD_REQREM 2
#define FIELD_REQUP 3
#define FIELD_REQEXTRA 4
/* field indexes in {!Cudf.preamble} */
#define FIELD_PREID 0
#define FIELD_TYPEDECL 1
#define FIELD_UCHECK 2
#define FIELD_SCHECK 3
#define FIELD_RCHECK 4
/* field indexes in the return type of {!Cudf_checker.is_solution} and
* {!Cudf_checker.is_consistent} */
#define FIELD_ISSOL 0
/* Initialize a pointer to an OCaml value */
#define NEW_MLVAL(p) \
do { p = malloc(sizeof(value)); \
caml_register_global_root(p); } \
while (0)
/* Free a pointer to an OCaml value */
#define FREE_MLVAL(p) \
do { free(p); \
caml_remove_global_root(p); } \
while (0)
/** generic OCaml binding helpers */
#if 0
static int caml_list_length(value l) {
int length = 0;
while (l != Val_emptylist) {
length++;
l = Field(l, 1);
}
return length;
}
#endif
/** CUDF-specific binding helpers */
static int relop_val(value v) {
CAMLparam1(v);
int op;
switch (Int_val(v)) {
case MLPVAR_Eq : op = RELOP_EQ ; break ;
case MLPVAR_Neq : op = RELOP_NEQ ; break ;
case MLPVAR_Geq : op = RELOP_GEQ ; break ;
case MLPVAR_Gt : op = RELOP_GT ; break ;
case MLPVAR_Leq : op = RELOP_LEQ ; break ;
case MLPVAR_Lt : op = RELOP_LT ; break ;
default :
g_error("Internal error: unexpected variant for \"relop\": %d",
Int_val(v));
}
CAMLreturnT(int, op);
}
cudf_vpkg_t *cudf_vpkg_val(value ml_vpkg) {
CAMLparam1(ml_vpkg);
CAMLlocal1(ml_constr);
cudf_vpkg_t *vpkg;
vpkg = malloc(sizeof(cudf_vpkg_t));
vpkg->name = strdup(String_val(Field(ml_vpkg, 0)));
if (Field(ml_vpkg, 1) != Val_none) { /* version constraint */
ml_constr = Some_val(Field(ml_vpkg, 1));
vpkg->relop = relop_val(Field(ml_constr, 0));
vpkg->version = Int_val(Field(ml_constr, 1));
} else { /* no version constraint */
vpkg->relop = 0;
vpkg->version = -1;
}
CAMLreturnT(cudf_vpkg_t *, vpkg);
}
cudf_vpkglist_t cudf_vpkglist_val(value ml_vpkgs) {
CAMLparam1(ml_vpkgs);
CAMLlocal1(ml_vpkg);
GList *l = NULL;
cudf_vpkg_t *vpkg;
while (ml_vpkgs != Val_emptylist) {
ml_vpkg = Field(ml_vpkgs, 0);
vpkg = cudf_vpkg_val(ml_vpkg);
l = g_list_append(l, vpkg);
ml_vpkgs = Field(ml_vpkgs, 1);
}
CAMLreturnT(cudf_vpkglist_t, l);
}
cudf_vpkgformula_t cudf_vpkgformula_val(value ml_fmla) {
CAMLparam1(ml_fmla);
CAMLlocal2(ml_and, ml_or);
GList *and_l = NULL; /* top-level formula (CNF) */
GList *or_l; /* OR-ed deps */
/* ml_and: iterates over OR-ed deps (which are AND-ed together) */
/* ml_or: iterates over vpkg-s (which are OR-ed together) */
cudf_vpkg_t *vpkg;
ml_and = ml_fmla;
while (ml_and != Val_emptylist) {
ml_or = Field(ml_and, 0);
or_l = NULL;
while (ml_or != Val_emptylist) {
vpkg = cudf_vpkg_val(Field(ml_or, 0));
or_l = g_list_append(or_l, vpkg);
ml_or = Field(ml_or, 1);
}
and_l = g_list_append(and_l, or_l);
ml_and = Field(ml_and, 1);
}
CAMLreturnT(cudf_vpkgformula_t, and_l);
}
cudf_value_t *cudf_value_val(value ml_v) {
CAMLparam1(ml_v);
CAMLlocal1(ml_payload);
cudf_value_t *v;
int typ;
v = malloc(sizeof(cudf_value_t));
typ = Int_val(Field(ml_v, 0));
ml_payload = Field(ml_v, 1);
v->typ = typ;
switch (typ) {
case MLPVAR_Int :
v->typ = TYPE_INT;
v->val.i = Int_val(ml_payload);
break;
case MLPVAR_Posint :
v->typ = TYPE_POSINT;
v->val.i = Int_val(ml_payload);
break;
case MLPVAR_Nat :
v->typ = TYPE_NAT;
v->val.i = Int_val(ml_payload);
break;
case MLPVAR_Bool :
v->typ = TYPE_BOOL;
v->val.i = Bool_val(ml_payload);
break;
case MLPVAR_String :
v->typ = TYPE_STRING;
v->val.s = strdup(String_val(ml_payload));
case MLPVAR_Pkgname :
v->typ = TYPE_PKGNAME;
v->val.s = strdup(String_val(ml_payload));
case MLPVAR_Ident :
v->typ = TYPE_IDENT;
v->val.s = strdup(String_val(ml_payload));
break;
case MLPVAR_Enum :
v->typ = TYPE_ENUM;
/* Skip enum list and jump to the actual enum. Enum list is
* currently not accessible using C bindings. */
v->val.s = strdup(String_val(Field(ml_payload, 1)));
break;
case MLPVAR_Vpkg :
v->typ = TYPE_VPKG;
v->val.vpkg = cudf_vpkg_val(ml_payload);
break;
case MLPVAR_Veqpkg :
v->typ = TYPE_VEQPKG;
v->val.vpkg = cudf_vpkg_val(ml_payload);
break;
case MLPVAR_Vpkglist :
v->typ = TYPE_VPKGLIST;
v->val.vpkgs = cudf_vpkglist_val(ml_payload);
break;
case MLPVAR_Veqpkglist :
v->typ = TYPE_VEQPKGLIST;
v->val.vpkgs = cudf_vpkglist_val(ml_payload);
break;
case MLPVAR_Vpkgformula :
v->typ = TYPE_VPKGFORMULA;
v->val.f = cudf_vpkgformula_val(ml_payload);
break;
case MLPVAR_Typedecl :
v->typ = TYPE_TYPEDECL;
break;
default :
g_error("Internal error: unexpected variant for type: %d", typ);
}
CAMLreturnT(cudf_value_t *, v);
}
/** libCUDF binding public interface */
void cudf_init() {
char *fake_argv[] = {"", NULL};
static int cudf_initialized = 0;
if (cudf_initialized)
return;
caml_startup(fake_argv);
cudf_initialized = 1;
}
cudf_doc_t *cudf_parse_from_file(char *fname) {
CAMLparam0();
CAMLlocal2(ml_doc, ml_pkgs);
static value *closure_f = NULL;
cudf_doc_t *doc;
GList *l = NULL;
cudf_package_t pkg;
doc = malloc(sizeof(cudf_doc_t));
if (closure_f == NULL)
closure_f = caml_named_value("parse_from_file");
ml_doc = caml_callback(*closure_f, caml_copy_string(fname));
NEW_MLVAL(doc->preamble); /* preamble */
if (Field(ml_doc, FIELD_PRE) != Val_none) {
doc->has_preamble = 1;
*(doc->preamble) = Some_val(Field(ml_doc, FIELD_PRE));
} else {
doc->has_preamble = 0;
*(doc->preamble) = Val_none;
}
NEW_MLVAL(doc->request); /* request */
if (Field(ml_doc, FIELD_REQ) != Val_none) {
doc->has_request = 1;
*(doc->request) = Some_val(Field(ml_doc, FIELD_REQ));
} else {
doc->has_request = 0;
*(doc->request) = Val_none;
}
ml_pkgs = Field(ml_doc, FIELD_UNIV); /* packages */
while (ml_pkgs != Val_emptylist) {
NEW_MLVAL(pkg);
*pkg = Field(ml_pkgs, 0);
l = g_list_prepend(l, pkg);
ml_pkgs = Field(ml_pkgs, 1);
}
doc->packages = g_list_reverse(l);
CAMLreturnT(cudf_doc_t *, doc);
}
cudf_t *cudf_load_from_file(char *fname) {
CAMLparam0();
CAMLlocal1(ml_cudf);
static value *closure_f = NULL;
cudf_t *cudf;
cudf = malloc(sizeof(cudf_t));
if (closure_f == NULL)
closure_f = caml_named_value("load_from_file");
ml_cudf = caml_callback(*closure_f, caml_copy_string(fname));
NEW_MLVAL(cudf->preamble); /* preamble */
if (Field(ml_cudf, FIELD_PRE) != Val_none) {
cudf->has_preamble = 1;
*(cudf->preamble) = Some_val(Field(ml_cudf, FIELD_PRE));
} else {
cudf->has_preamble = 0;
*(cudf->preamble) = Val_none;
}
NEW_MLVAL(cudf->request); /* request */
if (Field(ml_cudf, FIELD_REQ) != Val_none) {
cudf->has_request = 1;
*(cudf->request) = Some_val(Field(ml_cudf, FIELD_REQ));
} else {
cudf->has_request = 0;
*(cudf->request) = Val_none;
}
NEW_MLVAL(cudf->universe); /* universe */
*(cudf->universe) = Field(ml_cudf, FIELD_UNIV);
CAMLreturnT(cudf_t *, cudf);
}
cudf_t *cudf_load_solution_from_file(char *fname, cudf_universe_t ref_univ) {
CAMLparam0();
CAMLlocal1(ml_cudf);
static value *closure_f = NULL;
cudf_t *cudf;
cudf = malloc(sizeof(cudf_t));
if (closure_f == NULL)
closure_f = caml_named_value("load_solution_from_file");
ml_cudf = caml_callback2(*closure_f, caml_copy_string(fname),
*ref_univ);
NEW_MLVAL(cudf->preamble); /* preamble */
if (Field(ml_cudf, FIELD_PRE) != Val_none) {
cudf->has_preamble = 1;
*(cudf->preamble) = Some_val(Field(ml_cudf, FIELD_PRE));
} else {
cudf->has_preamble = 0;
*(cudf->preamble) = Val_none;
}
NEW_MLVAL(cudf->request); /* request */
cudf->has_request = 0; /* solutions have no request */
*(cudf->request) = Val_none;
NEW_MLVAL(cudf->universe); /* universe */
*(cudf->universe) = Field(ml_cudf, FIELD_UNIV);
CAMLreturnT(cudf_t *, cudf);
}
char *cudf_pkg_name(cudf_package_t pkg) {
return String_val(Field(*pkg, FIELD_PKG));
}
int cudf_pkg_version(cudf_package_t pkg) {
return Int_val(Field(*pkg, FIELD_VERSION));
}
int cudf_pkg_installed(cudf_package_t pkg) {
return Int_val(Field(*pkg, FIELD_INST));
}
int cudf_pkg_was_installed(cudf_package_t pkg) {
return Int_val(Field(*pkg, FIELD_WASINST));
}
int cudf_pkg_keep(cudf_package_t pkg) {
CAMLparam0();
CAMLlocal1(keep);
int k;
keep = Field(*pkg, FIELD_KEEP);
switch (Int_val(keep)) {
case MLPVAR_Keep_none : k = KEEP_NONE ; break ;
case MLPVAR_Keep_version : k = KEEP_VERSION ; break ;
case MLPVAR_Keep_package : k = KEEP_PACKAGE ; break ;
case MLPVAR_Keep_feature : k = KEEP_FEATURE ; break ;
default :
g_error("Internal error: unexpected variant for \"keep\": %d",
Int_val(keep));
}
CAMLreturnT(int, k);
}
cudf_vpkgformula_t cudf_pkg_depends(cudf_package_t pkg) {
return cudf_vpkgformula_val(Field(*pkg, FIELD_DEPS));
}
cudf_vpkglist_t cudf_pkg_conflicts(cudf_package_t pkg) {
return cudf_vpkglist_val(Field(*pkg, FIELD_CONFL));
}
cudf_vpkglist_t cudf_pkg_provides(cudf_package_t pkg) {
return cudf_vpkglist_val(Field(*pkg, FIELD_PROV));
}
char *cudf_pkg_property(cudf_package_t pkg, const char *prop) {
CAMLparam0();
CAMLlocal1(prop_val);
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("lookup_package_property");
prop_val = caml_callback2_exn(*closure_f, *pkg, caml_copy_string(prop));
CAMLreturnT(char *,
Is_exception_result(prop_val) ? NULL :
strdup(String_val(prop_val)));
}
char *cudf_req_property(cudf_request_t req, const char *prop) {
CAMLparam0();
CAMLlocal1(prop_val);
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("lookup_request_property");
prop_val = caml_callback2_exn(*closure_f, *req, caml_copy_string(prop));
CAMLreturnT(char *,
Is_exception_result(prop_val) ? NULL :
strdup(String_val(prop_val)));
}
cudf_vpkglist_t cudf_req_install(cudf_request_t req) {
return cudf_vpkglist_val(Field(*req, FIELD_REQINST));
}
cudf_vpkglist_t cudf_req_remove(cudf_request_t req) {
return cudf_vpkglist_val(Field(*req, FIELD_REQREM));
}
cudf_vpkglist_t cudf_req_upgrade(cudf_request_t req) {
return cudf_vpkglist_val(Field(*req, FIELD_REQUP));
}
char *cudf_pre_property(cudf_preamble_t pre, const char *prop) {
CAMLparam0();
CAMLlocal1(prop_val);
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("lookup_preamble_property");
prop_val = caml_callback2_exn(*closure_f, *pre, caml_copy_string(prop));
CAMLreturnT(char *,
Is_exception_result(prop_val) ? NULL :
strdup(String_val(prop_val)));
}
cudf_extra_t cudf_pkg_extra(cudf_package_t pkg) {
CAMLparam0();
CAMLlocal2(ml_extras, ml_prop);
GHashTable *h = NULL;
h = g_hash_table_new_full(g_str_hash, g_str_equal,
g_free, (GDestroyNotify) cudf_free_value);
ml_extras = Field(*pkg, FIELD_PKGEXTRA);
while (ml_extras != Val_emptylist) {
ml_prop = Field(ml_extras, 0);
g_hash_table_insert(h, strdup(String_val(Field(ml_prop, 0))),
cudf_value_val(Field(ml_prop, 1)));
ml_extras = Field(ml_extras, 1);
}
CAMLreturnT(cudf_extra_t, h);
}
/** Universe management */
cudf_universe_t cudf_load_universe(GList *packages) {
CAMLparam0();
CAMLlocal2(ml_pkgs, cons);
static value *closure_f = NULL;
GList *l = packages;
cudf_universe_t univ = NULL;
ml_pkgs = Val_emptylist;
while (l != NULL) {
cons = caml_alloc(2, 0);
Store_field(cons, 0, * (cudf_package_t) g_list_nth_data(l, 0));
Store_field(cons, 1, ml_pkgs);
ml_pkgs = cons;
l = g_list_next(l);
}
if (closure_f == NULL)
closure_f = caml_named_value("load_universe");
NEW_MLVAL(univ);
*univ = caml_callback(*closure_f, ml_pkgs);
CAMLreturnT(cudf_universe_t, univ);
}
int cudf_universe_size(cudf_universe_t univ) {
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("universe_size");
return Int_val(caml_callback(*closure_f, *univ));
}
int cudf_installed_size(cudf_universe_t univ) {
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("installed_size");
return Int_val(caml_callback(*closure_f, *univ));
}
int cudf_is_consistent(cudf_universe_t univ) {
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("is_consistent");
return Bool_val(Field(caml_callback(*closure_f, *univ), FIELD_ISSOL));
}
int cudf_is_solution(cudf_t *cudf, cudf_universe_t sol) {
CAMLparam0();
CAMLlocal1(ml_cudf);
static value *closure_f = NULL;
if (closure_f == NULL)
closure_f = caml_named_value("is_solution");
if (! cudf->has_request)
g_error("Given CUDF has no request: cannot compare it with a solution.");
ml_cudf = caml_alloc(2, 0);
Store_field(ml_cudf, 0, *(cudf->universe));
Store_field(ml_cudf, 1, *(cudf->request));
CAMLreturnT(int,
Bool_val(Field(caml_callback2(*closure_f, ml_cudf, *sol),
FIELD_ISSOL)));
}
/** Memory management.
free-like functions to free binding-specific data structures */
void cudf_free_doc(cudf_doc_t *doc) {
GList *l;
if (doc == NULL)
return;
FREE_MLVAL(doc->preamble);
FREE_MLVAL(doc->request);
l = doc->packages;
while (l != NULL) {
FREE_MLVAL(g_list_nth_data(l, 0));
l = g_list_next(l);
}
g_list_free(l);
free(doc);
}
void cudf_free_cudf(cudf_t *cudf) {
if (cudf == NULL)
return;
FREE_MLVAL(cudf->preamble);
FREE_MLVAL(cudf->request);
FREE_MLVAL(cudf->universe);
free(cudf);
}
void cudf_free_universe(cudf_universe_t univ) {
if (univ == NULL)
return;
FREE_MLVAL(univ);
}
void cudf_free_vpkg(cudf_vpkg_t *vpkg) {
if (vpkg == NULL)
return;
if (vpkg->name != NULL)
free(vpkg->name);
free(vpkg);
}
void cudf_free_vpkglist(cudf_vpkglist_t vpkgs) {
GList *l = vpkgs;
while (l != NULL) {
cudf_free_vpkg(g_list_nth_data(l, 0));
l = g_list_next(l);
}
g_list_free(vpkgs);
}
void cudf_free_vpkgformula(cudf_vpkgformula_t fmla) {
GList *l = fmla;
while (l != NULL) {
cudf_free_vpkglist(g_list_nth_data(l, 0));
l = g_list_next(l);
}
g_list_free(fmla);
}
void cudf_free_value(cudf_value_t *v) {
int typ;
if (v == NULL)
return;
typ = v->typ;
switch (typ) {
case TYPE_INT :
case TYPE_POSINT :
case TYPE_NAT :
case TYPE_BOOL :
break; /* integers don't require any freeing */
case TYPE_STRING :
case TYPE_PKGNAME :
case TYPE_IDENT :
case TYPE_ENUM :
free(v->val.s);
break;
case TYPE_VPKG :
case TYPE_VEQPKG :
cudf_free_vpkg(v->val.vpkg);
break;
case TYPE_VPKGLIST :
case TYPE_VEQPKGLIST :
cudf_free_vpkglist(v->val.vpkgs);
break;
case TYPE_VPKGFORMULA :
cudf_free_vpkgformula(v->val.f);
break;
case TYPE_TYPEDECL :
break;
default :
g_error("Internal error: unexpected variant for type: %d", typ);
}
free(v);
}
void cudf_free_extra(cudf_extra_t extra) {
g_hash_table_destroy(extra);
}
cudf-0.9/c-lib/cudf.h 0000664 0000000 0000000 00000022452 13064235433 0014373 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
#ifndef _CUDF_H
#define _CUDF_H
#include
#ifndef _CUDF_PRIVATE_H
/* Abstract data types. You should access them only with the functions given
below. Really (or you will face the anger of OCaml GC).*/
typedef void *cudf_preamble_t; /* preamble of a CUDF document */
typedef void *cudf_request_t; /* request of a CUDF document */
typedef void *cudf_universe_t; /* package universe (i.e. all known packages) */
typedef void *cudf_package_t; /* single package from the universe */
#endif
typedef GList *cudf_packages_t; /* List of CUDF packages */
typedef struct __cudf_doc {
int has_preamble; /* Whether user request was provided or not */
int has_request; /* Whether request was provided or not */
cudf_preamble_t preamble; /* Preamble (iff has_preamble != 0) */
cudf_request_t request; /* User request (iff has_request != 0) */
cudf_packages_t packages; /* List of packages */
} cudf_doc_t;
typedef struct __cudf {
int has_preamble; /* Whether user request was provided or not */
int has_request; /* Whether request was provided or not */
cudf_preamble_t preamble; /* Preamble (iff has_preamble != 0) */
cudf_request_t request; /* User request (iff has_request != 0) */
cudf_universe_t universe; /* Abstract package universe */
} cudf_t;
/* Initialization */
/* Call cudf_init() before doing anything else with libCUDF. (Or you will get a
* segfault, you've been warned.) */
void cudf_init();
/* Parsing */
/* Parse a CUDF document from file, without doing any further processing. */
cudf_doc_t *cudf_parse_from_file(char *fname);
/* Load a CUDF document from file, i.e. parse it and then store the contained
* packages as an universe structure.
*
* Note: to load solutions you should prefer cudf_load_solution_from_file,
* which can be invoked after CUDF document loading. */
cudf_t *cudf_load_from_file(char *fname);
/* Load from file a CUDF universe representing a solution to an upgrade
* scenario. Solution format is as per Appendix B of CUDF 2.0 spec
* (i.e. package/version pairs, together with installation status).
*
* @param ref_univ is the reference universe to be used to expand package
* information, usually it is the universe of the original CUDF
*/
cudf_t *cudf_load_solution_from_file(char *fname, cudf_universe_t ref_univ);
/* Package predicate
Examples:
- bar ---> { name="bar" ; relop=0 ; version=UNSPECIFIED }
- foo >= 2 ---> { name="foo" ; relop=RELOP_GEQ ; version=2 }
*/
typedef struct __cudf_vpkg {
char *name; /* Package name */
int relop; /* Version constraint operator, see RELOP_* constants.
0 (i.e. RELOP_NOP) means no constraint */
int version; /* Version constraint value (iff constr != 0) */
} cudf_vpkg_t;
typedef GList *cudf_vpkglist_t; /* List of cudf_vpkg */
/* Hash table mapping property names (char *) to typed values (cudf_value_t). */
typedef GHashTable *cudf_extra_t;
/* List of (cudf_vpkg_t *) lists.
CNF encoding: the inner lists are OR-ed, while the outer are AND-ed */
typedef GList *cudf_vpkgformula_t;
/* Version comparison operators */
#define RELOP_EQ 1 /* "=" */
#define RELOP_NEQ 2 /* "!=" */
#define RELOP_GEQ 3 /* ">=" */
#define RELOP_GT 4 /* ">" */
#define RELOP_LEQ 5 /* "<=" */
#define RELOP_LT 6 /* "<" */
#define RELOP_NOP 0 /* dummy operator */
/* CUDF types */
#define TYPE_INT 1 /* type "int" */
#define TYPE_POSINT 2 /* type "posint" */
#define TYPE_NAT 3 /* type "nat" */
#define TYPE_BOOL 4 /* type "bool" */
#define TYPE_STRING 5 /* type "string" */
#define TYPE_ENUM 6 /* type "enum" (whichever enum list) */
#define TYPE_PKGNAME 7 /* type "pkgname" */
#define TYPE_IDENT 8 /* type "ident" */
#define TYPE_VPKG 9 /* type "vpkg" */
#define TYPE_VPKGFORMULA 10 /* type "vpkgformula" */
#define TYPE_VPKGLIST 11 /* type "vpkglist" */
#define TYPE_VEQPKG 12 /* type "veqpkg" */
#define TYPE_VEQPKGLIST 13 /* type "veqpkglist" */
#define TYPE_TYPEDECL 14 /* type "typedecl" */
#define TYPE_NOTYPE 0 /* dummy type */
/* Typed CUDF value */
typedef struct __cudf_value {
int typ; /* CUDF type, one of the TYPE_* constants */
union {
int i;
char *s;
cudf_vpkg_t *vpkg;
cudf_vpkgformula_t f;
cudf_vpkglist_t vpkgs;
/* cudf_typedecl types; */ /* currently not supported */
} val; /* CUDF value
depending on typ above, one of the above union field is set:
typ | val field
-----------------+-------------------
TYPE_INT | int i
TYPE_POSINT | int i
TYPE_NAT | int i
TYPE_BOOL | int i
TYPE_STRING | char *s
TYPE_ENUM | char *s
TYPE_PKGNAME | char *s
TYPE_IDENT | char *s
TYPE_VPKG | cudf_vpkg_t *pkg
TYPE_VEQPKG | cudf_vpkg_t *pkg
TYPE_VPKGLIST | cudf_vpkglist_t pkgs
TYPE_VEQPKGLIST | cudf_vpkglist_t pkgs
TYPE_VPKGFORMULA | cudf_vpkgformula_t f
TYPE_TYPEDECL | cudf_typedecl_t types
*/
} cudf_value_t;
/* Macros for accessing cudf_package values */
/* Get package name of a cudf_pkg */
char *cudf_pkg_name(cudf_package_t pkg);
/* Get package version of a cudf_pkg */
int cudf_pkg_version(cudf_package_t pkg);
/* Get (current) installation status of a cudf_pkg */
int cudf_pkg_installed(cudf_package_t pkg);
/* Get (past) installation status of a cudf_pkg */
int cudf_pkg_was_installed(cudf_package_t pkg);
/* Possible values returned by cudf_pkg_keep() */
#define KEEP_NONE 0 /* keep: none */
#define KEEP_VERSION 1 /* keep: version */
#define KEEP_PACKAGE 2 /* keep: package */
#define KEEP_FEATURE 3 /* keep: feature */
/* Get "keep" property from a cudf_pkg. See KEEP_* macros */
int cudf_pkg_keep(cudf_package_t pkg);
/* Get dependencies of a package */
cudf_vpkgformula_t cudf_pkg_depends(cudf_package_t pkg);
/* Get conflicts of a package */
cudf_vpkglist_t cudf_pkg_conflicts(cudf_package_t pkg);
/* Get provided features of a package */
cudf_vpkglist_t cudf_pkg_provides(cudf_package_t pkg);
/* Get extra properties of a package. */
cudf_extra_t cudf_pkg_extra(cudf_package_t pkg);
/* Lookup package property by name. Returned string should be manually freed.
Return NULL if the property is missing (and has no default value). */
char *cudf_pkg_property(cudf_package_t pkg, const char *prop);
/* Lookup request property by name. Returned string should be manually freed.
Return NULL if the property is missing (and has no default value). */
char *cudf_req_property(cudf_request_t req, const char *prop);
/* Get install section of the request. */
cudf_vpkglist_t cudf_req_install(cudf_request_t req) ;
/* Get upgrade section of the request. */
cudf_vpkglist_t cudf_req_upgrade(cudf_request_t req) ;
/* Get remove section of the request. */
cudf_vpkglist_t cudf_req_remove(cudf_request_t req) ;
/* Lookup preamble property by name. Returned string should be manually freed.
Return NULL if the property is missing (and has no default value). */
char *cudf_pre_property(cudf_preamble_t pre, const char *prop);
/* Universe management */
/* @param packages list of (pointers to) cudf_package-s; the packages member of
a cudf_doc structure is a suitable value
@return a freshly allocated universe, which should be freed when no longer
needed using cudf_free_universe */
cudf_universe_t cudf_load_universe(GList *packages);
/* Return the number of packages in the given universe. */
int cudf_universe_size(cudf_universe_t univ);
/* Return the number of installed packages in the given universe. */
int cudf_installed_size(cudf_universe_t univ);
/* Check whether the package status of the given universe is consistent
* (i.e. dependencies and conflicts or all installed packages are
* respected). */
int cudf_is_consistent(cudf_universe_t univ);
/* Check whether the given universe contains a proper solution for the given
* CUDF (i.e. its package status is consistent and satisfies user request).
*
* Solution should normally be obtained via cudf_load_solution_from_file(), and
* passing cudf->universe to it, e.g.:
*
* cudf = cudf_load_from_file(...);
* sol = cudf_load_solution_from_file(..., cudf->universe);
* ok = is_solution(cudf, sol);
*/
int cudf_is_solution(cudf_t *cudf, cudf_universe_t solution);
/* Memory management */
void cudf_free_doc(cudf_doc_t *doc);
void cudf_free_cudf(cudf_t *cudf);
void cudf_free_universe(cudf_universe_t univ);
void cudf_free_vpkg(cudf_vpkg_t *vpkg);
void cudf_free_vpkglist(cudf_vpkglist_t l);
void cudf_free_vpkgformula(cudf_vpkgformula_t fmla);
void cudf_free_value(cudf_value_t *val);
void cudf_free_extra(cudf_extra_t extra);
#endif /* end of cudf.h */
cudf-0.9/c-lib/cudf.pc.in 0000664 0000000 0000000 00000000441 13064235433 0015145 0 ustar 00root root 0000000 0000000 libdir=@LIBDIR@
includedir=@INCDIR@
datarootdir=/usr/share
datadir=${datarootdir}
ocaml_libdir=@OCAMLLIBDIR@
Name: CUDF
Description: access descriptions of package upgrade problems
Version: @VERSION@
Requires: glib-2.0
Libs: -L${libdir} -L${ocaml_libdir} -lcudf -lm -ldl -lunix -lncurses
cudf-0.9/cudf.ml 0000664 0000000 0000000 00000023666 13064235433 0013576 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open ExtLib
open Printf
open Cudf_types
open Cudf_types_pp
exception Constraint_violation of string
type package = {
package : pkgname ;
version : version ;
depends : vpkgformula ;
conflicts : vpkglist ;
provides : veqpkglist ;
installed : bool ;
was_installed : bool ;
keep : enum_keep ;
pkg_extra : typed_value stanza ;
}
type request = {
request_id : string ;
install : vpkglist ;
remove : vpkglist ;
upgrade : vpkglist ;
req_extra : typed_value stanza ;
}
type preamble = {
preamble_id : string ;
property : typedecl ;
univ_checksum: string ;
status_checksum: string ;
req_checksum: string ;
}
type cudf_doc = preamble option * package list * request
type cudf_item =
[ `Preamble of preamble | `Package of package | `Request of request ]
type universe = {
id2pkg: ((string * int), package) Hashtbl.t; (** -> pkg *)
name2pkgs: (string, package list ref) Hashtbl.t; (** name -> pkg list ref *)
uid2pkgs: (int, package) Hashtbl.t; (** int uid -> pkg *)
id2uid: ((pkgname * version), int) Hashtbl.t; (** -> int uid *)
features: (string, (package * version option) list ref) Hashtbl.t;
(** feature -> avail feature versions
Each available feature is reported as a pair
, where owner is the package
providing it. Provided version "None" means "all possible
versions" *)
mutable univ_size : int;
mutable inst_size : int;
}
type cudf = preamble * universe * request
type solution = preamble * universe
let universe_size univ = univ.univ_size
let installed_size univ = univ.inst_size
let (=%) pkg1 pkg2 =
pkg1.package = pkg2.package && pkg1.version = pkg2.version
let (<%) pkg1 pkg2 =
Pervasives.compare (pkg1.package, pkg1.version) (pkg2.package, pkg2.version)
let (>%) pkg1 pkg2 =
Pervasives.compare (pkg2.package, pkg2.version) (pkg1.package, pkg1.version)
let default_preamble = {
preamble_id = "" ;
property = [] ;
univ_checksum = "" ;
status_checksum = "" ;
req_checksum = "" ;
}
let default_package = {
package = "" ;
version = 0 ;
depends = [] ;
conflicts = [] ;
provides = [] ;
installed = false ;
was_installed = false ;
keep = `Keep_none ;
pkg_extra = [] ;
}
let default_request = {
request_id = "" ;
install = [] ;
remove = [] ;
upgrade = [] ;
req_extra = [] ;
}
let empty_universe ?(size=1023) () =
{ id2pkg = Hashtbl.create size ;
uid2pkgs = Hashtbl.create size;
id2uid = Hashtbl.create size;
name2pkgs = Hashtbl.create size;
features = Hashtbl.create size;
univ_size = 0 ; inst_size = 0 ;
}
let add_to_hash_list h n p =
try let l = Hashtbl.find h n in l := p :: !l
with Not_found -> Hashtbl.add h n (ref [p])
let get_hash_list h n = try !(Hashtbl.find h n) with Not_found -> []
(** process all features (i.e., Provides) provided by a given package
and fill with them a given feature table *)
let expand_features pkg features =
List.iter
(function
| name, None -> add_to_hash_list features name (pkg, None)
| name, Some (_, ver) -> add_to_hash_list features name (pkg, (Some ver)))
pkg.provides
let add_package_aux univ pkg uid =
let id = pkg.package, pkg.version in
if Hashtbl.mem univ.id2pkg id then
raise (Constraint_violation (sprintf "duplicate package: <%s, %d>" pkg.package pkg.version))
else begin
Hashtbl.add univ.uid2pkgs uid pkg;
Hashtbl.add univ.id2uid id uid;
Hashtbl.add univ.id2pkg id pkg;
add_to_hash_list univ.name2pkgs pkg.package pkg;
expand_features pkg univ.features;
univ.univ_size <- univ.univ_size + 1;
if pkg.installed then
univ.inst_size <- univ.inst_size + 1
end
let add_package univ pkg =
let uid = (Hashtbl.length univ.uid2pkgs) + 1 in
add_package_aux univ pkg uid
let remove_package univ id =
if not (Hashtbl.mem univ.id2pkg id) then ()
else begin
let uid = Hashtbl.find univ.id2uid id in
let p = Hashtbl.find univ.uid2pkgs uid in
let l = Hashtbl.find univ.name2pkgs p.package in
l := List.remove !l p;
if List.length !l = 0 then
Hashtbl.remove univ.name2pkgs p.package;
List.iter
(function
| name, None ->
let l = Hashtbl.find univ.features name in
l := List.remove !l (p, None);
if List.length !l = 0 then
Hashtbl.remove univ.features name
| name, Some (_, ver) ->
let l = Hashtbl.find univ.features name in
l := List.remove !l (p, (Some ver));
if List.length !l = 0 then
Hashtbl.remove univ.features name)
p.provides;
Hashtbl.remove univ.uid2pkgs uid;
Hashtbl.remove univ.id2uid id;
Hashtbl.remove univ.id2pkg id;
univ.univ_size <- univ.univ_size - 1;
if p.installed then
univ.inst_size <- univ.inst_size - 1;
end
let load_universe pkgs =
let size = List.length pkgs in
let univ = empty_universe ~size () in
let uid = ref 0 in
List.iter
(fun pkg ->
add_package_aux univ pkg !uid;
incr uid)
pkgs;
univ
let package_by_uid univ = Hashtbl.find univ.uid2pkgs
let uid_by_package univ pkg =
Hashtbl.find univ.id2uid (pkg.package, pkg.version)
let lookup_package univ = Hashtbl.find univ.id2pkg
let mem_package univ = Hashtbl.mem univ.id2pkg
let iter_packages f univ = Hashtbl.iter (fun _id pkg -> f pkg) univ.id2pkg
let iteri_packages f univ = Hashtbl.iter (fun _id pkg -> f _id pkg) univ.uid2pkgs
let fold_packages f init univ =
Hashtbl.fold (fun _id pkg acc -> f acc pkg) univ.id2pkg init
let iter_packages_by_name f univ =
Hashtbl.iter (fun n { contents = l } -> f n l) univ.name2pkgs
let fold_packages_by_name f a univ =
Hashtbl.fold (fun n { contents = l } a -> f a n l) univ.name2pkgs a
let package_names univ = List.of_enum (Hashtbl.keys univ.name2pkgs)
let get_packages ?filter univ =
match filter with
| None -> fold_packages (fun acc pkg -> pkg :: acc) [] univ
| Some test ->
fold_packages
(fun acc pkg -> if test pkg then pkg :: acc else acc)
[] univ
let (|=) v = function
| None -> true
| Some (`Eq, v') -> v = v'
| Some (`Neq, v') -> v <> v'
| Some (`Geq, v') -> v >= v'
| Some (`Gt, v') -> v > v'
| Some (`Leq, v') -> v <= v'
| Some (`Lt, v') -> v < v'
let version_matches = (|=)
let status univ =
let univ' = empty_universe () in
Hashtbl.iter
(fun id pkg -> match pkg with
| { installed = true } ->
Hashtbl.add univ'.id2pkg id pkg;
add_to_hash_list univ'.name2pkgs pkg.package pkg;
expand_features pkg univ'.features
| _ -> ())
univ.id2pkg;
univ'.inst_size <- univ.inst_size;
univ'.univ_size <- univ.inst_size; (* as we filtered on installed pkgs *)
univ'
let lookup_packages ?(filter=None) univ pkgname =
let packages = get_hash_list univ.name2pkgs pkgname in
match filter with
None -> packages
| Some _ as pred -> List.filter (fun p -> p.version |= pred) packages
let get_installed univ pkgname =
List.filter (fun { installed = i } -> i) (lookup_packages univ pkgname)
let mem_installed ?(include_features = true) ?(ignore = fun _ -> false)
univ (name, constr) =
let pkg_filter = fun pkg -> not (ignore pkg) in
let mem_feature constr =
let feats = get_hash_list univ.features name in
List.exists
(function
| owner_pkg, _ when not owner_pkg.installed -> false
| owner_pkg, None -> pkg_filter owner_pkg
| owner_pkg, Some v -> pkg_filter owner_pkg && v |= constr)
feats in
let pkgs = List.filter pkg_filter (get_installed univ name) in
List.exists (fun pkg -> pkg.version |= constr) pkgs
|| (include_features && mem_feature constr)
let who_provides ?(installed=true) univ (pkgname, constr) =
List.filter
(function
|pkg , _ when not pkg.installed && installed -> false
|_, None -> true
| _, Some v -> v |= constr
)
(get_hash_list univ.features pkgname)
let lookup_typed_package_property pkg = function
| "package" -> `Pkgname pkg.package
| "version" -> `Posint pkg.version
| "depends" -> `Vpkgformula pkg.depends
| "conflicts" -> `Vpkglist pkg.conflicts
| "provides" -> `Veqpkglist pkg.provides
| "installed" -> `Bool pkg.installed
| "keep" -> `Enum (keep_enums, string_of_keep pkg.keep)
| prop_name -> List.assoc prop_name pkg.pkg_extra
let lookup_typed_request_property req = function
| "request" -> `String req.request_id
| "install" -> `Vpkglist req.install
| "remove" -> `Vpkglist req.remove
| "upgrade" -> `Vpkglist req.upgrade
| prop_name -> List.assoc prop_name req.req_extra
let lookup_typed_preamble_property pre = function
| "preamble" -> `String pre.preamble_id
| "property" -> `Typedecl pre.property
| "univ-checksum" -> `String pre.univ_checksum
| "status-checksum" -> `String pre.status_checksum
| "req-checksum" -> `String pre.req_checksum
| _ -> raise Not_found
let lookup_package_property pkg prop =
string_of_value (lookup_typed_package_property pkg prop)
let lookup_request_property req prop =
string_of_value (lookup_typed_request_property req prop)
let lookup_preamble_property pre prop =
string_of_value (lookup_typed_preamble_property pre prop)
let lookup_package_typedecl ?(extra = []) prop =
List.assoc prop (Cudf_conf.package_typedecl @ extra)
cudf-0.9/cudf.mli 0000664 0000000 0000000 00000024760 13064235433 0013743 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** CUDF library *)
open Cudf_types
(** {6 CUDF documents} *)
(** Representation of a parsed package description item.
With this representation, optional properties have already been
expanded to their default values (if they have one). It is not
possible to know whether they were present or not in the CUDF
syntax.
*)
type package = {
package : pkgname ;
version : version ;
depends : vpkgformula ; (* default : [] *)
conflicts : vpkglist ; (* default : [] *)
provides : veqpkglist ; (* default : [] *)
installed : bool ; (* default : false *)
was_installed : bool ; (* default : false *)
keep : enum_keep ; (* default : `Keep_none *)
pkg_extra : typed_value stanza ; (* extra properties *)
}
(** package equality up to
i.e. 2 packages are equal iff they have the same name and version *)
val (=%) : package -> package -> bool
(** Package comparison up to . Same rules of package equality,
but providing a suitable replacement for [Pervasives.compare]; useful for
sorting. *)
val (<%) : package -> package -> int
(** Same as {!Cudf.(<%)}, but sort with greater versions first. *)
val (>%) : package -> package -> int
type request = {
request_id : string ; (* default : "" *)
install : vpkglist ; (* default : [] *)
remove : vpkglist ; (* default : [] *)
upgrade : vpkglist ; (* default : [] *)
req_extra : typed_value stanza ; (* default : [] *)
}
type preamble = {
preamble_id : string ; (** text following the "preamble: " postmark *)
property : typedecl ; (** extra property declarations *)
univ_checksum: string ; (** universe checksum *)
status_checksum: string ; (** status checksum *)
req_checksum: string ; (** request checksum *)
}
val default_preamble : preamble (** implement preamble defaults *)
val default_package : package (** implement package defaults *)
val default_request : request (** implement request defaults *)
(** {6 Syntactic CUDF representation} *)
(** a CUDF document with its information items *)
type cudf_doc = preamble option * package list * request
(** a single information item *)
type cudf_item =
[ `Preamble of preamble
| `Package of package
| `Request of request
]
(** {6 Semantic CUDF representation} *)
(** violation of a constraint imposed by CUDF specification
@param msg explanation of which constraint has been violated *)
exception Constraint_violation of string
(** package universe (including package status, i.e., installed packages) *)
type universe
type cudf = preamble * universe * request
(** CUDF-based encoding of solutions, see CUDF 2.0, appendix B
A universe encoding a solution matters only for its [installed]
packages, which are considered to be the resulting package
status *)
type solution = preamble * universe
(** return an empty universe.
@param size represents the initial size of the universe (default: 1023) *)
val empty_universe : ?size:int -> unit -> universe
(** @raise Constraint_violation when a global CUDF constraint is violated in
the given package list *)
val load_universe : package list -> universe
(** add a package to an existing universe. The universe is modified in place.
@raise Constraint_violation if a package with the same name and version is
alreayd in the given universe *)
val add_package : universe -> package -> unit
(** remove a package from an existing universe.
The universe is modified in place *)
val remove_package : universe -> pkgname * version -> unit
(** {5 CUDF manipulation} *)
(** Lookup a specific package via a key
@raise Not_found if the requested package cannot be found *)
val lookup_package : universe -> pkgname * version -> package
(** Check existence of a specific package in the universe via a
key *)
val mem_package : universe -> pkgname * version -> bool
(** check wheather a given package constraint is satisfied in a given
package status (i.e., the universe subset of [installed] packages)
@param include_features allow constraint to be satisfied by features
(i.e., Provides). Default: true
@param ignore make the lookup skip over all packages matching the given
package predicate. Default: do not ignore any package *)
val mem_installed :
?include_features: bool ->
?ignore:(package -> bool) ->
universe -> vpkg -> bool
(** Ask who provides a given feature (predicate).
@param installed : consider only installed packages (default)
@return a list of packages providing the requested feature. Each
package is paired with an optional version; if it is None, the
given package provides all possible version of the feature; it if
is Some v, the given package only provides version [v] of the
feature. *)
val who_provides : ?installed:bool -> universe -> vpkg -> (package * version option) list
(** lookup all available versions of a given package name
@param filter filter the found packages according to the given
version constraint. Default: None (i.e., no filtering) *)
val lookup_packages : ?filter:constr -> universe -> pkgname -> package list
(** lookup all installed versions of a given package name.
Shorthand for [lookup_packages] composed with filtering on installed=true *)
val get_installed : universe -> pkgname -> package list
(** return a unique integer identifier for the given package in the universe
@raise Not_found if the given package cannot be found in the universe *)
val uid_by_package : universe -> package -> int
(** return the package corresponding to the given unique identifier
@raise Not_found if no package in the universe corresponds to the given
unique identifier *)
val package_by_uid : universe -> int -> package
(** iter over all packages in the universe *)
val iter_packages : (package -> unit) -> universe -> unit
(** fold over all packages in the universe *)
val fold_packages : ('a -> package -> 'a) -> 'a -> universe -> 'a
(** iter on all packages in the universe, passing to the iteration function
both the package and its unique identifier *)
val iteri_packages : (int -> package -> unit) -> universe -> unit
(** iter on all packages grouped by name. Each package name is associated to
a list of packages with the same name and different versions *)
val iter_packages_by_name : (pkgname -> package list -> unit) -> universe -> unit
(** fold on all packages grouped by name. Each package name is associated to
a list of packages with the same name and different versions *)
val fold_packages_by_name : ('a -> pkgname -> package list -> 'a) -> 'a -> universe -> 'a
(** return the list of all unique package names *)
val package_names : universe -> pkgname list
(** conversion from universe to plain package list
@param filter only return packages matching a given
predicate. Default is to return all packages *)
val get_packages : ?filter:(package -> bool) -> universe -> package list
(** total numer of available packages (no matter whether they are
installed or not) *)
val universe_size : universe -> int
(** total number of installed packages occurring in the universe *)
val installed_size : universe -> int
(** Projection on packages having "installed: true".
Inefficient (involves Hashtbl.t cloning), use with care. *)
val status : universe -> universe
(** {5 Low-level stanza manipulation} *)
(** low-level property lookup: given a package, lookup on it a
property by name, returning its (pretty-printed, see
{!Cudf_types}) value as a string
@param pkg package to be inspected
@param property property name to be lookup (case-sensitive)
@raise Not_found if the given property name is not associated to
the given package (note that "being associated with" does not
necessarily mean that the property appears in the stanza, due to
default values) *)
val lookup_package_property : package -> string -> string
(** Same as {!Cudf.lookup_package_property}, but acting on request
information items.
To lookup the request identifier as a string (which strictly
speaking is not a property) you should lookup "request" *)
val lookup_request_property : request -> string -> string
(** Same as {!Cudf.lookup_package_property}, but acting on preamble
information items.
To lookup the preamble identifier as a string (which strictly
speaking is not a property) you should lookup "preamble" *)
val lookup_preamble_property : preamble -> string -> string
(** Same as {!Cudf.lookup_package_property}, but return a typed value. *)
val lookup_typed_package_property : package -> string -> typed_value
(** Same as {!Cudf.lookup_request_property}, but return a typed value. *)
val lookup_typed_request_property : request -> string -> typed_value
(** Same as {!Cudf.lookup_preamble_property}, but return a typed value. *)
val lookup_typed_preamble_property : preamble -> string -> typed_value
(** lookup the type declaration of a given property (either core or extra)
@param extras if given, list of extra package properties to consider when
looking for the type declaration. When not given, which is the default, the
lookup is performed only among core package properties
Note: [lookup_typedecl name] is not the same as [List.assoc
preamble.property name]; only the former takes into account core package
properties. See also {!Cudf_conf.package_typedecl}.
@raise Not_found if no declaration could be found for the given property *)
val lookup_package_typedecl : ?extra:typedecl -> string -> typedecl1
(** Check whether a version matches a version constraint,
e.g. [version_matches 1 (Some(`Eq, 2)) = false] *)
val version_matches : version -> constr -> bool
(** Same as {!Cudf.version_matches} *)
val ( |= ) : version -> constr -> bool
cudf-0.9/cudf.mllib 0000664 0000000 0000000 00000000216 13064235433 0014247 0 ustar 00root root 0000000 0000000 Cudf_types
Cudf_conf
Cudf_822_parser
Cudf_type_parser
Cudf_types_pp
Cudf_822_lexer
Cudf_type_lexer
Cudf
Cudf_parser
Cudf_checker
Cudf_printer
cudf-0.9/cudf.odocl 0000664 0000000 0000000 00000000116 13064235433 0014247 0 ustar 00root root 0000000 0000000 Cudf_types
Cudf_conf
Cudf_types_pp
Cudf
Cudf_parser
Cudf_checker
Cudf_printer
cudf-0.9/cudf.spec 0000664 0000000 0000000 00000006454 13064235433 0014114 0 ustar 00root root 0000000 0000000 Summary: CUDF (Common Upgradeability Description Format) tools and libraries
Name: cudf
Version: 0.6
Release: 1
Source: https://gforge.inria.fr/frs/?group_id=4385
URL: http://www.mancoosi.org/cudf/
License: LGPL
Group: Development/Libraries
BuildRequires: ocaml ocaml-findlib ocaml-extlib-devel
BuildRoot: %{_tmppath}/%{name}-root
%description
CUDF (for Common Upgradeability Description Format) is a format for describing
upgrade scenarios in package-based Free and Open Source Software distribution.
libCUDF is a library to manipulate so called CUDF documents. A CUDF document
describe an upgrade problem, as faced by package managers in popular
package-based GNU/Linux distributions.
%package tools
Summary: CUDF (Common Upgradeability Description Format) command-line tools
%description tools
CUDF (for Common Upgradeability Description Format) is a format for describing
upgrade scenarios in package-based Free and Open Source Software distribution.
libCUDF is a library to manipulate so called CUDF documents. A CUDF document
describe an upgrade problem, as faced by package managers in popular
package-based GNU/Linux distributions.
This package contains command line tools to manipulate CUDF and related
documents. In particular it contains cudf-check, which enables checking of
document properties such as installation consistency and matching of problems
with their solutions.
%package devel
Summary: CUDF (Common Upgradeability Description Format) C development stuff
%description devel
CUDF (for Common Upgradeability Description Format) is a format for describing
upgrade scenarios in package-based Free and Open Source Software distribution.
libCUDF is a library to manipulate so called CUDF documents. A CUDF document
describe an upgrade problem, as faced by package managers in popular
package-based GNU/Linux distributions.
This package contains the development stuff needed to use libCUDF in your C
programs.
%package ocaml-devel
Summary: CUDF (Common Upgradeability Description Format) OCaml development stuff
%description ocaml-devel
CUDF (for Common Upgradeability Description Format) is a format for describing
upgrade scenarios in package-based Free and Open Source Software distribution.
libCUDF is a library to manipulate so called CUDF documents. A CUDF document
describe an upgrade problem, as faced by package managers in popular
package-based GNU/Linux distributions.
This package contains the development stuff needed to use libCUDF in your OCaml
programs.
%prep
%setup -q
%build
make all c-lib
which /usr/bin/ocamlopt > /dev/null && make opt c-lib-opt
%install
rm -rf "$RPM_BUILD_ROOT"
make install \
DESTDIR="$RPM_BUILD_ROOT" \
LIBDIR="%{_libdir}" \
OCAMLLIBDIR="%{_libdir}/ocaml"
%check
make test
%clean
rm -rf "$RPM_BUILD_ROOT"
%files tools
%defattr(-,root,root)
%{_bindir}/cudf-check
%{_bindir}/cudf-parse-822
%files devel
%defattr(-,root,root)
%{_includedir}/cudf.h
%{_libdir}/*.a
%{_libdir}/pkgconfig/cudf.pc
%files ocaml-devel
%defattr(-,root,root)
%{_libdir}/ocaml/cudf
%changelog
* Tue Dec 22 2009 Stefano Zacchiroli
- use default rpm installation paths (in particular, /usr/lib64 on x86_64)
* Sat Dec 19 2009 Stefano Zacchiroli
- various adjustments (deps, description, native code, ...)
* Fri Dec 18 2009 Jeff Johnson
- create.
cudf-0.9/cudf_822_lexer.mll 0000664 0000000 0000000 00000003716 13064235433 0015536 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** Lexer for CUDF 822 surface syntax *)
{
open Cudf_types
open Cudf_822_parser
let get_range { Lexing.lex_start_p = start_pos;
Lexing.lex_curr_p = end_pos } =
(start_pos, end_pos)
(* Lexing.new_line is only available in OCaml 3.11 or greater *)
(* let lexing_new_line = Lexing.new_line *)
let lexing_new_line lexbuf =
let lcp = lexbuf.Lexing.lex_curr_p in
lexbuf.Lexing.lex_curr_p <-
{ lcp with
Lexing.pos_lnum = lcp.Lexing.pos_lnum + 1;
Lexing.pos_bol = lcp.Lexing.pos_cnum; }
}
let lower_letter = [ 'a' - 'z' ]
let digit = [ '0' - '9' ]
let blank = [ ' ' '\t' ]
let ident = lower_letter (lower_letter | digit | '-')*
rule token_822 = parse
| (ident as field) ':' ' '
([^'\n']* as rest) { FIELD(field, (get_range lexbuf, rest)) }
| ' ' ([^'\n']* as rest) { CONT(get_range lexbuf, rest) }
| '#' [^'\n']* ('\n'|eof) { token_822 lexbuf }
| blank* '\n' { lexing_new_line lexbuf;
EOL }
| eof { EOF }
| _ { raise (Parse_error_822
("unexpected RFC 822 token",
(lexbuf.Lexing.lex_start_p,
lexbuf.Lexing.lex_curr_p))) }
cudf-0.9/cudf_822_parser.mly 0000664 0000000 0000000 00000005143 13064235433 0015724 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
/* RFC822-like parser: surface parser for CUDF stanzas
This parser handle the surface syntax of CUDF documents: it recognizes
RFC822 stanzas, folds together line continuations, and throws away comments
and empty lines
*/
%{
open ExtLib
exception Dup_stanza
let join (r1, v) (r2, cont) = Cudf_types.extend_loc r1 r2, v ^ cont
%}
%token FIELD
%token CONT
%token EOL EOF
%type <(string * (Cudf_types.loc * string)) list list> doc_822
%type <(string * (Cudf_types.loc * string)) list option> stanza_822
%start doc_822 stanza_822
%%
doc_822:
| stanzas { $1 }
| eols stanzas { $2 }
;
stanza_822:
| stanza { Some $1 }
| eols stanza { Some $2 }
| eols EOF { None }
| EOF { None }
;
eols:
| EOL {}
| EOL eols {}
;
stanzas:
| { [] }
| stanza EOF { [ $1 ] }
| stanza eols stanzas { $1 :: $3 }
;
stanza:
| fields { let keys = List.map fst $1 in
(* check for re-defined keys *)
if List.length (List.unique keys) < List.length keys then
raise Dup_stanza
else
$1
}
;
fields:
| field { [ $1 ] }
| field fields { $1 :: $2 }
;
field:
| FIELD EOL { $1 }
| FIELD EOL linecont { let k, v = $1 in
k, (join v $3) }
;
linecont:
| CONT EOL { $1 }
| CONT EOL linecont { join $1 $3 }
;
%%
let error_wrapper f =
fun lexer lexbuf ->
try
f lexer lexbuf
with
| Parsing.Parse_error ->
raise (Cudf_types.Parse_error_822
("RFC 822 (stanza structure) parse error",
Cudf_types.loc_of_lexbuf lexbuf))
| Dup_stanza ->
raise (Cudf_types.Parse_error_822
("duplicate keys in stanza",
Cudf_types.loc_of_lexbuf lexbuf))
let doc_822 = error_wrapper doc_822
let stanza_822 = error_wrapper stanza_822
cudf-0.9/cudf_c.ml 0000664 0000000 0000000 00000003214 13064235433 0014063 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
let () =
Callback.register "parse_from_file"
(Cudf_parser.parse_from_file ?typedecl:None);
Callback.register "load_from_file"
(Cudf_parser.load_from_file ?typedecl:None);
Callback.register "load_solution_from_file"
Cudf_parser.load_solution_from_file;
Callback.register "lookup_package_property" Cudf.lookup_package_property;
Callback.register "lookup_request_property" Cudf.lookup_request_property;
Callback.register "lookup_preamble_property" Cudf.lookup_preamble_property;
Callback.register "universe_size" Cudf.universe_size;
Callback.register "installed_size" Cudf.installed_size;
Callback.register "is_consistent" Cudf_checker.is_consistent;
Callback.register "is_solution" Cudf_checker.is_solution;
Callback.register "load_universe" Cudf.load_universe;
cudf-0.9/cudf_checker.ml 0000664 0000000 0000000 00000015371 13064235433 0015254 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open ExtLib
open Printf
open Cudf_types
open Cudf
module PP = Cudf_types_pp
let (!!) pred = fun x -> not (pred x)
type inconsistency_reason =
[ `Unsat_dep of (pkgname * version) * vpkgformula
| `Conflict of (pkgname * version) * vpkglist
]
type bad_solution_reason =
[ inconsistency_reason
| `Missing_install of vpkglist
| `Missing_upgrade of vpkglist
| `Unremoved of vpkglist
| `Downgrade of vpkglist
| `Multi_upgrade of pkgname list
| `Not_kept of pkgname * version * enum_keep
]
let explain_reason = function
| `Unsat_dep ((name, ver), fmla) ->
sprintf "Cannot satisfy dependencies %s of package %s (version %d)"
(PP.string_of_vpkgformula fmla) name ver
| `Conflict ((name, ver), pkgs) ->
sprintf "Unresolved conflicts %s of package %s (version %d)"
(PP.string_of_vpkglist pkgs) name ver
| `Missing_install vpkgs ->
"Unmet installation request, missing packages: " ^
PP.string_of_vpkglist vpkgs
| `Missing_upgrade vpkgs ->
"Unmet upgrade request, missing packages: " ^
PP.string_of_vpkglist vpkgs
| `Unremoved vpkgs ->
"Unmet remove request, still present packages: " ^
PP.string_of_vpkglist vpkgs
| `Downgrade vpkgs ->
"Unmet upgrade request, not-upgraded: " ^
PP.string_of_vpkglist vpkgs
| `Multi_upgrade pkgs ->
"Unmet upgrade request, not-unique: " ^ String.concat ", " pkgs
| `Not_kept (name, ver, keep) ->
sprintf "Unmet \"Keep\" request %s of package %s (version %d)"
(PP.string_of_keep keep) name ver
(* XXX not tail-recursive *)
let satisfy_formula univ fmla =
let reason = ref [] in
let sat_pkg = mem_installed ~include_features:true univ in
let sat =
match List.filter (!! (List.exists sat_pkg)) fmla with
[] -> true
| unsat -> reason := unsat ; false
in
sat, !reason
let disjoint univ ?ignore pkgs =
match
List.filter (mem_installed ?ignore ~include_features:true univ) pkgs
with
| [] -> true, []
| pkgs -> false, pkgs
let is_consistent univ =
let msg = ref None in
try
iter_packages
(fun pkg ->
if pkg.installed then begin
(match satisfy_formula univ pkg.depends with
false, fmla ->
msg := Some (`Unsat_dep ((pkg.package, pkg.version), fmla));
raise Exit
| _ -> ());
(match disjoint univ ~ignore:((=%) pkg) pkg.conflicts with
| false, pkgs ->
msg := Some (`Conflict ((pkg.package, pkg.version), pkgs));
raise Exit
| _ -> ());
end)
univ;
true, !msg
with Exit -> false, !msg
(* for reference, see CUDF §2.3.4, "semantics of requests" *)
let is_solution (univ, req) sol =
let _ =
if universe_size sol <> installed_size sol then
prerr_endline ("WARNING: solution contains not-installed packages,"
^ " they have been ignored")
in
let sat vpkg = fst (satisfy_formula sol [[vpkg]]) in
let and_formula = List.map (fun vpkg -> [(vpkg :> vpkg)]) in
let is_succ () = (* XXX not implemented, as it will be pointless with a
diff-like encoding of solutions *)
true, [] in
let is_cons () = (* check solution consistency (i.e., dep./conflicts) *)
match is_consistent sol with
| true, _ -> true, []
| false, None -> assert false
| false, Some reason -> false, [reason] in
let install_ok () = (* check "Install" property semantics *)
match List.filter (!! sat) req.install with
| [] -> true, []
| l -> false, [`Missing_install l] in
let remove_ok () = (* check "Remove" property semantics *)
match disjoint sol req.remove with
| true, _ -> true, []
| false, pkgs -> false, [`Unremoved pkgs] in
let upgrade_ok () = (* check "Upgrade" property semantics *)
match List.filter (!! sat) req.upgrade with
| (_ :: _) as l -> false, [`Missing_upgrade l]
| [] ->
let versions_of univ name =
List.map (* real packages *)
(fun pkg -> Some pkg.version)
(get_installed univ name)
@ List.map (* virtual packages; "None" means "all versions" *)
(fun (_pkg, version) -> version)
(who_provides univ (name, None)) in
let res =
List.fold_left
(fun (ok, downgrades, multi) ((name, _constr) as vpkg) ->
match List.unique (versions_of sol name) with
| [Some v] ->
let old_installed = versions_of univ name in
if not (List.for_all
(function Some v' -> v' <= v | None -> false)
(* XXX: this None will report attempted
upgrade of unversioned virtual packages
as downgrades. Maybe right, maybe not *)
old_installed)
then
false, vpkg :: downgrades, multi
else
true && ok, downgrades, multi
| [] -> (* impossible: cause the formula is satisfied *)
assert false
| _ -> false, downgrades, name :: multi)
(true, [], [])
req.upgrade
in
(match res with
| true, _, _ -> true, []
| false, downgrades, multi ->
false,
(if downgrades <> [] then [`Downgrade downgrades] else [])
@ (if multi <> [] then [`Multi_upgrade multi] else []))
in
let keep_ok () = (* check "Keep" property semantics *)
let to_be_kept =
get_packages
~filter:(fun pkg -> pkg.installed && pkg.keep <> `Keep_none) univ in
List.fold_left
(fun (ok, reasons) pkg ->
let pkg_ok =
match pkg.keep with
| `Keep_version ->
(try
(lookup_package sol (pkg.package, pkg.version)).installed
with Not_found -> false)
| `Keep_package ->
mem_installed ~include_features:false sol (pkg.package, None)
| `Keep_feature ->
fst (satisfy_formula sol (and_formula pkg.provides))
| _ -> assert false (* [get_packages ~filter] is broken *)
in
if pkg_ok then
ok, reasons
else
false,
(`Not_kept (pkg.package, pkg.version, pkg.keep)) :: reasons)
(true, [])
to_be_kept
in
List.fold_left
(fun (is_sol, msgs) test ->
let res, msg = test () in
res && is_sol, msg @ msgs)
(true, [])
[is_succ; is_cons; install_ok; remove_ok; upgrade_ok; keep_ok]
cudf-0.9/cudf_checker.mli 0000664 0000000 0000000 00000007114 13064235433 0015421 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** Checkers for CUDF documents
Consistency and problem-solution matching. *)
open Cudf_types
open Cudf
type inconsistency_reason =
[ `Unsat_dep of (pkgname * version) * vpkgformula (** unsatisfied dep. *)
| `Conflict of (pkgname * version) * vpkglist (** unsolved conflict(s) *)
]
type bad_solution_reason =
[ inconsistency_reason
| `Missing_install of vpkglist (** install pkgs missing *)
| `Missing_upgrade of vpkglist (** upgrade pkgs missing *)
| `Unremoved of vpkglist (** remove pkgs still there *)
| `Downgrade of vpkglist (** upgrade pkgs downgraded *)
| `Multi_upgrade of pkgname list (** upgrade pkgs aren't singleton *)
| `Not_kept of pkgname * version * enum_keep (** unattended "Keep" *)
]
(** provide a string explaining a given reason, meant for error messages *)
val explain_reason : bad_solution_reason -> string
(** check whether a given package formula is satisfied by a given
package status
@return [true, []] if the formula is satisfied; [false, f]
otherwise, where f is a sub-formula of the input denoting an
unsatisfiable formula (ideally, a witness of the unsatisfiability
of the input formula) *)
val satisfy_formula : universe -> vpkgformula -> bool * vpkgformula
(** check whether a package list is not satisfied by a given package
status
@return [true, []] if the list is disjoint; [false, l]
otherwise, where l is a list of packages satisfied by the universe
(ideally, the reason of the non-disjointness) *)
val disjoint :
universe -> ?ignore:(package -> bool) -> vpkglist -> bool * vpkglist
(** @return [true, None] if the given installation is consistent,
[false, Some r] otherwise, where r is the inconsistency reason *)
val is_consistent : universe -> bool * inconsistency_reason option
(** [is_solution (status, req) sol] checks whether [sol] fulfills the CUDF
upgrade scenario described by [(status, req)]
{b Note}: the [sol] package universe must contain all relevant package
metadata (e.g. Depends, Conflicts, etc.), copied from [status], a compact
universe only containing package names and versions won't be enough. To
load compact universes see {!Cudf_parser.load_solution}.
{b Note}: in accordance with CUDF semantics, for a solution to be valid,
the solution shall correspond to a consistent universe. A solution that
does satisfy user request, but at the same time proposes an inconsistent
universe (as per {!Cudf_checker.is_consistent}) will be reported by
[is_solution] as not being a valid solution.
@return [true, []] if this is the case, [false, l]
otherwise, where r explains why the solution is bad *)
val is_solution : (universe * request) -> universe -> bool * bad_solution_reason list
cudf-0.9/cudf_conf.ml 0000664 0000000 0000000 00000003357 13064235433 0014576 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open Cudf_types
type stanza_typedecl = (string * typedecl) list
let preamble_typedecl = [
"preamble", `String None ;
"property", `Typedecl (Some []) ;
"univ-checksum", `String (Some "") ;
"status-checksum", `String (Some "") ;
"req-checksum", `String (Some "") ;
]
let package_typedecl = [
"package", `Pkgname None ;
"version", `Posint None ;
"depends", `Vpkgformula (Some []) ;
"conflicts", `Vpkglist (Some []) ;
"provides", `Veqpkglist (Some []) ;
"installed", `Bool (Some false) ;
"was-installed", `Bool (Some false) ;
"keep", `Enum (keep_enums, Some "none") ;
]
let request_typedecl = [
"request", `String None ;
"install", `Vpkglist (Some []) ;
"remove", `Vpkglist (Some []) ;
"upgrade", `Vpkglist (Some []) ;
]
let stanza_typedecl = [
"preamble", preamble_typedecl ;
"package", package_typedecl ;
"request", request_typedecl ;
]
cudf-0.9/cudf_conf.mli 0000664 0000000 0000000 00000003550 13064235433 0014742 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open Cudf_types
(** Mapping (in the form of associative list) from stanza postmarks to type
declarations.
Keys in the map are usually only those prescribed by the CUDF
specification, namely "preamble", "package", and "request". Values in the
map are type declarations for each supported property of that stanza;
usually they only represent core property schemata (see CUDF §2.2.3).
*)
type stanza_typedecl = (string * typedecl) list
(** {5 Global configuration} *)
(** Default stanza types for parsing CUDF documents.
For what concerns package stanzas, available types can be extended by using
"property" declaration in the preamble stanza.
*)
val stanza_typedecl: stanza_typedecl
(** {6 Direct access to per-stanza type declaration} *)
(** Preamble schemata *)
val preamble_typedecl: typedecl
(** Package description schemata
I.e. type declarataion for all core package properties *)
val package_typedecl: typedecl
(** Request schemata *)
val request_typedecl: typedecl
cudf-0.9/cudf_parser.ml 0000664 0000000 0000000 00000024065 13064235433 0015144 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2015 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open ExtLib
open Printf
open Cudf
open Cudf_types
type cudf_parser = {
lexbuf: Lexing.lexbuf ;
fname: string ;
mutable typedecl: Cudf_conf.stanza_typedecl ;
priv_in_chan: in_channel option;
(* in_channel to be closed upon close() invocation, to avoid leaving up to
OCaml GC when to close it. Will be set only if it is Cudf_parser itself
who has created the in_channel, e.g., upon Cudf_parser.from_file *)
}
type loc_map = (string * loc) list
exception Parse_error of string * loc
let parse_error loc msg = raise (Parse_error (msg, loc))
let from_in_channel ?(typedecl=Cudf_conf.stanza_typedecl) ic =
{ lexbuf = Lexing.from_channel ic ;
typedecl = typedecl ;
fname = "" ;
priv_in_chan = None ;
}
let from_IO_in_channel ?(typedecl=Cudf_conf.stanza_typedecl) ic =
let f s n = try IO.input ic s 0 n with IO.No_more_input -> 0 in
{ lexbuf = Lexing.from_function f;
typedecl = typedecl ;
fname = "" ;
priv_in_chan = None ;
}
let from_file ?(typedecl=Cudf_conf.stanza_typedecl) fname =
(* Syntax error with OCaml 3.10.2:
* { from_in_channel ?typedecl (open_in fname)
* with fname = fname } *)
let ic = open_in fname in
{ lexbuf = Lexing.from_channel ic ;
typedecl = typedecl ;
fname = fname ;
priv_in_chan = Some ic ;
}
let close p =
match p.priv_in_chan with
| None -> ()
| Some ic -> close_in ic
let parse_stanza p =
try
(match Cudf_822_parser.stanza_822 Cudf_822_lexer.token_822 p.lexbuf with
| Some stanza ->
List.fold_right (* split loc_map from (string * loc) stanzas *)
(* non tail recursive, but should be ok: stanzas are short *)
(fun (k, (loc, v)) (locs, stanza) ->
(k, loc) :: locs, (k, v) :: stanza)
stanza ([], [])
| None -> raise End_of_file)
with Parse_error_822 (msg, loc) -> raise (Syntax_error (msg, loc))
let loc_lookuper locs =
(fun p -> try List.assoc p locs
with Not_found -> prerr_endline "non located property" ; assert false)
let type_check_stanza ?locs stanza types =
let lookup_loc =
match locs with
| None -> (fun p -> dummy_loc)
| Some locs -> loc_lookuper locs in
let typed_stanza =
List.map
(fun (k, v) ->
try
let decl = List.assoc k types in
let typed_v = Cudf_types_pp.parse_value (type_of_typedecl decl) v in
k, typed_v
with
| Not_found ->
parse_error (lookup_loc k)
(sprintf "unexpected property \"%s\" in this stanza" k)
| Cudf_types_pp.Type_error (typ, v) -> (* localize type errors *)
raise (Cudf_types.Type_error (typ, v, lookup_loc k)))
stanza in
let defaults, missing = (* deal with missing properties *)
List.fold_left
(fun (defaults, missing) (name, ty1) ->
match value_of_typedecl ty1, List.mem_assoc name typed_stanza with
| None, true -> defaults, missing (* mandatory, present *)
| None, false -> defaults, (name :: missing) (* mandatory, missing *)
| Some v, true -> defaults, missing (* optional, present *)
| Some v, false -> (* optional, missing *)
(name, v) :: defaults, missing)
([], []) types
in
if missing <> [] then begin
let loc = match stanza with [] -> dummy_loc | (k,_) :: _ -> lookup_loc k in
parse_error loc (sprintf "missing mandatory properties: %s"
(String.concat ", " missing))
end;
typed_stanza @ defaults
(** Cast a typed stanza starting with "package: " to a {!Cudf.package}.
ASSUMPTION: type checking of the stanza has already happend, in particular
all extra properties have already been checked for allowance. *)
let bless_package stanza =
let p = default_package in (* assumption: should be completely overrode *)
let rec aux p = function
| ("package", `Pkgname v) :: tl -> aux { p with package = v } tl
| ("version", `Posint v) :: tl -> aux { p with version = v } tl
| ("depends", `Vpkgformula v) :: tl -> aux { p with depends = v } tl
| ("conflicts", `Vpkglist v) :: tl -> aux { p with conflicts = v } tl
| ("provides", `Veqpkglist v) :: tl -> aux { p with provides = v } tl
| ("installed", `Bool v) :: tl -> aux { p with installed = v } tl
| ("was-installed", `Bool v) :: tl -> aux { p with was_installed = v } tl
| ("keep", `Enum (_, v)) :: tl ->
aux { p with keep = Cudf_types_pp.parse_keep v } tl
| (k, (v: typed_value)) :: tl ->
aux { p with pkg_extra = (k, v) :: p.pkg_extra } tl
| [] -> p
in
let p' = aux p stanza in
{ p' with pkg_extra = List.rev p'.pkg_extra }
(** Cast a typed stanza starting with "preamble: " to a {!Cudf.preamble}
ASSUMPTION: as per {!Cudf_parser.bless_package} above. *)
let bless_preamble stanza =
let p = default_preamble in (* assumption: should be completely overrode *)
let rec aux p = function
| ("preamble", `String v) :: tl -> aux { p with preamble_id = v } tl
| ("property", `Typedecl v) :: tl -> aux { p with property = v } tl
| ("univ-checksum", `String v) :: tl -> aux { p with univ_checksum = v } tl
| ("status-checksum", `String v) :: tl -> aux { p with status_checksum = v } tl
| ("req-checksum", `String v) :: tl -> aux { p with req_checksum = v } tl
| [] -> p
| _ -> assert false
in
aux p stanza
(** Cast a typed stanza starting with "request: " to a {!Cudf.request}.
ASSUMPTION: as per {!Cudf_parser.bless_package} above. *)
let bless_request stanza =
let r = default_request in (* assumption: should be completely overrode *)
let rec aux r = function
| ("request", `String v) :: tl -> aux { r with request_id = v } tl
| ("install", `Vpkglist v) :: tl -> aux { r with install = v } tl
| ("remove", `Vpkglist v) :: tl -> aux { r with remove = v } tl
| ("upgrade", `Vpkglist v) :: tl -> aux { r with upgrade = v } tl
| (k, (v: typed_value)) :: tl ->
aux { r with req_extra = (k, v) :: r.req_extra } tl
| [] -> r
in
let r' = aux r stanza in
{ r' with req_extra = List.rev r'.req_extra }
let parse_item' p =
let locs, stanza =
try
parse_stanza p
with Syntax_error (msg, loc) -> parse_error loc msg in
let lookup_loc = loc_lookuper locs in
let typed_stanza =
match stanza with
| [] -> eprintf "empty stanza\n%!"; assert false
| (postmark, _) :: _ ->
(try
type_check_stanza ~locs stanza (List.assoc postmark p.typedecl)
with Not_found ->
parse_error (lookup_loc postmark)
(sprintf "Unknown stanza type, starting with \"%s\" postmark."
postmark)) in
let item =
match typed_stanza with
| [] -> assert false
| ("preamble", _) :: _ ->
let preamble = bless_preamble typed_stanza in
p.typedecl <- (* update type declaration for "package" stanza *)
(let pkg_typedecl =
(List.assoc "package" p.typedecl) @ preamble.property in
("package", pkg_typedecl)
:: List.remove_assoc "package" p.typedecl);
`Preamble preamble
| ("package", _) :: _ -> `Package (bless_package typed_stanza)
| ("request", _) :: _ -> `Request (bless_request typed_stanza)
| _ -> assert false in
(locs, item)
let parse_item p = snd (parse_item' p)
let get_postmark = function
| `Package pkg -> pkg.package
| `Request req -> req.request_id
| `Preamble pre -> pre.preamble_id
let parse p =
let pre, pkgs, req = ref None, ref [], ref None in
let rec aux_pkg () =
match parse_item' p with
| locs, `Package pkg -> pkgs := pkg :: !pkgs ; aux_pkg ()
| locs, `Request req' -> req := Some req' (* stop recursion after req *)
| locs, `Preamble pre ->
parse_error (loc_lookuper locs pre.preamble_id) "late preamble"
in
let parse () =
try
(match parse_item p with (* parse first item *)
| `Preamble pre' ->
pre := Some pre' ;
(try aux_pkg () with End_of_file -> ())
| `Package pkg ->
pkgs := [pkg] ;
(try aux_pkg () with End_of_file -> ())
| `Request req' -> req := Some req')
with End_of_file -> ()
in
(try
parse () ;
with Cudf_types.Type_error (typ, v, loc) ->
parse_error loc
(sprintf
("a value of type \"%s\" was expected, but \"%s\" has been found")
(Cudf_types_pp.string_of_type typ)
(Cudf_types_pp.string_of_value v)));
(try (* check for forbidden trailing content *)
let locs, item = parse_item' p in
parse_error (loc_lookuper locs (get_postmark item))
"trailing stanzas after final request stanza"
with End_of_file -> ());
(!pre, List.rev !pkgs, !req)
let load p =
let pre, pkgs, req = parse p in
(pre, load_universe pkgs, req)
let load_solution p univ =
let pre, sol_pkgs, _ = parse p in
let expand_package pkg =
let old_pkg =
try
lookup_package univ (pkg.package, pkg.version)
with Not_found ->
parse_error dummy_loc
(sprintf "unknown package (%s,%d) found in solution"
pkg.package pkg.version)
in
{ old_pkg with installed = pkg.installed } in
let sol_univ = load_universe (List.map expand_package sol_pkgs) in
pre, sol_univ
let parser_wrapper ?typedecl fname f =
let ic = open_in fname in
let p = from_in_channel ?typedecl ic in
finally (fun () -> close_in ic ; close p) f p
let parse_from_file ?typedecl fname = parser_wrapper ?typedecl fname parse
let load_from_file ?typedecl fname = parser_wrapper ?typedecl fname load
let load_solution_from_file fname univ =
parser_wrapper fname (fun p -> load_solution p univ)
cudf-0.9/cudf_parser.mli 0000664 0000000 0000000 00000014023 13064235433 0015306 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** Parser for CUDF related documents *)
open Cudf
open Cudf_types
(** a CUDF parser opened on some input source *)
type cudf_parser
(** Error during parsing (syntax error, type error, ...). Arguments are error
message and error location. *)
exception Parse_error of string * loc
(** create a CUDF parser reading data from an input channel
@param typedecl (initial) per-stanza and per-property type declarations to
be used while parsing. Default: {!Cudf_conf.stanza_typedecl}
*)
val from_in_channel : ?typedecl:Cudf_conf.stanza_typedecl ->
in_channel -> cudf_parser
(** create a CUDF parser reading data from an Extlib input channel
@param typedecl (initial) per-stanza and per-property type declarations to
be used while parsing. Default: {!Cudf_conf.stanza_typedecl}
*)
val from_IO_in_channel : ?typedecl:Cudf_conf.stanza_typedecl ->
IO.input -> cudf_parser
(** create a CUDF parser reading data from a file
@param typedecl as per {!Cudf_parser.from_in_channel}
*)
val from_file : ?typedecl:Cudf_conf.stanza_typedecl ->
string -> cudf_parser
(** Dispose a CUDF parser.
Afterwards, the parser should not be used any longer *)
val close : cudf_parser -> unit
(** {6 Full CUDF document parsing}
"parse_*" functions offer plain syntax parsing, with no semantic
interpretation of what is being parsed. "load_*" functions offer
the latter, hence also checking for semantic constraints (such as
the lack of key duplication).
All full parsing function are granted to raise only
{!Cudf_parser.Parse_error}; finer grained exception are mapped to it.
*)
(** parse a CUDF document (or a universe) as a whole
@return a triple [preamble, packages, request] where preamble and request
are returned only if actually met in the parsed document. Note that a
document with no request part is not a valid CUDF document (but might still
be used to represent solver solutions, for instance).
@raise Parse_error when an error during parsing is encountered (might be a
syntax error, a type error, ..)
*)
val parse : cudf_parser -> preamble option * package list * request option
(** same as {!Cudf_parser.parse}, but additionally loads the package
list as an abstract {!Cudf.universe}.
{b Note}: to load compact universes (i.e. only containing package names,
versions, and installed status) that will be tested as solutions you should
use {!Cudf_parser.load_solution} instead: the present function does not
expand missing metadata with respect to the initial status.
@raise Parse_error as {!Cudf_parser.parse} does
@raise Cudf.Constraint_violation as {!Cudf.load_universe} does
*)
val load : cudf_parser -> preamble option * universe * request option
(** Load a solution wrt to a given CUDF document, whose universe is given.
Solution format is as per Appendix B of CUDF 2.0 spec
@raise Parse_error as {!Cudf_parser.parse} does *)
val load_solution : cudf_parser -> universe -> preamble option * universe
(** Shorthand: parse a file given its name *)
val parse_from_file : ?typedecl:Cudf_conf.stanza_typedecl ->
string -> preamble option * package list * request option
(** Shorthand: load from a file given its name *)
val load_from_file : ?typedecl:Cudf_conf.stanza_typedecl ->
string -> preamble option * universe * request option
(** Shorthand: load a solution from a file given its name *)
val load_solution_from_file : string -> universe -> preamble option * universe
(** {6 Item-by-item CUDF parsing} *)
(** Parse the next information item (either a package description, a user
request, or a preamble) from the given input channel.
Beware that parsing is stateful; in particular when the preamble is parsed,
the list of allowed properties for future package stanzas is internally
updated.
*)
val parse_item : cudf_parser -> cudf_item
(** {6 Low-level parsing functions}
The following parsing function usually raise fine grained exceptions such
as {!Cudf_types.Syntax_error} and {!Cudf_types.Type_error}.
*)
type loc_map = (string * loc) list
(** Parse a file stanza (i.e., a RFC822-like stanza, with the notable
simplification that all field/value pairs are one-liners). Strip
any heading blanks lines leading to the first available
field/value pair.
@return an associative list mapping field name to field values and a
location map mapping field names to locations
@raise End_of_file if no other stanza is available due to reached EOF
@raise Cudf_types.Syntax_error when a syntax error is encountered
*)
val parse_stanza : cudf_parser -> loc_map * string stanza
(** Type check an untyped stanza according to a given set of type declarations.
Also take care of default values, adding missing properties where needed;
fail if a required property is missing.
@param loc location map from prop name to locations, default is None
(i.e. use dummy locations)
@raise Syntax_error if a property does not match its declared type; this
exception is also raised when an undeclared property is encountered
@raise Type_error when a property has a value of the wrong type
*)
val type_check_stanza : ?locs:loc_map ->
string stanza -> typedecl -> typed_value stanza
cudf-0.9/cudf_printer.ml 0000664 0000000 0000000 00000013057 13064235433 0015332 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open ExtLib
open Printf
open Cudf
open Cudf_types
open Cudf_types_pp
let pp_property out (n, s) = fprintf out "%s: %s\n" n s
let pp_io_property out (n, s) = IO.printf out "%s: %s\n" n s
let pp_sep out = output_char out '\n'
let pp_io_sep out = IO.write out '\n'
let pp_package_gen ~pp_property out pkg =
let pp = pp_property out in
pp ("package", string_of_pkgname pkg.package);
pp ("version", string_of_version pkg.version);
if pkg.depends <> default_package.depends then
pp ("depends", string_of_vpkgformula pkg.depends);
if pkg.conflicts <> default_package.conflicts then
pp ("conflicts", string_of_vpkglist pkg.conflicts);
if pkg.provides <> default_package.provides then
pp ("provides", string_of_vpkglist (pkg.provides :> vpkg list));
if pkg.installed <> default_package.installed then
pp ("installed", string_of_bool pkg.installed);
if pkg.was_installed <> default_package.was_installed then
pp ("was-installed", string_of_bool pkg.was_installed);
if pkg.keep <> default_package.keep then
pp ("keep", string_of_keep pkg.keep);
List.iter (fun (k, v) -> pp (k, string_of_value v)) pkg.pkg_extra
let pp_request_gen ~pp_property out req =
let pp = pp_property out in
pp ("request", req.request_id);
if req.install <> default_request.install then
pp ("install", string_of_vpkglist req.install);
if req.remove <> default_request.remove then
pp ("remove", string_of_vpkglist req.remove);
if req.upgrade <> default_request.upgrade then
pp ("upgrade", string_of_vpkglist req.upgrade);
List.iter (fun (k, v) -> pp (k, string_of_value v)) req.req_extra
let pp_preamble_gen ~pp_property out pre =
let pp = pp_property out in
pp ("preamble", pre.preamble_id);
if pre.property <> default_preamble.property then
pp ("property", string_of_typedecl pre.property);
if pre.univ_checksum <> default_preamble.univ_checksum then
pp ("univ-checksum", pre.univ_checksum);
if pre.status_checksum <> default_preamble.status_checksum then
pp ("status-checksum", pre.status_checksum);
if pre.req_checksum <> default_preamble.req_checksum then
pp ("req-checksum", pre.req_checksum)
let pp_universe_gen ~pp_package ~pp_sep out univ =
iter_packages (fun pkg -> pp_package out pkg; pp_sep out) univ
let pp_packages_gen ~pp_package ~pp_sep out pkgs =
List.iter (fun pkg -> pp_package out pkg; pp_sep out) pkgs
let pp_cudf_gen ~pp_preamble ~pp_universe ~pp_request ~pp_sep out
(pre, univ, req) =
pp_preamble out pre;
pp_sep out;
pp_universe out univ;
pp_request out req
let pp_doc_gen ~pp_preamble ~pp_packages ~pp_request ~pp_sep out (pre, pkgs, req) =
Option.may (fun pre -> pp_preamble out pre; pp_sep out) pre;
pp_packages out pkgs;
pp_request out req
let pp_solution_gen ~pp_preamble ~pp_universe ~pp_sep out (pre, univ) =
pp_preamble out pre;
pp_sep out;
pp_universe out univ
let pp_item_gen ~pp_package ~pp_request ~pp_preamble out = function
| `Package pkg -> pp_package out pkg
| `Request req -> pp_request out req
| `Preamble pre -> pp_preamble out pre
(** {6 Pretty print to standard output channels} *)
let pp_package out p = pp_package_gen ~pp_property out p
let pp_request out r = pp_request_gen ~pp_property out r
let pp_preamble out p = pp_preamble_gen ~pp_property out p
let pp_universe out u = pp_universe_gen ~pp_package ~pp_sep out u
let pp_packages out p = pp_packages_gen ~pp_package ~pp_sep out p
let pp_cudf out c =
pp_cudf_gen ~pp_preamble ~pp_universe ~pp_request ~pp_sep out c
let pp_doc out d =
pp_doc_gen ~pp_preamble ~pp_packages ~pp_request ~pp_sep out d
let pp_solution out s = pp_solution_gen ~pp_preamble ~pp_universe ~pp_sep out s
let pp_item out i = pp_item_gen ~pp_package ~pp_request ~pp_preamble out i
(** {6 Pretty print to abstract output channels} *)
let pp_io_package out p = pp_package_gen ~pp_property:pp_io_property out p
let pp_io_request out r = pp_request_gen ~pp_property:pp_io_property out r
let pp_io_preamble out p = pp_preamble_gen ~pp_property:pp_io_property out p
let pp_io_universe out u =
pp_universe_gen ~pp_package:pp_io_package ~pp_sep:pp_io_sep out u
let pp_io_packages out p =
pp_packages_gen ~pp_package:pp_io_package ~pp_sep:pp_io_sep out p
let pp_io_cudf out c =
pp_cudf_gen ~pp_preamble:pp_io_preamble
~pp_universe:pp_io_universe ~pp_request:pp_io_request ~pp_sep:pp_io_sep
out c
let pp_io_doc out d =
pp_doc_gen ~pp_preamble:pp_io_preamble ~pp_packages:pp_io_packages
~pp_request:pp_io_request ~pp_sep:pp_io_sep
out d
let pp_io_solution out s =
pp_solution_gen ~pp_preamble:pp_io_preamble ~pp_universe:pp_io_universe
~pp_sep:pp_io_sep out s
let pp_io_item out i =
pp_item_gen ~pp_package:pp_io_package ~pp_request:pp_io_request
~pp_preamble:pp_io_preamble
out i
cudf-0.9/cudf_printer.mli 0000664 0000000 0000000 00000007717 13064235433 0015511 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** Pretty printing of CUDF macro-components (documents, stanzas, ...)
For pretty printing of micro-components see {!module: Cudf_types_pp}.
*)
open Cudf
(** {6 Pretty print to standard output channels} *)
val pp_cudf : out_channel -> cudf -> unit
val pp_doc : out_channel -> cudf_doc -> unit
val pp_solution : out_channel -> solution -> unit
val pp_item : out_channel -> cudf_item -> unit
val pp_package : out_channel -> package -> unit
val pp_preamble : out_channel -> preamble -> unit
val pp_request : out_channel -> request -> unit
val pp_packages : out_channel -> package list -> unit
val pp_universe : out_channel -> universe -> unit
(** {6 Pretty print to abstract output channels}
Note: you can write to string using these methods using the following
pattern:
[let o = IO.output_string () in ... Cudf_printer.pp_* o ...; IO.close_out o]
*)
val pp_io_cudf : 'a IO.output -> cudf -> unit
val pp_io_doc : 'a IO.output -> cudf_doc -> unit
val pp_io_solution : 'a IO.output -> solution -> unit
val pp_io_item : 'a IO.output -> cudf_item -> unit
val pp_io_package : 'a IO.output -> package -> unit
val pp_io_preamble : 'a IO.output -> preamble -> unit
val pp_io_request : 'a IO.output -> request -> unit
val pp_io_packages : 'a IO.output -> package list -> unit
val pp_io_universe : 'a IO.output -> universe -> unit
(** {6 Generic, higher-order pretty printers}
Usually, you shouldn't need those and you should be well served by the
above printers.
To bootstrap usage of the generic printers, you'll need to provide a
pp_property argument --- that takes a property as a pair of name/value
strings and print them on a generic output --- and then proceed composing
generic printers together.
*)
val pp_package_gen :
pp_property:('out -> string * string -> unit) ->
'out -> Cudf.package -> unit
val pp_request_gen :
pp_property:('out -> string * string -> unit) ->
'out -> Cudf.request -> unit
val pp_preamble_gen :
pp_property:('out -> string * string -> unit) ->
'out -> Cudf.preamble -> unit
val pp_universe_gen :
pp_package:('out -> Cudf.package -> unit) ->
pp_sep:('out -> unit) ->
'out -> Cudf.universe -> unit
val pp_packages_gen :
pp_package:('out -> Cudf.package -> unit) ->
pp_sep:('out -> unit) ->
'out -> Cudf.package list -> unit
val pp_cudf_gen :
pp_preamble:('out -> Cudf.preamble -> unit) ->
pp_universe:('out -> Cudf.universe -> unit) ->
pp_request:('out -> Cudf.request -> unit) ->
pp_sep:('out -> unit) ->
'out -> Cudf.cudf -> unit
val pp_doc_gen :
pp_preamble:('out -> Cudf.preamble -> unit) ->
pp_packages:('out -> Cudf.package list -> unit) ->
pp_request:('out -> Cudf.request -> unit) ->
pp_sep:('out -> unit) ->
'out -> Cudf.cudf_doc -> unit
val pp_solution_gen :
pp_preamble:('out -> Cudf.preamble -> unit) ->
pp_universe:('out -> Cudf.universe -> unit) ->
pp_sep:('out -> unit) ->
'out -> Cudf.solution -> unit
val pp_item_gen :
pp_package:('out -> Cudf.package -> unit) ->
pp_request:('out -> Cudf.request -> unit) ->
pp_preamble:('out -> Cudf.preamble -> unit) ->
'out -> Cudf.cudf_item -> unit
cudf-0.9/cudf_type_lexer.mll 0000664 0000000 0000000 00000004513 13064235433 0016200 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** Lexer for CUDF values *)
{
open Cudf_types
open Cudf_type_parser
}
let lower_letter = [ 'a' - 'z' ]
let upper_letter = [ 'A' - 'Z' ]
let letter = lower_letter | upper_letter
let digit = [ '0' - '9' ]
let blank = [ ' ' '\t' ]
let blanks = blank+
let ident = lower_letter (lower_letter | digit | '-')*
let pkgname = (letter | digit | ['-' '+' '.' '/' '@' '(' ')' '%'])+
rule token_cudf = parse
| "true!" { VPKGTRUE }
| "false!" { VPKGFALSE }
| ident as s { IDENT s }
| '+'? (digit+ as s) { POSINT s }
| '-' digit+ as s { NEGINT s }
| pkgname as s { PKGNAME s }
| (">=" | "<=") as op { RELOP op }
| "!=" as op { RELOP op }
| ('>' | '<') as op { RELOP (String.make 1 op) }
| '[' { LBRACKET }
| ']' { RBRACKET }
| '(' { LPAREN }
| ')' { RPAREN }
| ',' { COMMA }
| '|' { PIPE }
| ':' { COLON }
| '=' { EQ }
| '"' { let buf = Buffer.create 11 in
qstring buf lexbuf }
| blank+ { token_cudf lexbuf }
| eof { EOL } (* single-line parsing: EOF means in fact EOL *)
and qstring buf = parse
| "\\\"" { Buffer.add_string buf "\"";
qstring buf lexbuf }
| "\\\\" { Buffer.add_string buf "\\";
qstring buf lexbuf }
| '"' { QSTRING (Buffer.contents buf) }
| [^ '\n' '\r' '\\' '"']+ as s { Buffer.add_string buf s;
qstring buf lexbuf }
| _ { raise (Parse_error_822
("unexpected end of quoted string",
(lexbuf.Lexing.lex_start_p,
lexbuf.Lexing.lex_curr_p))) }
cudf-0.9/cudf_type_parser.mly 0000664 0000000 0000000 00000013177 13064235433 0016400 0 ustar 00root root 0000000 0000000 /*****************************************************************************/
/* libCUDF - CUDF (Common Upgrade Description Format) manipulation library */
/* Copyright (C) 2009-2012 Stefano Zacchiroli */
/* */
/* This library is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU Lesser General Public License as */
/* published by the Free Software Foundation, either version 3 of the */
/* License, or (at your option) any later version. A special linking */
/* exception to the GNU Lesser General Public License applies to this */
/* library, see the COPYING file for more information. */
/*****************************************************************************/
/* CUDF type parser: parse values belonging to CUDF types.
Used as the basic building block to parse CUDF stanzas retuned by
Cudf_822_paser. Generally, this parser does not need to parse multi-line
values (as they are all normalized to single-line values by
Cudf_822_parser.)
*/
%{
(** a non-located parse error carrying an error message (...) *)
exception Parse_error_msg of string
let parse_relop = function
| "=" -> `Eq
| "!=" -> `Neq
| ">=" -> `Geq
| ">" -> `Gt
| "<=" -> `Leq
| "<" -> `Lt
| _ -> assert false (* lexer shouldn't have returned such a RELOP! *)
(** parse a type declaration with no default value *)
let parse_typename = function
| "int" -> `Int
| "posint" -> `Posint
| "nat" -> `Nat
| "bool" -> `Bool
| "string" -> `String
| "pkgname" -> `Pkgname
| "ident" -> `Ident
| "vpkg" -> `Vpkg
| "vpkgformula" -> `Vpkgformula
| "vpkglist" -> `Vpkglist
| "veqpkg" -> `Veqpkg
| "veqpkglist" -> `Veqpkglist
| s -> raise (Parse_error_msg ("unknown type name: " ^ s))
%}
%token IDENT PKGNAME QSTRING RELOP
%token POSINT NEGINT
%token LBRACKET RBRACKET LPAREN RPAREN
%token COMMA PIPE COLON EQ
%token VPKGTRUE VPKGFALSE
%token EOL
%type int_top
%type ident_top qstring_top
%type pkgname_top
%type vpkg_top
%type vpkglist_top
%type vpkgformula_top
%type typedecl_top
%type type_top
%start int_top ident_top qstring_top pkgname_top type_top
%start vpkg_top vpkglist_top vpkgformula_top typedecl_top
%%
int_top: int EOL { $1 } ;
ident_top: ident EOL { $1 } ;
qstring_top: qstring EOL { $1 } ;
pkgname_top: pkgname EOL { $1 } ;
vpkg_top: vpkg EOL { $1 } ;
vpkglist_top: vpkglist EOL { $1 } ;
vpkgformula_top: vpkgformula EOL { $1 } ;
typedecl_top: typedecl EOL { $1 } ;
type_top: type_ EOL { $1 } ;
ident: IDENT { $1 } ;
qstring: QSTRING { $1 } ;
version: POSINT { int_of_string $1 } ;
pkgname:
| PKGNAME { $1 }
| IDENT { $1 }
| POSINT { $1 }
| NEGINT { $1 }
;
relop:
| RELOP { parse_relop $1 }
| EQ { `Eq }
;
int:
| POSINT { int_of_string $1 }
| NEGINT { int_of_string $1 }
;
vpkg:
| pkgname { ($1, None) }
| pkgname relop version { ($1, Some ($2, $3)) }
;
vpkglist:
| { [] }
| vpkglist_ne { $1 }
;
vpkglist_ne:
| vpkg { [ $1 ] }
| vpkg COMMA vpkglist_ne { $1 :: $3 }
;
vpkgformula:
| and_formula { $1 }
| VPKGTRUE { [] }
| VPKGFALSE { [ [] ] }
;
and_formula:
| or_formula { [ $1 ] }
| or_formula COMMA and_formula { $1 :: $3 }
;
or_formula:
| vpkg { [ $1 ] }
| vpkg PIPE or_formula { $1 :: $3 }
;
/* non trivial formula, i.e. a formula based which is syntactially different from
both an integer and an identifier */
vpkgformula_ntriv:
| and_formula_ntriv { $1 }
| VPKGTRUE { [] }
| VPKGFALSE { [ [] ] }
;
and_formula_ntriv:
| or_formula_ntriv { [ $1 ] }
| or_formula COMMA and_formula { $1 :: $3 }
;
or_formula_ntriv:
| vpkg_ntriv { [ $1 ] }
| vpkg PIPE or_formula { $1 :: $3 }
;
vpkg_ntriv:
| PKGNAME { ($1, None) }
| pkgname relop version { ($1, Some ($2, $3)) }
;
typedecl:
| { [] }
| typedecl_ne { $1 }
;
typedecl_ne:
| typedecl_ { [ $1 ] }
| typedecl_ COMMA typedecl_ne { $1 :: $3 }
;
typedecl_:
| ident COLON type_ { ($1, Cudf_types.typedecl_of_type $3) }
| ident COLON type_
EQ LBRACKET typed_value RBRACKET { let name, typ, v = $1, $3, $6 in
(name,
Cudf_types.typedecl_of_value
(Cudf_types.cast typ v)) }
;
type_:
| ident { parse_typename $1 }
| ident LBRACKET enums RBRACKET { if $1 = "enum"
then `Enum $3
else raise Parsing.Parse_error }
;
enums:
| ident { [ $1 ] }
| ident COMMA enums { $1 :: $3 }
;
typed_value:
| { `Vpkglist [] }
| ident { `Ident $1 }
| int { `Int $1 }
| qstring { `String $1 }
| vpkgformula_ntriv { `Vpkgformula $1 }
;
%%
open ExtLib
let error_wrapper f =
fun lexer lexbuf ->
let syntax_error msg =
raise (Cudf_types.Syntax_error (msg, Cudf_types.loc_of_lexbuf lexbuf)) in
try
f lexer lexbuf
with
| Parsing.Parse_error -> syntax_error "parse error"
| Failure _m when String.starts_with _m "lexing" ->
syntax_error "lexer error"
| Cudf_types.Type_error _ -> syntax_error "type error"
| Parse_error_msg msg -> syntax_error msg
let int_top = error_wrapper int_top
let ident_top = error_wrapper ident_top
let pkgname_top = error_wrapper pkgname_top
let vpkg_top = error_wrapper vpkg_top
let vpkglist_top = error_wrapper vpkglist_top
let vpkgformula_top = error_wrapper vpkgformula_top
let typedecl_top = error_wrapper typedecl_top
let qstring_top = error_wrapper qstring_top
let type_top = error_wrapper type_top
cudf-0.9/cudf_types.ml 0000664 0000000 0000000 00000016415 13064235433 0015014 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open ExtLib
open Printf
type version = int
type relop = [`Eq|`Neq|`Geq|`Gt|`Leq|`Lt]
type constr = (relop * version) option
type pkgname = string
type vpkg = pkgname * constr
type vpkglist = vpkg list
type vpkgformula = vpkg list list
type veqpkg = pkgname * ([`Eq] * version) option
type veqpkglist = veqpkg list
type enum_keep = [`Keep_version | `Keep_package | `Keep_feature | `Keep_none ]
type typ =
[ `Int | `Posint | `Nat | `Bool | `String | `Enum of string list
| `Pkgname | `Ident
| `Vpkg | `Vpkgformula | `Vpkglist | `Veqpkg | `Veqpkglist
| `Typedecl ]
type typedecl1 =
[ `Int of int option | `Posint of int option | `Nat of int option
| `Bool of bool option | `String of string option
| `Pkgname of string option | `Ident of string option
| `Enum of string list * string option | `Vpkg of vpkg option
| `Vpkgformula of vpkgformula option | `Vpkglist of vpkglist option
| `Veqpkg of veqpkg option | `Veqpkglist of veqpkglist option
| `Typedecl of typedecl option ]
and typedecl = (string * typedecl1) list
type typed_value =
[ `Int of int | `Posint of int | `Nat of int | `Bool of bool
| `String of string | `Pkgname of string | `Ident of string
| `Enum of string list * string | `Vpkg of vpkg
| `Vpkgformula of vpkgformula | `Vpkglist of vpkglist
| `Veqpkg of veqpkg | `Veqpkglist of veqpkglist
| `Typedecl of typedecl ]
type 'ty stanza = (string * 'ty) list
type loc = Lexing.position * Lexing.position
let dummy_loc: loc = Lexing.dummy_pos, Lexing.dummy_pos
let extend_loc (r1_start, _r1_end) (_r2_start, r2_end) = (r1_start, r2_end)
let loc_of_lexbuf b = (b.Lexing.lex_start_p, b.Lexing.lex_curr_p)
exception Parse_error_822 of string * loc (* *)
exception Syntax_error of string * loc (* *)
exception Type_error of typ * typed_value * loc (* *)
let keep_enums = ["version"; "package"; "feature"; "none"]
let keep_type = `Enum keep_enums
let type_of_typedecl = function
| `Int _ -> `Int
| `Posint _ -> `Posint
| `Nat _ -> `Nat
| `Bool _ -> `Bool
| `String _ -> `String
| `Pkgname _ -> `Pkgname
| `Ident _ -> `Ident
| `Enum (enums, _) -> `Enum enums
| `Vpkg _ -> `Vpkg
| `Vpkgformula _ -> `Vpkgformula
| `Vpkglist _ -> `Vpkglist
| `Veqpkg _ -> `Veqpkg
| `Veqpkglist _ -> `Veqpkglist
| `Typedecl _ -> `Typedecl
let typedecl_of_type = function
| `Int -> `Int None
| `Posint -> `Posint None
| `Nat -> `Nat None
| `Bool -> `Bool None
| `String -> `String None
| `Pkgname -> `Pkgname None
| `Ident -> `Ident None
| `Enum enums -> `Enum (enums, None)
| `Vpkg -> `Vpkg None
| `Vpkgformula -> `Vpkgformula None
| `Vpkglist -> `Vpkglist None
| `Veqpkg -> `Veqpkg None
| `Veqpkglist -> `Veqpkglist None
| `Typedecl -> `Typedecl None
let typedecl_of_value = function
| `Int n -> `Int (Some n)
| `Posint n -> `Posint (Some n)
| `Nat n -> `Nat (Some n)
| `Bool b -> `Bool (Some b)
| `String s -> `String (Some s)
| `Pkgname s -> `Pkgname (Some s)
| `Ident s -> `Ident (Some s)
| `Enum (enums, s) -> `Enum (enums, Some s)
| `Vpkg p -> `Vpkg (Some p)
| `Vpkgformula f -> `Vpkgformula (Some f)
| `Vpkglist l -> `Vpkglist (Some l)
| `Veqpkg p -> `Veqpkg (Some p)
| `Veqpkglist l -> `Veqpkglist (Some l)
| `Typedecl l -> `Typedecl (Some l)
let value_of_typedecl = function
| `Int (Some v) -> Some (`Int v)
| `Posint (Some v) -> Some (`Posint v)
| `Nat (Some v) -> Some (`Nat v)
| `Bool (Some v) -> Some (`Bool v)
| `String (Some v) -> Some (`String v)
| `Pkgname (Some v) -> Some (`Pkgname v)
| `Ident (Some v) -> Some (`Ident v)
| `Enum (enums, (Some v)) -> Some (`Enum (enums, v))
| `Vpkg (Some v) -> Some (`Vpkg v)
| `Vpkgformula (Some v) -> Some (`Vpkgformula v)
| `Vpkglist (Some v) -> Some (`Vpkglist v)
| `Veqpkg (Some v) -> Some (`Veqpkg v)
| `Veqpkglist (Some v) -> Some (`Veqpkglist v)
| `Typedecl (Some v) -> Some (`Typedecl v)
| _ -> None
let type_of_value = function
| `Int n -> `Int
| `Posint n -> `Posint
| `Nat n -> `Nat
| `Bool b -> `Bool
| `String s -> `String
| `Pkgname s -> `Pkgname
| `Ident s -> `Ident
| `Enum (enums, s) -> `Enum enums
| `Vpkg p -> `Vpkg
| `Vpkgformula f -> `Vpkgformula
| `Vpkglist l -> `Vpkglist
| `Veqpkg p -> `Veqpkg
| `Veqpkglist l -> `Veqpkglist
| `Typedecl l -> `Typedecl
let rec cast typ v =
let type_error () = raise (Type_error (typ, v, dummy_loc)) in
match typ, v with
| `Posint, `Int n when n > 0 -> `Posint n
| `Nat, `Int n when n >= 0 -> `Nat n
| `Bool, `Ident "true" -> `Bool true
| `Bool, `Ident "false" -> `Bool false
| `Pkgname, `Vpkgformula [[(pkg, None)]] -> `Pkgname pkg
| `Pkgname, (`Int n | `Posint n | `Nat n) -> `Pkgname (string_of_int n)
| `Pkgname, `Ident i-> `Pkgname i
| (`Vpkg | `Veqpkg | `Vpkglist | `Veqpkglist),
(`Int n | `Posint n | `Nat n) ->
cast typ (`Vpkgformula [[string_of_int n, None]])
| (`Vpkg | `Veqpkg | `Vpkglist | `Veqpkglist), `Ident i ->
cast typ (`Vpkgformula [[i, None]])
| `Vpkg, `Vpkgformula [[vpkg]] -> `Vpkg vpkg
| (`Vpkglist | `Veqpkglist),
(`Vpkgformula [] (* "true!" *) | `Vpkgformula [ [] ] (* "false!" *)) ->
type_error ()
| `Vpkglist, `Vpkgformula f ->
if List.exists (function _ :: _ :: _ -> true | _ -> false) f then
type_error () (* there are OR-ed deps *)
else
`Vpkglist (List.map (function [vpkg] -> vpkg | _ -> assert false) f)
| `Veqpkg, `Vpkgformula [[ (_, (Some (`Eq, _) | None)) as vpkg ]] ->
`Veqpkg vpkg
| `Veqpkglist, `Vpkgformula f ->
`Veqpkglist
(List.fold_right
(fun or_deps veqpkgs ->
match or_deps with
| [ (_, (Some (`Eq, _) | None)) as vpkg ] -> vpkg :: veqpkgs
| _ -> type_error ())
f [])
| `Veqpkg, `Vpkg ((_, (Some (`Eq, _) | None)) as vpkg) -> `Veqpkg vpkg
| `Veqpkglist, `Vpkglist l ->
`Veqpkglist
(List.fold_right
(fun vpkg veqpkgs ->
match vpkg with
| (_, (Some (`Eq, _) | None)) as vpkg -> vpkg :: veqpkgs
| _ -> type_error ())
l [])
| `Enum enums, `Ident i when List.mem i enums -> `Enum (enums, i)
| `Vpkgformula, `Ident i -> `Vpkgformula [[i, None]]
| `Vpkgformula, `Int n -> `Vpkgformula [[string_of_int n, None]]
| typ, v when type_of_value v = typ -> v (* identity cast *)
| _ -> type_error ()
let rec is_eq_formula f =
not (List.exists
(fun vpkgs ->
List.exists
(function
| (_, Some ((`Neq | `Geq | `Gt | `Leq | `Lt), _)) -> true
| _ -> false)
vpkgs)
f)
cudf-0.9/cudf_types.mli 0000664 0000000 0000000 00000012535 13064235433 0015164 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** CUDF type library
Implement core CUDF types (see CUDF spec. §2.2.2).
For parsing and pretty printing of CUDF types see {!Cudf_types_pp}.
*)
(** {5 CUDF types} *)
type version = int (* required to be non 0 *)
type relop = [`Eq | `Neq | `Geq | `Gt | `Leq | `Lt]
type constr = (relop * version) option
(** {6 CUDF spec. types} *)
type pkgname = string
type vpkg = pkgname * constr
type vpkglist = vpkg list
type enum_keep = [`Keep_version | `Keep_package | `Keep_feature | `Keep_none ]
(** CNF formula. Inner lists are OR-ed, outer AND-ed.
E.g.:
- "Depends: foo, baz | baz" --> [ [ foo ] ; [ bar ; baz ] ]
- "Depends: true!" --> [ ]
- "Depends: false!" --> [ [] ]
*)
type vpkgformula = vpkg list list
type veqpkg = pkgname * ([`Eq] * version) option
type veqpkglist = veqpkg list
(** CUDF types *)
type typ =
[ `Int | `Posint | `Nat | `Bool | `String | `Enum of string list
| `Pkgname | `Ident
| `Vpkg | `Vpkgformula | `Vpkglist | `Veqpkg | `Veqpkglist
| `Typedecl ]
val keep_type : typ
val keep_enums : string list
(** (Single) type declaration: each variant denotes a type, its argument the
default value, None if missing *)
type typedecl1 =
[ `Int of int option
| `Posint of int option
| `Nat of int option
| `Bool of bool option
| `String of string option
| `Pkgname of string option
| `Ident of string option
| `Enum of string list * string option (** enums, default enum *)
| `Vpkg of vpkg option
| `Vpkgformula of vpkgformula option
| `Vpkglist of vpkglist option
| `Veqpkg of veqpkg option
| `Veqpkglist of veqpkglist option
| `Typedecl of typedecl option
]
and typedecl = (string * typedecl1) list
(** Typed value in the value space of all CUDF types *)
type typed_value =
[ `Int of int
| `Posint of int
| `Nat of int
| `Bool of bool
| `String of string
| `Pkgname of string
| `Ident of string
| `Enum of string list * string
| `Vpkg of vpkg
| `Vpkgformula of vpkgformula
| `Vpkglist of vpkglist
| `Veqpkg of veqpkg
| `Veqpkglist of veqpkglist
| `Typedecl of typedecl
]
(** {5 Manipulation of typed values} *)
(** extract the type of a (single) type declaration *)
val type_of_typedecl : typedecl1 -> typ
(** Create a (single) type declaration having as default value the given typed
value (i.e. apply the "Some" monad to typed values) *)
val typedecl_of_value : typed_value -> typedecl1
(** Extract the default value from a type declaration (or return [None]) *)
val value_of_typedecl : typedecl1 -> typed_value option
(** Create a (single) type declaration with no default value *)
val typedecl_of_type : typ -> typedecl1
(** @return the type of a given value *)
val type_of_value : typed_value -> typ
(** [cast ty v] attempt a runtime cast of a given (typed) value to a different
type.
@raise Type_error if casting is not possible *)
val cast: typ -> typed_value -> typed_value
(** {6 CUDF syntactic types}
Types used in parsing, before values are injected into the CUDF type
system. *)
(** RFC-822-like stanza, i.e. an associative list mapping property names to
property values.
Values are typed according to the type variable ['ty]. Usually, libCUDF
uses either [string stanza] (for untyped stanzas) or
[Cudf_types.typed_value stanza] (for typed stanzas). *)
type 'ty stanza = (string * 'ty) list
(**/**)
(** {5 Parsing helpers}
Used internally for pasring, generally otherwise uninteresting.
*)
(** Range in a file being parsed *)
type loc = Lexing.position * Lexing.position
(** Dummy location, pointing nowhere, going nowhere, ... *)
val dummy_loc : loc
(** [extend_range (p1, _) (_, p2)] return [(p1, p2)] *)
val extend_loc : loc -> loc -> loc
(** Get file range corresponding to the last read token *)
val loc_of_lexbuf : Lexing.lexbuf -> loc
(**/**)
(** {5 Various errors} *)
(** Error while parsing RFC822-like syntax of CUDF documents.
arguments: error message and file range, respectively. *)
exception Parse_error_822 of string * loc
(** Syntax error while parsing some literal value
arguments: error message and file range, respectively *)
exception Syntax_error of string * loc
(** Type error: mismatch between typed value and expected type
arguments: expected type, found value *)
exception Type_error of typ * typed_value * loc
(** {5 Accessors, predicates, etc.} *)
(** Check whether a formula uses only equality tests over package versions. *)
val is_eq_formula : vpkgformula -> bool
cudf-0.9/cudf_types_pp.ml 0000664 0000000 0000000 00000016137 13064235433 0015514 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
open ExtLib
open Printf
open Cudf_types
(* note: Type_error <> Cudf_types.Type_error, this one is not located *)
exception Type_error of typ * typed_value
let lexbuf_wrapper type_parser typ =
fun s ->
try
type_parser Cudf_type_lexer.token_cudf (Lexing.from_string s)
with Cudf_types.Syntax_error (_msg, loc) ->
raise (Type_error (typ, `String s))
let lexbuf_wrapper' type_parser =
fun s ->
type_parser Cudf_type_lexer.token_cudf (Lexing.from_string s)
let parse_int = lexbuf_wrapper Cudf_type_parser.int_top `Int
let parse_ident = lexbuf_wrapper Cudf_type_parser.ident_top `Ident
let parse_pkgname = lexbuf_wrapper Cudf_type_parser.pkgname_top `Pkgname
let parse_vpkg = lexbuf_wrapper Cudf_type_parser.vpkg_top `Vpkg
let parse_vpkglist = lexbuf_wrapper Cudf_type_parser.vpkglist_top `Vpkglist
let parse_vpkgformula =
lexbuf_wrapper Cudf_type_parser.vpkgformula_top `Vpkgformula
let parse_typedecl = lexbuf_wrapper Cudf_type_parser.typedecl_top `Typedecl
let parse_qstring = lexbuf_wrapper' Cudf_type_parser.qstring_top
let parse_type = lexbuf_wrapper' Cudf_type_parser.type_top
(** DEFCON 4, use with care!
Rationale: to avoid duplicating code we have the cast checks enclosed only
in the [cast] function. After having used it however, we will have to
extract the contained typed value. To avoid writing several functions
extracting the appropriate value and [assert false] everywhere else we
cheat with [Obj.magic].
*)
let unbox v = snd (Obj.magic v: 'a * 'b)
let cast' typ v =
try
cast typ v
with Cudf_types.Type_error _ -> raise (Type_error (typ, v))
let parse_posint s: int = unbox (cast' `Posint (`Int (parse_int s)))
let parse_nat s: int = unbox (cast' `Nat (`Int (parse_int s)))
let parse_bool s: bool = unbox (cast' `Bool (`Ident (parse_ident s)))
let parse_veqpkg s: veqpkg = unbox (cast' `Veqpkg (`Vpkg (parse_vpkg s)))
let parse_veqpkglist s: veqpkglist =
unbox (cast' `Veqpkglist (`Vpkglist (parse_vpkglist s)))
let parse_enum ~enums s =
match cast' (`Enum enums) (`Ident (parse_ident s)) with
| `Enum (_, i) -> i
| _ -> assert false
let parse_keep = function
| "version" -> `Keep_version
| "feature" -> `Keep_feature
| "package" -> `Keep_package
| "none" -> `Keep_none
| i -> raise (Type_error (Cudf_types.keep_type, `Ident i))
let parse_string s =
let type_error () = raise (Type_error (`String, `String s)) in
(try ignore (String.index s '\n') ; type_error () with Not_found -> ());
(try ignore (String.index s '\r') ; type_error () with Not_found -> ());
s
let parse_value ty s =
match ty with
| `Int -> `Int (parse_int s)
| `Posint -> `Posint (parse_posint s)
| `Nat -> `Nat (parse_nat s)
| `Bool -> `Bool (parse_bool s)
| `String -> `String (parse_string s)
| `Enum l -> `Enum (l, parse_enum l s)
| `Pkgname -> `Pkgname (parse_pkgname s)
| `Ident -> `Ident (parse_ident s)
| `Vpkg -> `Vpkg (parse_vpkg s)
| `Vpkglist -> `Vpkglist (parse_vpkglist s)
| `Vpkgformula -> `Vpkgformula (parse_vpkgformula s)
| `Veqpkg -> `Veqpkg (parse_veqpkg s)
| `Veqpkglist -> `Veqpkglist (parse_veqpkglist s)
| `Typedecl -> `Typedecl (parse_typedecl s)
(** Pretty printers *)
let string_of_int = Pervasives.string_of_int
let string_of_posint = string_of_int
let string_of_nat = string_of_int
let string_of_bool = Pervasives.string_of_bool
let string_of_keep = function
`Keep_version -> "version"
| `Keep_package -> "package"
| `Keep_feature -> "feature"
| `Keep_none -> "none"
let string_of_pkgname pkgname = pkgname
let string_of_version = string_of_int
let string_of_relop = function
`Eq -> "="
| `Neq -> "!="
| `Geq -> ">="
| `Gt -> ">"
| `Leq -> "<="
| `Lt -> "<"
let string_of_vpkg = function
(name, None) -> name
| (name, Some (relop, v)) -> sprintf "%s %s %d" name (string_of_relop relop) v
let string_of_list string_of_item sep l =
let buf = Buffer.create 1023 in
let rec aux = function
| [] -> assert false
| [last] -> (* last item, no trailing sep *)
Buffer.add_string buf (string_of_item last)
| item :: tl -> (* at least one item in tl *)
Buffer.add_string buf (string_of_item item);
Buffer.add_string buf sep;
aux tl in
let _ =
match l with
| [] -> ()
| [sole] -> Buffer.add_string buf (string_of_item sole)
| _ -> aux l in
Buffer.contents buf
let string_of_vpkglist = string_of_list string_of_vpkg " , "
(** ASSUMPTION: formula is in CNF *)
let rec string_of_vpkgformula = function
| [] -> "true!"
| [ [] ] -> "false!"
| [] :: _ ->
eprintf "malformed vpkgformula: `[] :: _' ; aborting\n%!";
assert false
| fmla ->
let string_of_OR = string_of_list string_of_vpkg " | " in
let string_of_AND = string_of_list string_of_OR " , " in
string_of_AND fmla
let string_of_veqpkglist l = string_of_vpkglist (l :> vpkglist)
let string_of_veqpkg = string_of_vpkg
let string_of_type = function
| `Int -> "int"
| `Posint -> "posint"
| `Nat -> "nat"
| `Bool -> "bool"
| `String -> "string"
| `Enum enums -> sprintf "enum[%s]" (String.concat "," enums)
| `Pkgname -> "pkgname"
| `Ident -> "ident"
| `Vpkg -> "vpkg"
| `Vpkgformula -> "vpkgformula"
| `Vpkglist -> "vpkglist"
| `Veqpkg -> "veqpkg"
| `Veqpkglist -> "veqpkglist"
| `Typedecl -> "typedecl"
let rec string_of_typedecl' (name, decl1) =
let string_escape =
String.replace_chars
(function '"' -> "\\\"" | '\\' -> "\\\\" | c -> String.of_char c) in
match value_of_typedecl decl1 with
| None -> sprintf "%s: %s" name (string_of_type (type_of_typedecl decl1))
| Some (`String s) -> sprintf "%s: string = [\"%s\"]" name (string_escape s)
| Some v ->
sprintf "%s: %s = [%s]"
name (string_of_type (type_of_typedecl decl1)) (string_of_value v)
and string_of_value (v: typed_value) = match v with
| (`Int i | `Posint i | `Nat i) -> string_of_int i
| `Bool b -> string_of_bool b
| (`String s | `Pkgname s | `Ident s | `Enum (_, s)) -> s
| `Vpkg p -> string_of_vpkg p
| `Veqpkg p -> string_of_vpkg p
| `Vpkglist l -> string_of_vpkglist l
| `Veqpkglist l -> string_of_veqpkglist l
| `Vpkgformula f -> string_of_vpkgformula f
| `Typedecl d -> string_of_typedecl d
and string_of_typedecl decl = string_of_list string_of_typedecl' ", " decl
cudf-0.9/cudf_types_pp.mli 0000664 0000000 0000000 00000007252 13064235433 0015663 0 ustar 00root root 0000000 0000000 (*****************************************************************************)
(* libCUDF - CUDF (Common Upgrade Description Format) manipulation library *)
(* Copyright (C) 2009-2012 Stefano Zacchiroli *)
(* *)
(* This library is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Lesser General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(*****************************************************************************)
(** CUDF type library: parsing and pretty printing
Implement parsing and pretty printing of CUDF types (see CUDF spec. §2.2.2).
For the actual CUDF type definition see {!module: Cudf_types}.
For pretty printing of macro-components see {!module: Cudf_printer}.
*)
open Cudf_types
(** {5 Errors} *)
exception Type_error of typ * typed_value
(** {5 Parsers} *)
(** {6 Public types}
All parsing function are granted to raise only {!Cudf_types_pp.Type_error},
lower lever exception (e.g. syntax errors) are wrapped into it *)
val parse_int : string -> int
val parse_posint : string -> int
val parse_nat : string -> int
val parse_bool : string -> bool
val parse_string : string -> string
val parse_pkgname : string -> pkgname
val parse_ident : string -> string
val parse_enum : enums:string list -> string -> string
val parse_vpkg : string -> vpkg
val parse_vpkglist : string -> vpkglist
val parse_vpkgformula : string -> vpkgformula
val parse_veqpkg : string -> veqpkg
val parse_veqpkglist : string -> veqpkglist
val parse_typedecl : string -> typedecl
(** {6 Parsing of other CUDF entities}
Mostly for application relying on CUDF conventions *)
(** Parse a quoted string, enclosed by double quotes as it happens within the
"property" property of preamble stanzas. The only place where such strings
are allowed in CUDF are within type declarations; see
{!Cudf_types_pp.parse_typedecl}.
@return the parsed string after having resolved escaping and removed
surrounding double quotes
@raise Cudf_types.Syntax_error when the quoted string cannot be parsed
*)
val parse_qstring : string -> string
(** Parse a CUDF type expression.
At present it can be either a typename or an enum with its values.
@raise Cudf_types.Syntax_error when the given string is not a valid type
expression
*)
val parse_type : string -> typ
(** Parse the enum value corresponding to the "keep" core property of package
stanzas. Shorthand to avoid parsing the corresponding `Enum and then
casting to {!Cudf_types.enum_keep} *)
val parse_keep : string -> enum_keep
(** generic, type-based parsing *)
val parse_value : typ -> string -> typed_value
(** {5 Pretty printers} *)
(** {6 Pretty print to string} *)
val string_of_int : int -> string
val string_of_posint : int -> string
val string_of_nat : int -> string
val string_of_bool : bool -> string
val string_of_keep : enum_keep -> string
val string_of_pkgname : pkgname -> string
val string_of_version : version -> string
val string_of_vpkg : vpkg -> string
val string_of_vpkglist : vpkglist -> string
val string_of_vpkgformula : vpkgformula -> string
val string_of_veqpkg : veqpkg -> string
val string_of_veqpkglist : veqpkglist -> string
val string_of_typedecl : typedecl -> string
val string_of_type : typ -> string
val string_of_value : typed_value -> string
cudf-0.9/doc/ 0000775 0000000 0000000 00000000000 13064235433 0013053 5 ustar 00root root 0000000 0000000 cudf-0.9/doc/.gitignore 0000664 0000000 0000000 00000000015 13064235433 0015037 0 ustar 00root root 0000000 0000000 cudf-check.1
cudf-0.9/doc/Makefile 0000664 0000000 0000000 00000000365 13064235433 0014517 0 ustar 00root root 0000000 0000000 include ../Makefile.config
MANPAGES = cudf-check
GEN_STUFF = $(patsubst %,%.1,$(MANPAGES))
all: $(GEN_STUFF)
%.1: %.pod
pod2man --release $(VERSION) $< > $@
clean:
rm -f $(GEN_STUFF)
show: cudf-check.1
man -l $<
.PHONY: all clean show
cudf-0.9/doc/cudf-check.pod 0000664 0000000 0000000 00000002474 13064235433 0015562 0 ustar 00root root 0000000 0000000 =head1 NAME
cudf-check - manipulate CUDF documents
=head1 SYNOPSIS
=over
=item B [I