opam-2.0.5/0000755000175000017500000000000013511367404011456 5ustar nicoonicooopam-2.0.5/tests/0000755000175000017500000000000013511367404012620 5ustar nicoonicooopam-2.0.5/tests/tests.py0000755000175000017500000001035613511367404014344 0ustar nicoonicoo#!/usr/bin/python import unittest from subprocess import Popen, STDOUT, PIPE from subprocess import call import uuid import os,sys,time import argparse import difflib tmpdir = "/tmp/OPAM.UNITTEST" results = "results" opamcmd = "/tmp/OPAM.BIN/opam --yes --root /tmp/OPAM.ROOT" verbose=0 FNULL=open(os.devnull, "w") def diff(fromfile,tofile,verbose=0): fromdate = time.ctime(os.stat(fromfile).st_mtime) todate = time.ctime(os.stat(tofile).st_mtime) fromlines = open(fromfile, 'U').readlines() tolines = open(tofile, 'U').readlines() diff = difflib.unified_diff(fromlines, tolines, fromfile, tofile)#, fromdate, todate) l = list(diff) if l : print "File Differences : " print ''.join(l) return False else : return True def opam(cmd, diffile=None,verbose=0): # first we exectute the action, then # we compare the output of list with # the diffile env = os.environ.copy() env['PATH'] = ':'.join(['/tmp/OPAM.BIN',env['PATH']]) env['OPAM_ROOT'] = '/tmp/OPAM.ROOT' cmd = opamcmd.split() + cmd if verbose > 1 : print "Env\nPATH=%s\nOPAM_ROOT=%s" % (env['PATH'],env['OPAM_ROOT']) print "CMD=%s" % (' '.join(cmd)) if verbose <= 1 : call(cmd, stdout=FNULL, env=env) else : call(cmd, env=env) if diffile : f = "%s/%s.opamtest" % (tmpdir,uuid.uuid1()) output = open(f,'w') call(opamcmd.split() + ["list"], stdout=output, env=env) output.close() d = diff(f,diffile,verbose) os.remove(f) return d return None def load_scenario(scenario,verbose=0): if verbose > 0 : print "Loading scenario %d" % scenario if verbose <= 1 : call(["./init-repo.sh", "-s", str(scenario)],stdout=FNULL) else : call(["./init-repo.sh", "-s", str(scenario)]) class OpamTests(unittest.TestCase): def setUp(self): if verbose > 0 : print "\nsetting up repository" call(["./init-repo.sh", "-i"], stdout=FNULL) if not os.path.exists(tmpdir): os.makedirs(tmpdir) def tearDown(self): if verbose > 0 : print "tearing down repository" call(["./init-repo.sh", "-c"], stdout=FNULL) def test_install(self): load_scenario(1,verbose) diffile="%s/install-P1" % results d = opam(["install", "P1"],diffile,verbose) self.assertTrue(d) def test_install_many(self): load_scenario(1,verbose) diffile="%s/install-P1-P2-P3-P4" % results opam(["install", "P1"]) opam(["install", "P2"]) opam(["install", "P3"]) d = opam(["install", "P4"], diffile,verbose) self.assertTrue(d) def test_remove(self): load_scenario(1,verbose) diffile="%s/install-remove-P1" % results opam(["install", "P1"]) d = opam(["remove", "P1"],diffile,verbose) self.assertTrue(d) def test_upgrade(self): load_scenario(1,verbose) diffile="%s/install-upgrade-P2" % results opam(["install", "P4"]) d = opam(["upgrade", "P2"],diffile,verbose) self.assertTrue(d) # @unittest.skip("skipping") def test_reinstall(self): load_scenario(1,verbose) diffile="%s/reinstall-P2" % results opam(["install", "P2"]) d = opam(["reinstall", "P2"],diffile,verbose) self.assertTrue(d) def test_install_opt(self): load_scenario(1,verbose) load_scenario(2,verbose) diffile="%s/install-opt" % results opam(["install", "P5"]) opam(["install", "P2"]) opam(["remove", "P5"]) opam(["remove", "P2"]) d = opam(["remove", "P1"],diffile,verbose) self.assertTrue(d) def main(): global verbose parser = argparse.ArgumentParser(description='description of you program') parser.add_argument('-v', '--verbose', action='store_true') parser.add_argument('-d', '--debug', action='store_true') args = parser.parse_args() verbosity=0 if args.verbose == True : verbose = 1 verbosity=2 if args.debug == True : verbose = 2 suite = unittest.TestLoader().loadTestsFromTestCase(OpamTests) unittest.TextTestRunner(verbosity=verbosity).run(suite) if __name__ == '__main__': main() opam-2.0.5/tests/init-repo.sh0000755000175000017500000000461713511367404015075 0ustar nicoonicoo#! /bin/sh TEST_DIR=/tmp OPAM_ROOT=$TEST_DIR/OPAM.ROOT OPAM_REPO=$TEST_DIR/OPAM.REPO BIN=$TEST_DIR/OPAM.BIN REPO=test BINARIES=opam # opam in the path should not be a requirement ENV="OCAMLRUNPARAM=b OPAMDEBUG=2 OPAM_ROOT=$OPAM_ROOT PATH=$BIN:$PATH" ENV="OCAMLRUNPARAM=b OPAM_ROOT=$OPAM_ROOT PATH=$BIN:$PATH" OPAM="$ENV opam --yes --root $OPAM_ROOT" function binaries() { mkdir -p $BIN for bin in $BINARIES; do \ cp ../_obuild/$bin/$bin.asm $BIN/$bin ; \ done } function opam_clean() { rm -rf $ARCHIVES rm -rf $OPAM_ROOT $BIN rm -rf $OPAM_REPO } function opam_init() { mkdir -p $OPAM_REPO binaries eval $OPAM init -no-base-packages $REPO $OPAM_REPO -kind rsync } function opam_upload_stage1() { cd packages eval $OPAM upload -opam P1-1.opam -descr P1-1/README -archive P1-1.tar.gz -repo $REPO eval $OPAM upload -opam P2.opam -descr P2/README -archive P2.tar.gz -repo $REPO eval $OPAM upload -opam P3.opam -descr P3/README -archive P3.tar.gz -repo $REPO eval $OPAM upload -opam P4-1.opam -descr P4/README -archive P4.tar.gz -repo $REPO eval $OPAM upload -opam P5.opam -descr P5/README -archive P5.tar.gz -repo $REPO cd - cp compilers/* $OPAM_REPO/compilers/ # update the list of available packages with the one being updated eval $OPAM update } function opam_upload_stage2() { cd packages eval $OPAM upload -opam P1-2.opam -descr P1-2/README -archive P1-2.tar.gz -repo $REPO eval $OPAM upload -opam P4-2.opam -descr P4/README -archive P4.tar.gz -repo $REPO eval $OPAM upload -opam P4-3.opam -descr P4/README -archive P4.tar.gz -repo $REPO cd - # update the list of available packages with the one being updated eval $OPAM update } function usage() { DESCRIPTION="Opam unittest init functions" cat << EOF usage: $0 options $DESCRIPTION OPTIONS: -h Show this message -v Verbose -d Debug -i Init -c Clean EOF } VERBOSE= DEBUG= INIT= CLEAN= STAGE= while getopts "vhdcis:" flag do case "$flag" in d) set -x ; DEBUG=true;; v) VERBOSE=true ;; i) INIT=true ;; s) STAGE=$OPTARG ;; c) CLEAN=true ;; h) usage ; exit 0 ;; esac # echo "$flag" $OPTIND $OPTARG done if [ -n "$INIT" ]; then opam_clean opam_init fi if [ -n "$STAGE" ]; then if [ $STAGE = "1" ]; then opam_upload_stage1 fi if [ $STAGE = "2" ]; then opam_upload_stage2 fi fi if [ -n "$CLEAN" ]; then opam_clean fi exit 0 opam-2.0.5/tests/Makefile0000644000175000017500000002544613511367404014273 0ustar nicoonicooTMP_DIR = $(realpath .)/tmp OPAM_ROOT = $(TMP_DIR)/OPAM.ROOT OPAM_REPO = $(TMP_DIR)/OPAM.REPO # repositoy name REPO = test REPOKIND ?= local # To test GIT repo OPAM_GIT = $(TMP_DIR)/OPAM.GIT PACKAGES = P1-0 P1-1 P1-2 P2 P3 P4 P5 unexport OCAMLLIB ifndef OPAM OPAM = $(firstword $(realpath ../../install/default/bin/opam$(EXE) ../_build/install/default/bin/opamMain.exe)) endif ENV = PATH=$(PATH) $(DEBUG) OPAMKEEPBUILDDIR=1 OPAMROOT=$(OPAM_ROOT) OPAMSWITCH= OPAMNOBASEPACKAGES=1 OPAMYES=1 OPAM=$(OPAM) OPAMBIN = $(ENV) $(OPAM) ifndef CHECK CHECK = $(ENV) $(firstword $(realpath ../src/tools/opam_check.exe ../_build/default/src/tools/opam_check.exe)) endif ifeq ($(OPAMTESTQUIET), 1) DEBUG = else DEBUG = OPAMDEBUG=2 OCAMLRUNPARAM=b endif ARCHIVES = $(PACKAGES:%=packages/%.tar.gz) .PHONY: all local git all: local git @ quiet: $(MAKE) OPAMTESTQUIET=1 all printf = /usr/bin/printf define RUN @COUNT=$$(ls -1 $(REPOKIND)-*.log 2>/dev/null | wc -l); \ LOG=$$($(printf) "$(REPOKIND)-%02d-$(1).log" $$COUNT); \ $(printf) " %02d \e[1m%-20s\e[0m ..................................... " \ $$COUNT $(1); \ if $(MAKE) $(1) >$$LOG 2>&1; then \ $(printf) "\e[32m[ OK ]\e[0m\n"; \ else \ $(printf) "\e[31m$(1) FAILED\e[0m\n\n" >>$$LOG; \ $(printf) "\e[31m[FAIL]\e[0m\n"; \ { $(printf) "\e[31m>> %s FAILED <<\e[0m\n" $(1); cat $$LOG; } \ >> failed-$(REPOKIND).log; \ fi; \ cat $$LOG >> fulltest-$(REPOKIND).log endef run: @rm -f failed-$(REPOKIND).log fulltest-$(REPOKIND).log @rm -f $(REPOKIND)-*.log $(call RUN,init) $(call RUN,upload) $(call RUN,install-remove) $(call RUN,list) $(call RUN,install-opt) $(call RUN,list) $(call RUN,install) $(call RUN,list) $(call RUN,reinstall) $(call RUN,list) $(call RUN,upload-new) $(call RUN,list) $(call RUN,upgrade) $(call RUN,list) $(call RUN,downgrade) $(call RUN,list) $(call RUN,switch-alias) $(call RUN,list) $(call RUN,switch-env-packages) $(call RUN,repo) $(call RUN,list) @if [ -e failed-$(REPOKIND).log ]; \ then echo "FAILED! Logs in `pwd`/failed-$(REPOKIND).log"; exit 1; \ else echo "SUCCESS!"; fi local: @$(MAKE) --silent --no-print-directory clean $(MAKE) --no-print-directory REPOKIND=local run git: @$(MAKE) --silent --no-print-directory clean $(MAKE) --no-print-directory REPOKIND=git run define GIT_INIT git init && echo '*.sh text eol=lf'> .gitattributes && $(if $1,touch $1 && )\ git add -A && git config --local user.name 'OPAM test environment' &&\ git config --local user.email noreply@ocaml.org && git commit -m "Initial commit" endef init: rm -rf $(OPAM_REPO) mkdir -p $(OPAM_REPO) ifeq ($(REPOKIND), git) cd $(OPAM_REPO) && $(call GIT_INIT,README) endif $(OPAMBIN) init --bare --no-setup --disable-sandboxing $(REPO) $(OPAM_REPO) -k $(REPOKIND) define mkurl echo 'src: "http://dev.null" checksum: "'`openssl md5 packages/$(2) |cut -d' ' -f2`'"' \ > $(OPAM_REPO)/packages/$(1)/url endef upload: $(ARCHIVES) cp -r packages/ocaml $(OPAM_REPO)/packages mkdir -p $(OPAM_REPO)/packages/P1.0 cp packages/P1-0.opam $(OPAM_REPO)/packages/P1.0/opam $(call mkurl,P1.0,P1-0.tar.gz) mkdir -p $(OPAM_REPO)/packages/P1.1 cp packages/P1-1.opam $(OPAM_REPO)/packages/P1.1/opam cp packages/P1-1/README $(OPAM_REPO)/packages/P1.1/descr $(call mkurl,P1.1,P1-1.tar.gz) mkdir -p $(OPAM_REPO)/packages/P2.1 cp packages/P2/README $(OPAM_REPO)/packages/P2.1/descr cp packages/P2.opam $(OPAM_REPO)/packages/P2.1/opam $(call mkurl,P2.1,P2.tar.gz) mkdir -p $(OPAM_REPO)/packages/P3.1~weird-version.test cp packages/P3.opam $(OPAM_REPO)/packages/P3.1~weird-version.test/opam cp packages/P3/README $(OPAM_REPO)/packages/P3.1~weird-version.test/descr $(call mkurl,P3.1~weird-version.test,P3.tar.gz) mkdir -p $(OPAM_REPO)/packages/P4.1 cp packages/P4-1.opam $(OPAM_REPO)/packages/P4.1/opam cp packages/P4/README $(OPAM_REPO)/packages/P4.1/descr $(call mkurl,P4.1,P4.tar.gz) mkdir -p $(OPAM_REPO)/packages/P5.1 cp packages/P5.opam $(OPAM_REPO)/packages/P5.1/opam cp packages/P5/README $(OPAM_REPO)/packages/P5.1/descr $(call mkurl,P5.1,P5.tar.gz) ifeq ($(REPOKIND), git) cd $(OPAM_REPO)/packages/ocaml.system && git add * && git commit -m "Adding ocaml.system" cd $(OPAM_REPO)/packages/ocaml.20 && git add * && git commit -m "Adding ocaml.20" cd $(OPAM_REPO)/packages/ocaml.10+a+b && git add * && git commit -m "Adding ocaml.10+a+b" echo 'git: "$(OPAM_GIT)/P1-0"' > $(OPAM_REPO)/packages/P1.0/url cd $(OPAM_REPO)/packages/P1.0/ && git add * && git commit -m "Adding P0" echo 'git: "$(OPAM_GIT)/P1-1"' > $(OPAM_REPO)/packages/P1.1/url cd $(OPAM_REPO)/packages/P1.1/ && git add * && git commit -m "Adding P1" echo 'git: "$(OPAM_GIT)/P2"' > $(OPAM_REPO)/packages/P2.1/url cd $(OPAM_REPO)/packages/P2.1/ && git add * && git commit -m "Adding P2" echo 'git: "$(OPAM_GIT)/P3"' > $(OPAM_REPO)/packages/P3.1~weird-version.test/url cd $(OPAM_REPO)/packages/P3.1~weird-version.test/ && git add * && git commit -m "Adding P3" echo 'git: "$(OPAM_GIT)/P4"' > $(OPAM_REPO)/packages/P4.1/url cd $(OPAM_REPO)/packages/P4.1/ && git add * && git commit -m "Adding P4" echo 'git: "$(OPAM_GIT)/P5"' > $(OPAM_REPO)/packages/P5.1/url cd $(OPAM_REPO)/packages/P5.1/ && git add * && git commit -m "Adding P5" rm -rf $(OPAM_GIT) && mkdir -p $(OPAM_GIT) mkdir $(OPAM_GIT)/P1-0 && cp packages/P1-0/* $(OPAM_GIT)/P1-0/ mkdir $(OPAM_GIT)/P1-1 && cp packages/P1-1/* $(OPAM_GIT)/P1-1/ mkdir $(OPAM_GIT)/P2 && cp packages/P2/* $(OPAM_GIT)/P2/ mkdir $(OPAM_GIT)/P3 && cp packages/P3/* $(OPAM_GIT)/P3/ mkdir $(OPAM_GIT)/P4 && cp packages/P4/* $(OPAM_GIT)/P4/ mkdir $(OPAM_GIT)/P5 && cp packages/P5/* $(OPAM_GIT)/P5/ cd $(OPAM_GIT)/P1-0 && $(call GIT_INIT) cd $(OPAM_GIT)/P1-1 && $(call GIT_INIT) cd $(OPAM_GIT)/P2 && $(call GIT_INIT) cd $(OPAM_GIT)/P3 && $(call GIT_INIT) cd $(OPAM_GIT)/P4 && $(call GIT_INIT) cd $(OPAM_GIT)/P5 && $(call GIT_INIT) else mkdir -p $(OPAM_REPO)/cache for p in P1-0 P1-1 P1-2 P2 P3 P4 P5; do \ f=packages/$$p.tar.gz; \ md5=`openssl md5 $$f |cut -d' ' -f2`; \ dir=$(OPAM_REPO)/cache/md5/`echo $$md5 |head -c2`; \ mkdir -p $$dir; \ cp $$f $$dir/$$md5; \ done echo 'archive-mirrors: "$(OPAM_REPO)/cache"' >> $(OPAM_REPO)/repo endif $(OPAMBIN) update $(OPAMBIN) switch create system --packages ocaml.system list: $(OPAMBIN) list -A install-remove: $(CHECK) -l install-remove-1 ocaml.system $(OPAMBIN) install P1 $(CHECK) -l install-remove-2 ocaml.system P1.1 $(OPAMBIN) remove P1 $(CHECK) -l install-remove-3 ocaml.system install-opt: $(CHECK) -l install-opt-1 ocaml.system $(OPAMBIN) install P5 test -f $(OPAM_ROOT)/system/lib/p5/p2_absent $(CHECK) -l install-opt-2 ocaml.system P1.1 P5.1 $(OPAMBIN) remove P5 $(CHECK) -l install-opt-3 ocaml.system P1.1 $(OPAMBIN) install P5 $(CHECK) -l install-opt-4 ocaml.system P1.1 P5.1 $(OPAMBIN) remove P5 -a $(CHECK) -l install-opt-5 ocaml.system $(OPAMBIN) install P5 $(CHECK) -l install-opt-6 ocaml.system P1.1 P5.1 $(OPAMBIN) install P2 test -f $(OPAM_ROOT)/system/lib/p5/p2_present $(CHECK) -l install-opt-7 ocaml.system P1.1 P2.1 P5.1 $(OPAMBIN) remove P5 -a $(CHECK) -l install-opt-8 ocaml.system P1.1 P2.1 $(OPAMBIN) remove P2 -a $(CHECK) -l install-opt-9 ocaml.system $(OPAMBIN) install P1 P2 P5 test -f $(OPAM_ROOT)/system/lib/p5/p2_present $(CHECK) -l install-opt-10 ocaml.system P1.1 P2.1 P5.1 $(OPAMBIN) remove P2 -a test -f $(OPAM_ROOT)/system/lib/p5/p2_absent $(CHECK) -l install-opt-11 ocaml.system P1.1 P5.1 $(OPAMBIN) remove P1 $(CHECK) -l install-opt-12 ocaml.system install: $(CHECK) -l install-1 ocaml.system $(OPAMBIN) install P1 $(CHECK) -l install-2 ocaml.system P1.1 $(OPAMBIN) install P2 $(CHECK) -l install-3 ocaml.system P1.1 P2.1 $(OPAMBIN) install P3 $(CHECK) -l install-4 ocaml.system P1.1 P2.1 P3.1~weird-version.test $(OPAMBIN) install P4 $(CHECK) -l install-5 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.1 reinstall: $(CHECK) -l reinstall-1 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.1 $(OPAMBIN) reinstall P1 $(CHECK) -l reinstall-2 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.1 upload-new: mkdir $(OPAM_REPO)/packages/P4.2 cp packages/P4-2.opam $(OPAM_REPO)/packages/P4.2/opam cp packages/P4/README $(OPAM_REPO)/packages/P4.2/descr $(call mkurl,P4.2,P4.tar.gz) mkdir $(OPAM_REPO)/packages/P4.3 cp packages/P4-3.opam $(OPAM_REPO)/packages/P4.3/opam cp packages/P4/README $(OPAM_REPO)/packages/P4.3/descr $(call mkurl,P4.3,P4.tar.gz) ifeq ($(REPOKIND), git) echo "(* new line *)" >> $(OPAM_GIT)/P1-1/p1.ml cd $(OPAM_GIT)/P1-1 && git commit -a -m "a small change" echo 'git: "$(OPAM_GIT)/P4"' > $(OPAM_REPO)/packages/P4.2/url echo 'git: "$(OPAM_GIT)/P4"' > $(OPAM_REPO)/packages/P4.3/url cd $(OPAM_REPO) && git add * && git commit -m "Adding P4.2 and P4.3" else mkdir $(OPAM_REPO)/packages/P1.2 cp packages/P1-2.opam $(OPAM_REPO)/packages/P1.2/opam cp packages/P1-2/README $(OPAM_REPO)/packages/P1.2/descr $(call mkurl,P1.2,P1-2.tar.gz) endif $(OPAMBIN) update upgrade: $(CHECK) -l upgrade-1 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.1 eval `$(OPAMBIN) config env`; [ "X$$P1" = "Xversion1" ] $(OPAMBIN) upgrade ifeq ($(REPOKIND), git) $(CHECK) -l upgrade-2 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.3 else $(CHECK) -l upgrade-2 ocaml.system P1.2 P2.1 P3.1~weird-version.test P4.3 eval `$(OPAMBIN) config env`; [ "X$$P1" = "Xversion2" ] endif downgrade: ifeq ($(REPOKIND), git) $(CHECK) -l downgrade-1 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.3 else $(CHECK) -l downgrade-1 ocaml.system P1.2 P2.1 P3.1~weird-version.test P4.3 endif $(OPAMBIN) install P4.2 $(CHECK) -l downgrade-2 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.2 switch-alias: $(CHECK) -l switch-alias-1 ocaml.system P1.1 P2.1 P3.1~weird-version.test P4.2 $(OPAMBIN) remove P3.1~weird-version.test P4.2 $(CHECK) -l switch-alias-2 ocaml.system P1.1 P2.1 $(OPAMBIN) switch export $(TMP_DIR)/export $(OPAMBIN) switch create test system $(CHECK) -l switch-alias-3 ocaml.system $(OPAMBIN) switch import $(TMP_DIR)/export $(CHECK) -l switch-alias-4 ocaml.system P1.1 P2.1 $(OPAMBIN) switch create test2 20 $(CHECK) -l switch-alias-5 ocaml.20 $(OPAMBIN) install P1 $(CHECK) -l switch-alias-6 ocaml.20 P1.1 $(OPAMBIN) switch system $(CHECK) -l switch-alias-7 ocaml.system P1.1 P2.1 $(OPAMBIN) switch remove test test2 switch-env-packages: $(CHECK) -l switch-env-packages-1 ocaml.system P1.1 P2.1 $(OPAMBIN) switch install 10+a+b --packages=ocaml.10+a+b,P1,P2,P3,P4 $(CHECK) -l switch-env-packages-2 ocaml.10+a+b P1.1 P2.1 P3.1~weird-version.test P4.3 ./test-TEST.sh $(wildcard $(OPAM_ROOT)/10+a+b/build/P4.3/P4*.env) "1" repo: $(OPAMBIN) repo add $(REPO)2 $(OPAM_REPO) -k $(REPOKIND) $(OPAMBIN) repo remove $(REPO)2 $(OPAMBIN) repo remove $(REPO) packages/%.tar.gz: packages/% cd packages && tar czf $*.tar.gz $* clean: rm -f test.log fulltest.log rm -f $(ARCHIVES) rm -rf $(TMP_DIR) opam-2.0.5/tests/README.unittest0000644000175000017500000000122113511367404015352 0ustar nicoonicoo # to create a new unit test * clean the test repository : ./init-repo.sh -c * init the test repository : ./init-repo.sh -i * load an initial scenario (this command can be invoked multiple times): ./init-repo.sh -s 1 ./init-repo.sh -s 2 * install/remove/upgrade : OPAM_ROOT=/tmp/OPAM.ROOT PATH=/tmp/OPAM.BIN:$PATH opam --yes --root /tmp/OPAM.ROOT install P4 * crearte a new expected result file in as OPAM_ROOT=/tmp/OPAM.ROOT PATH=/tmp/OPAM.BIN:$PATH \ opam --yes --root /tmp/OPAM.ROOT list > results/new-expected-result * Make sure that the result correct ! * Add a new test case in the file tests.py opam-2.0.5/tests/results/0000755000175000017500000000000013511367404014321 5ustar nicoonicooopam-2.0.5/tests/results/reinstall-P20000644000175000017500000000031113511367404016513 0ustar nicoonicooAvailable packages for system: P1 1 A very useful package P2 1 An other very useful package P3 -- Testing version names P4 -- Testing transitive closure P5 -- Testing optional dependencies opam-2.0.5/tests/results/install-remove-P10000644000175000017500000000031113511367404017456 0ustar nicoonicooAvailable packages for system: P1 -- A very useful package P2 -- An other very useful package P3 -- Testing version names P4 -- Testing transitive closure P5 -- Testing optional dependencies opam-2.0.5/tests/results/README.tests0000644000175000017500000000115213511367404016341 0ustar nicoonicoo # All tests are performed in a clean repository Initial state of the repository Available packages for system: P1 -- A very useful package P2 -- An other very useful package P3 -- Testing version names P4 -- Testing transitive closure P5 -- Testing optional dependencies * install-P1 install P1 * install-P1-P2-P3-P4 install P1, P2, P3, P4 * install-remove-P1 install P1 and then remove P1 * install-upgrade-P2 install P4 and then upgrade P2 * reinstall-P2 install P2 and the re-install P2 * install_opt install P5 , install P2, remove P5, remove P2, remove P1 opam-2.0.5/tests/results/install-opt0000644000175000017500000000031113511367404016505 0ustar nicoonicooAvailable packages for system: P1 -- A very useful package P2 -- An other very useful package P3 -- Testing version names P4 -- Testing transitive closure P5 -- Testing optional dependencies opam-2.0.5/tests/results/install-P10000644000175000017500000000031113511367404016163 0ustar nicoonicooAvailable packages for system: P1 1 A very useful package P2 -- An other very useful package P3 -- Testing version names P4 -- Testing transitive closure P5 -- Testing optional dependencies opam-2.0.5/tests/results/install-upgrade-P20000644000175000017500000000044313511367404017617 0ustar nicoonicooAvailable packages for system: P1 1 A very useful package P2 1 An other very useful package P3 1~weird-version.test Testing version names P4 1 Testing transitive closure P5 -- Testing optional dependencies opam-2.0.5/tests/results/install-P1-P2-P3-P40000644000175000017500000000044313511367404017211 0ustar nicoonicooAvailable packages for system: P1 1 A very useful package P2 1 An other very useful package P3 1~weird-version.test Testing version names P4 1 Testing transitive closure P5 -- Testing optional dependencies opam-2.0.5/tests/dune0000644000175000017500000000024113511367404013473 0ustar nicoonicoo(alias (name runtest) (deps (source_tree .) ../src/client/opamMain.exe ../src/tools/opam_check.exe) (action (run make all))) (ignored_subdirs (packages)) opam-2.0.5/tests/packages/0000755000175000017500000000000013511367404014376 5ustar nicoonicooopam-2.0.5/tests/packages/P1-1.opam0000644000175000017500000000214613511367404015675 0ustar nicoonicoo(* API version *) opam-version: "1" name: "P1" # Test # Toto (* Version are arbitrary strings *) version: "1" maintainer: "contact@ocamlpro.com" (* The command to run *) build: [ ["./build.sh"] # HAHAH ["this" "should" "never" "run"] {ocaml:version > "z100"} [make "this" ocaml:version "also"] {os = "NO"} ["echo" "HAHA!"] {ocaml:version = "10"} ["echo" make share ocaml:version] ["this as well" {os = "myOS"}] ] available: os != "NO" | os != "NO" & os != "YES" (* List of files to substitute env variables *) substs: [ "P1.config" ] (* Libraries *) libraries: [ "p1" ] (* External dependencies *) depexts: [ [ ["debian" "amd64"] ["foo" "bar"] ] [ ["osx" ] ["foobar"] ] ] messages: [ "I'll always bother you displaying this message" ] post-messages: [ "Thanks SO MUCH for installing this humble package" "Everything went well" {success} "Nooo, something went wrong, this makes me feel sooo sad..." {failure} ] bug-reports: "TEST.com" setenv: [P1 = "version1"] depends: [ "ocaml" {(!= "20" | != "10") & (= "20" | = "10" | = "10+a+b" | = "system")} ] opam-2.0.5/tests/packages/P1-1/0000755000175000017500000000000013511367404015014 5ustar nicoonicooopam-2.0.5/tests/packages/P1-1/P1.install0000644000175000017500000000024313511367404016663 0ustar nicoonicoolib: [ "p1.cmi" "p1.cma" "p1.cmxa" "p1.a" "?this_file_will_not_exits_but_that's_ok" ] share: [ "build.sh" ] doc: [ "p1.cmi" { "foo/bar/index.html" } ] opam-2.0.5/tests/packages/P1-1/README0000644000175000017500000000002613511367404015672 0ustar nicoonicooA very useful package opam-2.0.5/tests/packages/P1-1/build.sh0000755000175000017500000000024113511367404016447 0ustar nicoonicoo#! /bin/sh -eu if [ -n "${P1:-}" ]; then echo "P1 ('$P1') should not be set yet" >&2 exit 12 fi ocamlc -a p1.ml -o p1.cma ocamlopt -a p1.ml -o p1.cmxa opam-2.0.5/tests/packages/P1-1/P1.config.in0000644000175000017500000000032413511367404017067 0ustar nicoonicooopam-version: "1.3" variables { asmcomp: "-I %{lib}%/P1" bytecomp: "-I %{lib}%/P1" asmlink: "-I %{lib}%/P1 p1.cmxa" bytelink: "-I %{lib}%/P1 p1.cma" LOCAL: "local" l: "L" FOO: "foo" bar: true } opam-2.0.5/tests/packages/P1-1/p1.ml0000644000175000017500000000005513511367404015666 0ustar nicoonicoolet x () = try Random.int 10 with _ -> 0 opam-2.0.5/tests/packages/P4-2.opam0000644000175000017500000000023313511367404015674 0ustar nicoonicooopam-version: "1" name: "P4" version: "2" maintainer: "contact@ocamlpro.com" depends: [ "P1" { <= "1" } "P2" "P3" ] build: [ "./build.sh" ] opam-2.0.5/tests/packages/P3/0000755000175000017500000000000013511367404014660 5ustar nicoonicooopam-2.0.5/tests/packages/P3/p3_bar.ml0000644000175000017500000000007013511367404016355 0ustar nicoonicoolet f () = Printf.printf "foo\n%!" let _ = P3.z () opam-2.0.5/tests/packages/P3/build.sh0000755000175000017500000000061313511367404016316 0ustar nicoonicoo#! /bin/sh -eu echo "Building P3 version ${OPAM_PACKAGE_VERSION}" if [ "x${OPAM_PACKAGE_NAME}" = "xP3" ]; then LIB=$(${OPAM} config var lib) ocamlc -a -I $LIB/P1 -I $LIB/P2 p3.ml -o p3.cma ocamlopt -a -I $LIB/P1 -I $LIB/P2 p3.ml -o p3.cmxa ocamlc -a -I $LIB/P1 -I $LIB/P2 p3_bar.ml -o p3_bar.cma ocamlopt -a -I $LIB/P1 -I $LIB/P2 p3_bar.ml -o p3_bar.cmxa else exit 1 fi opam-2.0.5/tests/packages/P3/P3.install0000644000175000017500000000021213511367404016525 0ustar nicoonicoolib: [ (* p3 *) "p3.cma" "p3.cmxa" "p3.a" "p3.cmi" (* p3_bar *) "p3_bar.cma" "p3_bar.cmxa" "p3_bar.a" "p3_bar.cmi" ] opam-2.0.5/tests/packages/P3/p3.ml0000644000175000017500000000004713511367404015535 0ustar nicoonicoolet z () = try P1.x () with _ -> 0 opam-2.0.5/tests/packages/P3/README0000644000175000017500000000002613511367404015536 0ustar nicoonicooTesting version names opam-2.0.5/tests/packages/P3/P3.config.in0000644000175000017500000000031113511367404016731 0ustar nicoonicooopam-version: "1.3" variables { asmcomp : "-I %{lib}%/P3" bytecomp: "-I %{lib}%/P3" asmlink : "-I %{lib}%/P3 p3.cmxa p3_bar.cmxa" bytelink: "-I %{lib}%/P3 p3.cma p3_bar.cma" requires: "p1" } opam-2.0.5/tests/packages/P4-3.opam0000644000175000017500000000020213511367404015671 0ustar nicoonicooopam-version: "1" name: "P4" version: "3" maintainer: "contact@ocamlpro.com" depends: [ "P2" "P3" ] build: [ "./build.sh" ] opam-2.0.5/tests/packages/P1-0.opam0000644000175000017500000000034213511367404015670 0ustar nicoonicoo(* API version *) opam-version: "1" name: "P1" version: "0" setenv: [P1 = "version0"] substs: "P1.config" build: [ [ "ocamlc" "-a" "p1.ml" "-o" "p1.cma" ] [ "ocamlopt" "-a" "p1.ml" "-o" "p1.cmxa" ] ] depends: ["ocaml"] opam-2.0.5/tests/packages/P1-2/0000755000175000017500000000000013511367404015015 5ustar nicoonicooopam-2.0.5/tests/packages/P1-2/P1.config.in0000644000175000017500000000032413511367404017070 0ustar nicoonicooopam-version: "1.3" variables { asmcomp: "-I %{lib}%/P1" bytecomp: "-I %{lib}%/P1" asmlink: "-I %{lib}%/P1 p1.cmxa" bytelink: "-I %{lib}%/P1 p1.cma" LOCAL: "local" l: "L" FOO: "foo" bar: true } opam-2.0.5/tests/packages/P1-2/README0000644000175000017500000000002613511367404015673 0ustar nicoonicooA very useful package opam-2.0.5/tests/packages/P1-2/build.sh0000755000175000017500000000024113511367404016450 0ustar nicoonicoo#! /bin/sh -eu if [ -n "${P1:-}" ]; then echo "P1 ('$P1') should not be set yet" >&2 exit 12 fi ocamlc -a p1.ml -o p1.cma ocamlopt -a p1.ml -o p1.cmxa opam-2.0.5/tests/packages/P1-2/P1.install0000644000175000017500000000006413511367404016665 0ustar nicoonicoolib: [ "p1.cma" "p1.cmxa" "p1.a" "p1.cmi" ] opam-2.0.5/tests/packages/P1-2/p1.ml0000644000175000017500000000007113511367404015665 0ustar nicoonicoolet x () = failwith "the new version is not very good" opam-2.0.5/tests/packages/P4/0000755000175000017500000000000013511367404014661 5ustar nicoonicooopam-2.0.5/tests/packages/P4/build.sh0000755000175000017500000000115313511367404016317 0ustar nicoonicoo#! /bin/sh -ex if [ $OPAM_PACKAGE_VERSION -eq 2 ]; then if [ "X${P1:-}" != "Xversion1" ]; then echo "P1 not set to version1 while P1.1 should be installed" >&2 exit 12 fi else if [ -z "X${P1:-}" ]; then echo "P1 not set while P1 should be installed" >&2 exit 12 fi fi echo "Building P4 with ${OPAM}" LIBDIR="`${OPAM} config var lib`" COMP="-I ${LIBDIR}/P1 -I ${LIBDIR}/P2 -I ${LIBDIR}/P3" LINK="p1.cmxa p2.cmxa p3.cmxa p3_bar.cmxa" OCAMLC=ocamlc if which ocamlopt >/dev/null 2>&1; then OCAMLC=ocamlopt; fi $OCAMLC ${COMP} ${LINK} p4.ml -o p4.foo echo "TEST=${TEST}" opam-2.0.5/tests/packages/P4/P4.install0000644000175000017500000000004513511367404016533 0ustar nicoonicoobin: [ "p4.foo" { "p4" } "p4.foo" ]opam-2.0.5/tests/packages/P4/README0000644000175000017500000000003313511367404015535 0ustar nicoonicooTesting transitive closure opam-2.0.5/tests/packages/P4/p4.ml0000644000175000017500000000024413511367404015536 0ustar nicoonicoolet f = try P3_bar.f (); P1.x () with _ -> P3.z () let () = let t = try Sys.getenv "TEST" with _ -> "" in Printf.printf "TEST=%s\n%!" t opam-2.0.5/tests/packages/P5.opam0000644000175000017500000000056013511367404015541 0ustar nicoonicoo(* API version *) opam-version: "1" name: "P5" version: "1" maintainer: "contact@ocamlpro.com" depends: ["ocaml" "P1"] depopts: [ "P2" ] build: [ [ "./build.sh" ] ] install: [ [ "mkdir" "-p" "%{lib}%/p5" ] [ "touch" "%{lib}%/p5/p2_present" ] {P2:installed} [ "touch" "%{lib}%/p5/p2_absent" ] {!P2:installed} ] remove: [ "rm" "-rf" "%{lib}%/p5" ] opam-2.0.5/tests/packages/ocaml/0000755000175000017500000000000013511367404015471 5ustar nicoonicooopam-2.0.5/tests/packages/ocaml/ocaml.system/0000755000175000017500000000000013511367404020107 5ustar nicoonicooopam-2.0.5/tests/packages/ocaml/ocaml.system/opam0000644000175000017500000000030113511367404020760 0ustar nicoonicooopam-version: "1.3.0~dev4" maintainer: "louis.gesbert@ocamlpro.com" build: ["sh" "-uex" "./gen.sh"] setenv: [CAML_LD_LIBRARY_PATH = "%{lib}%:%{_:ocaml-stublibs}%"] depends: [ ] flags: compiler opam-2.0.5/tests/packages/ocaml/ocaml.system/files/0000755000175000017500000000000013511367404021211 5ustar nicoonicooopam-2.0.5/tests/packages/ocaml/ocaml.system/files/gen.sh0000755000175000017500000000125413511367404022323 0ustar nicoonicoo#!/bin/sh -ue if ! OCAMLC=$(command -v ocamlc); then echo "No OCaml compiler was found on the system" >&2 exit 2 fi LIBDIR=$("$OCAMLC" -where) STUBLIBS=$(cat "$LIBDIR/ld.conf" | tr '\n' ':') echo "Using ocaml compiler found at $OCAMLC with base lib at $LIBDIR" bool() { if "$@"; then echo "true"; else echo "false"; fi } cat >ocaml.config < 0 opam-2.0.5/tests/packages/P1-0/P1.install0000644000175000017500000000006413511367404016663 0ustar nicoonicoolib: [ "p1.cmi" "p1.cma" "p1.cmxa" "p1.a" ] opam-2.0.5/tests/packages/P1-0/P1.config.in0000644000175000017500000000032413511367404017066 0ustar nicoonicooopam-version: "1.3" variables { asmcomp: "-I %{lib}%/P1" bytecomp: "-I %{lib}%/P1" asmlink: "-I %{lib}%/P1 p1.cmxa" bytelink: "-I %{lib}%/P1 p1.cma" LOCAL: "local" l: "L" FOO: "foo" bar: true } opam-2.0.5/tests/packages/P4-1.opam0000644000175000017500000000020513511367404015672 0ustar nicoonicooopam-version: "1" name: "P4" version: "1" maintainer: "contact@ocamlpro.com" depends: ["ocaml" "P2" "P3"] build: [ "./build.sh" ] opam-2.0.5/tests/packages/P1-2.opam0000644000175000017500000000033413511367404015673 0ustar nicoonicooopam-version: "1" name: "P1" version: "2" depends: [ "ocaml" {<= "10" | = "system"} ] maintainer: "contact@ocamlpro.com" substs: [ "P1.config" ] libraries: [ "p1" ] build: [ "./build.sh" ] setenv: [P1 = "version2"] opam-2.0.5/tests/packages/P3.opam0000644000175000017500000000025013511367404015533 0ustar nicoonicooopam-version: "1" name: "P3" version: "1~weird-version.test" maintainer: "contact@ocamlpro.com" depends: ["ocaml" "P1"] substs: [ "P3.config" ] build: [ "./build.sh" ] opam-2.0.5/tests/packages/P5/0000755000175000017500000000000013511367404014662 5ustar nicoonicooopam-2.0.5/tests/packages/P5/README0000644000175000017500000000003613511367404015541 0ustar nicoonicooTesting optional dependencies opam-2.0.5/tests/packages/P5/p5.ml0000644000175000017500000000002513511367404015535 0ustar nicoonicoolet g () = P1.x () opam-2.0.5/tests/packages/P5/build.sh0000755000175000017500000000035313511367404016321 0ustar nicoonicoo#! /bin/sh -eu FLAGS="-I `${OPAM} config var P1:lib`" echo "Bytecode Compilation" ocamlc ${FLAGS} -a p5.ml -o p5.cma if which ocamlopt >/dev/null 2>&1; then echo "Native Compilation" ocamlopt ${FLAGS} -a p5.ml -o p5.cmxa fi opam-2.0.5/tests/packages/P2.opam0000644000175000017500000000027213511367404015536 0ustar nicoonicooopam-version: "1" name: "P2" version: "1" maintainer: "contact@ocamlpro.com" substs: [ "config" "P2.config" ] depends: ["ocaml" "P1"] libraries: [ "p2" ] build: [ "./build.sh" ] opam-2.0.5/tests/packages/P2/0000755000175000017500000000000013511367404014657 5ustar nicoonicooopam-2.0.5/tests/packages/P2/P2.config.in0000644000175000017500000000026213511367404016734 0ustar nicoonicooopam-version: "1.3" variables { asmcomp: "-I %{lib}%/P2" bytecomp: "-I %{lib}%/P2" asmlink: "-I %{lib}%/P2 p2.cmxa" bytelink: "-I %{lib}%/P2 p2.cma" requires: "p1" } opam-2.0.5/tests/packages/P2/p2.ml0000644000175000017500000000002513511367404015527 0ustar nicoonicoolet g () = P1.x () opam-2.0.5/tests/packages/P2/README0000644000175000017500000000023113511367404015533 0ustar nicoonicooAn other very useful package The description can go on multiple lines. The first line is the package synopsis, and the rest is the package description. opam-2.0.5/tests/packages/P2/build.sh0000755000175000017500000000043213511367404016314 0ustar nicoonicoo#! /bin/sh -eu OFLAGS="`${OPAM} config var P1:asmcomp`" CFLAGS="`${OPAM} config var P1:bytecomp`" echo "Bytecode Compilation" ocamlc ${CFLAGS} -a p2.ml -o p2.cma if which ocamlopt >/dev/null 2>&1; then echo "Native Compilation" ocamlopt ${OFLAGS} -a p2.ml -o p2.cmxa fi opam-2.0.5/tests/packages/P2/config.in0000644000175000017500000000012013511367404016445 0ustar nicoonicooFoo is %{P1:FOO}% Foo also contains a variable with %{P1:l}%. Funny, isn't it? opam-2.0.5/tests/packages/P2/P2.install0000644000175000017500000000006413511367404016530 0ustar nicoonicoolib: [ "p2.cma" "p2.cmxa" "p2.a" "p2.cmi" ] opam-2.0.5/tests/test-TEST.sh0000755000175000017500000000020313511367404014706 0ustar nicoonicoo#!/bin/sh if [ -f $1 ]; then . $1 fi if [ x${TEST} != x$2 ]; then echo "Error: TEST=${TEST} instead of $2" exit 2 fi opam-2.0.5/CONTRIBUTING.md0000644000175000017500000000100613511367404013704 0ustar nicoonicooBug reports and feature requests for **the opam tool** should be reported on: * http://github.com/ocaml/opam/issues (please include the output of `opam config report` whenever possible) **Packaging issues** or requests for a new package should be reported on: * http://github.com/ocaml/opam-repository/issues **General queries** can be addressed at: * http://lists.ocaml.org/listinfo/platform (for the both the tool & packages) * http://lists.ocaml.org/listinfo/opam-devel (for the tool and its evolution) opam-2.0.5/opam-core.opam0000644000175000017500000000171013511367404014215 0ustar nicoonicooopam-version: "1.2" version: "2.0.5" maintainer: "opam-devel@lists.ocaml.org" authors: [ "Vincent Bernardoff " "Raja Boujbel " "Roberto Di Cosmo " "Thomas Gazagnaire " "Louis Gesbert " "Fabrice Le Fessant " "Anil Madhavapeddy " "Guillem Rieu " "Ralf Treinen " "Frederic Tuong " ] homepage: "https://opam.ocaml.org/" bug-reports: "https://github.com/ocaml/opam/issues" dev-repo: "https://github.com/ocaml/opam.git" build: [ ["./configure" "--disable-checks" "--prefix" prefix] [make "%{name}%.install"] ] depends: [ "base-unix" "base-bigarray" "ocamlgraph" "re" {>= "1.5.0"} "dune" {build & >= "1.2.1"} "cppo" {build} ] conflicts: "extlib-compat" available: ocaml-version >= "4.02.3" opam-2.0.5/.ocp-indent0000644000175000017500000000003013511367404013510 0ustar nicoonicoonormal strict_else=auto opam-2.0.5/.travis-ci.sh0000755000175000017500000001337113511367404014001 0ustar nicoonicoo#!/bin/bash -xue OPAMBSVERSION=2.0.0-rc2 OPAMBSROOT=$HOME/.opam.cached OPAMBSSWITCH=opam-build PATH=~/local/bin:$PATH; export PATH TARGET="$1"; shift COLD=${COLD:-0} OPAM_TEST=${OPAM_TEST:-0} EXTERNAL_SOLVER=${EXTERNAL_SOLVER:-} init-bootstrap () { export OPAMROOT=$OPAMBSROOT # The system compiler will be picked up opam init --yes --no-setup eval $(opam env) opam update CURRENT_SWITCH=$(opam config var switch) if [[ $CURRENT_SWITCH != "default" ]] ; then opam switch default eval $(opam env) opam switch remove $CURRENT_SWITCH --yes fi if [ "$OPAM_TEST" = "1" ]; then opam switch create $OPAMBSSWITCH ocaml-system eval $(opam env) # extlib is installed, since UChar.cmi causes problems with the search # order. See also the removal of uChar and uTF8 in src_ext/jbuild-extlib-src opam install ssl cmdliner dose3 cudf.0.9 opam-file-format re extlib dune 'mccs>=1.1+5' --yes fi rm -f "$OPAMBSROOT"/log/* } case "$TARGET" in prepare) mkdir -p ~/local/bin # Git should be configured properly to run the tests git config --global user.email "travis@example.com" git config --global user.name "Travis CI" git config --global gc.autoDetach false # Disable bubblewrap wrapping, it's not available within Docker cat <>~/.opamrc required-tools: [ ["curl" "wget"] {"A download tool is required, check env variables OPAMCURL or OPAMFETCH"} "diff" "patch" "tar" "unzip" ] wrap-build-commands: [] wrap-install-commands: [] wrap-remove-commands: [] EOF if [[ $COLD -eq 1 ]] ; then if [ ! -x ~/local/bin/make ] ; then wget http://ftpmirror.gnu.org/gnu/make/make-4.2.tar.gz tar -xzf make-4.2.tar.gz mkdir make-4.2-build cd make-4.2-build ../make-4.2/configure --prefix ~/local make make install cd .. fi else if [[ $TRAVIS_OS_NAME = "osx" && -n $EXTERNAL_SOLVER ]] ; then rvm install ruby-2.3.3 rvm --default use 2.3.3 brew install "$EXTERNAL_SOLVER" fi if [[ -e ~/local/versions ]] ; then . ~/local/versions if [[ $LOCAL_OCAML_VERSION != $OCAML_VERSION ]] ; then echo "Cached compiler is $LOCAL_OCAML_VERSION; requested $OCAML_VERSION" echo "Resetting local cache" rm -rf ~/local elif [[ ${LOCAL_OPAMBSVERSION:-$OPAMBSVERSION} != $OPAMBSVERSION ]] ; then echo "Cached opam is $LOCAL_OPAMBSVERSION; requested $OPAMBSVERSION" echo "Replacement opam will be downloaded" rm -f ~/local/bin/opam-bootstrap fi fi fi exit 0 ;; install) if [[ $COLD -eq 1 ]] ; then make compiler make lib-pkg else if [[ ! -x ~/local/bin/ocaml ]] ; then echo -en "travis_fold:start:ocaml\r" wget http://caml.inria.fr/pub/distrib/ocaml-${OCAML_VERSION%.*}/ocaml-$OCAML_VERSION.tar.gz tar -xzf ocaml-$OCAML_VERSION.tar.gz cd ocaml-$OCAML_VERSION if [[ $OPAM_TEST -ne 1 ]] ; then CONFIGURE_SWITCHES="-no-ocamldoc" if [[ "$OCAML_VERSION" != "4.02.3" ]] ; then CONFIGURE_SWITCHES="$CONFIGURE_SWITCHES -no-ocamlbuild" fi fi ./configure --prefix ~/local -no-graph -no-debugger ${CONFIGURE_SWITCHES:-} if [[ $OPAM_TEST -eq 1 ]] ; then make -j 4 world.opt else make world.opt fi make install echo "LOCAL_OCAML_VERSION=$OCAML_VERSION" > ~/local/versions echo -en "travis_fold:end:ocaml\r" fi if [[ $OPAM_TEST -eq 1 ]] ; then echo -en "travis_fold:start:opam\r" if [[ ! -e ~/local/bin/opam-bootstrap ]] ; then wget -q -O ~/local/bin/opam-bootstrap \ "https://github.com/ocaml/opam/releases/download/$OPAMBSVERSION/opam-$OPAMBSVERSION-$(uname -m)-$(uname -s)" fi cp -f ~/local/bin/opam-bootstrap ~/local/bin/opam chmod a+x ~/local/bin/opam if [[ -d $OPAMBSROOT ]] ; then init-bootstrap || { rm -rf $OPAMBSROOT; init-bootstrap; } else init-bootstrap fi echo -en "travis_fold:end:opam\r" fi fi exit 0 ;; build) ;; *) echo "bad command $TARGET"; exit 1 esac export OPAMYES=1 export OCAMLRUNPARAM=b ( # Run subshell in bootstrap root env to build if [[ $OPAM_TEST -eq 1 ]] ; then export OPAMROOT=$OPAMBSROOT eval $(opam env) fi ./configure --prefix ~/local --with-mccs if [[ $OPAM_TEST$COLD -eq 0 ]] ; then make lib-ext fi make all make man rm -f ~/local/bin/opam make install if [ "$OPAM_TEST" = "1" ]; then make distclean for pin in core format solver repository state client ; do opam pin add --kind=path opam-$pin . --yes done # Compile and run opam-rt cd ~/build wget https://github.com/ocaml/opam-rt/archive/opam2.0.tar.gz -O opam-rt.tar.gz tar -xzf opam-rt.tar.gz cd opam-rt-* opam install ./opam-rt.opam --deps-only -y make opam switch default opam switch remove $OPAMBSSWITCH --yes else # Note: these tests require a "system" compiler and will use the one in $OPAMBSROOT OPAMEXTERNALSOLVER="$EXTERNAL_SOLVER" make tests || (tail -n 2000 _build/default/tests/fulltest-*.log; echo "-- TESTS FAILED --"; exit 1) fi ) ( # Finally run the tests, in a clean environment export OPAMKEEPLOGS=1 if [[ $OPAM_TEST -eq 1 ]] ; then cd ~/build/opam-rt-* OPAMEXTERNALSOLVER="$EXTERNAL_SOLVER" make KINDS="local git" run else if [[ $COLD -eq 1 ]] ; then export PATH=$PWD/bootstrap/ocaml/bin:$PATH fi # Test basic actions opam init --bare opam switch create default ocaml-system eval $(opam env) opam install lwt opam list opam config report fi ) rm -f ~/local/bin/opam opam-2.0.5/appveyor_build.cmd0000644000175000017500000001623513511367404015176 0ustar nicoonicoo@rem *********************************************************************** @rem * * @rem * opam * @rem * * @rem * David Allsopp, OCaml Labs, Cambridge. * @rem * * @rem * Copyright 2018 MetaStack Solutions Ltd. * @rem * * @rem * All rights reserved. This file is distributed under the terms of * @rem * the GNU Lesser General Public License version 2.1, with the * @rem * special exception on linking described in the file LICENSE. * @rem * * @rem *********************************************************************** @rem BE CAREFUL ALTERING THIS FILE TO ENSURE THAT ERRORS PROPAGATE @rem IF A COMMAND SHOULD FAIL IT PROBABLY NEEDS TO END WITH @rem || exit /b 1 @rem BASICALLY, DO THE TESTING IN BASH... @rem Do not call setlocal! @echo off goto %1 goto :EOF :CheckPackage "%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %1" | findstr %1 > nul if %ERRORLEVEL% equ 1 ( echo Cygwin package %1 will be installed set CYGWIN_INSTALL_PACKAGES=%CYGWIN_INSTALL_PACKAGES%,%1 ) goto :EOF :UpgradeCygwin if "%CYGWIN_INSTALL_PACKAGES%" neq "" "%CYG_ROOT%\setup-%CYG_ARCH%.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --packages %CYGWIN_INSTALL_PACKAGES:~1% > nul for %%P in (%CYGWIN_COMMANDS%) do "%CYG_ROOT%\bin\bash.exe" -lc "%%P --help" > nul || set CYGWIN_UPGRADE_REQUIRED=1 "%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %CYGWIN_PACKAGES%" if %CYGWIN_UPGRADE_REQUIRED% equ 1 ( echo Cygwin package upgrade required - please go and drink coffee "%CYG_ROOT%\setup-%CYG_ARCH%.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --upgrade-also > nul "%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %CYGWIN_PACKAGES%" ) goto :EOF :install set CYG_ROOT=C:\%CYG_ROOT% cd "%APPVEYOR_BUILD_FOLDER%" rem CYGWIN_PACKAGES is the list of required Cygwin packages (cygwin is included rem in the list just so that the Cygwin version is always displayed on the log). rem CYGWIN_COMMANDS is a corresponding command to run with --version to test rem whether the package works. This is used to verify whether the installation rem needs upgrading. set CYGWIN_PACKAGES=cygwin make patch curl diffutils tar unzip set CYGWIN_COMMANDS=cygcheck make patch curl diff tar unzip if "%OCAML_PORT%" equ "mingw" ( set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-i686-gcc-g++ set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-w64-mingw32-g++ ) if "%OCAML_PORT%" equ "mingw64" ( set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-x86_64-gcc-g++ set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% x86_64-w64-mingw32-g++ ) if "%OCAML_PORT%" equ "" ( set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% gcc-g++ flexdll set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% g++ flexlink ) set CYGWIN_INSTALL_PACKAGES= set CYGWIN_UPGRADE_REQUIRED=0 for %%P in (%CYGWIN_PACKAGES%) do call :CheckPackage %%P call :UpgradeCygwin rem Use dra27 flexdll for native ports if "%OCAML_PORT%" neq "" git apply appveyor.patch set INSTALLED_URL= for /f "tokens=3" %%U in ('findstr /C:"URL_ocaml = " src_ext\Makefile') do set OCAML_URL=%%U for /f "tokens=3" %%U in ('findstr /C:"URL_flexdll = " src_ext\Makefile') do set FLEXDLL_URL=%%U if exist bootstrap\ocaml\lib\stdlib.cmxa ( echo Deleting out-of-date bootstrap compiler rd /s/q bootstrap ) if exist bootstrap\installed-tarball for /f "delims=" %%U in ('type bootstrap\installed-tarball') do set INSTALLED_URL=%%U if "%INSTALLED_URL%" neq "%OCAML_URL% %FLEXDLL_URL% %DEP_MODE%" if exist bootstrap\nul ( echo Required: %OCAML_URL% %FLEXDLL_URL% %DEP_MODE% echo Compiled: %INSTALLED_URL% echo Re-building bootstrap compiler rd /s/q bootstrap if exist src_ext\archives\nul rd /s/q src_ext\archives ) if "%DEP_MODE%" equ "lib-pkg" "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && make --no-print-directory -C src_ext lib-pkg-urls | head -n -1 | sort | uniq" > current-lib-pkg-list if not exist bootstrap\installed-packages goto SkipCheck fc bootstrap\installed-packages current-lib-pkg-list > nul if %ERRORLEVEL% equ 1 ( echo lib-pkg packages changed: "%CYG_ROOT%\bin\diff.exe" bootstrap/installed-packages current-lib-pkg-list | "%CYG_ROOT%\bin\sed.exe" -ne "s//Add/p" | "%CYG_ROOT%\bin\gawk.exe" "BEGIN{FS="" ""}$2!=k{if(k!="""")print o==f?w:o;w=$0;k=$2;f=o=$2"" ""$3;next}{o=""Switch ""o"" --> ""$3}END{print o==f?w:o}" echo lib-pkg will be re-built "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && make --no-print-directory -C src_ext reset-lib-pkg" del bootstrap\installed-packages ) else ( del current-lib-pkg-list ) :SkipCheck "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && make --no-print-directory -C src_ext cache-archives" || exit /b 1 if not exist bootstrap\nul ( "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && make compiler" || exit /b 1 for /f "delims=" %%U in ('type bootstrap\installed-tarball') do echo %%U %DEP_MODE%> bootstrap\installed-tarball if exist bootstrap\ocaml-*.tar.gz del bootstrap\ocaml-*.tar.gz if "%OCAML_PORT%" neq "" if exist bootstrap\flexdll-*.tar.gz del bootstrap\flexdll-*.tar.gz del bootstrap\ocaml\bin\*.byte.exe del bootstrap\ocaml\lib\ocaml\expunge.exe for /f %%D in ('dir /b/ad bootstrap\ocaml-*') do ( rd /s/q bootstrap\%%D rem Directory needs to exist, as the Cygwin bootstraps OCAMLLIB refers to it rem and bootstrap-ocaml.sh assumes it will exist even when regenerating the rem config. md bootstrap\%%D ) ) else ( if not exist bootstrap\installed-packages "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && make --no-print-directory -C src_ext reset-lib-pkg" if exist current-lib-pkg-list "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && GEN_CONFIG_ONLY=1 shell/bootstrap-ocaml.sh %OCAML_PORT%" || exit /b 1 ) if exist current-lib-pkg-list ( "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER && make lib-pkg" || exit /b 1 move current-lib-pkg-list bootstrap\installed-packages ) goto :EOF :build if "%OCAML_PORT%" equ "" ( rem make install doesn't yet work for the native Windows builds set POST_COMMAND=^&^& make opam-installer install ) set LIB_EXT= if "%DEP_MODE%" equ "lib-ext" set LIB_EXT=^&^& make lib-ext set PRIVATE_RUNTIME= if "%OCAML_PORT:~0,5%" equ "mingw" set PRIVATE_RUNTIME=--with-private-runtime "%CYG_ROOT%\bin\bash.exe" -lc "cd $APPVEYOR_BUILD_FOLDER %LIB_PKG% && ./configure %PRIVATE_RUNTIME% %LIB_EXT% && make opam %POST_COMMAND%" || exit /b 1 goto :EOF :test if "%OCAML_PORT%" neq "" ( echo Running the opam command... opam || exit /b 1 ) rem Can't yet do an opam init with the native Windows builds if "%OCAML_PORT%" equ "" "%CYG_ROOT%\bin\bash.exe" -lc "make -C $APPVEYOR_BUILD_FOLDER run-appveyor-test" || exit /b 1 goto :EOF opam-2.0.5/opam-solver.opam0000644000175000017500000000166213511367404014605 0ustar nicoonicooopam-version: "1.2" version: "2.0.5" maintainer: "opam-devel@lists.ocaml.org" authors: [ "Vincent Bernardoff " "Raja Boujbel " "Roberto Di Cosmo " "Thomas Gazagnaire " "Louis Gesbert " "Fabrice Le Fessant " "Anil Madhavapeddy " "Guillem Rieu " "Ralf Treinen " "Frederic Tuong " ] homepage: "https://opam.ocaml.org/" bug-reports: "https://github.com/ocaml/opam/issues" dev-repo: "https://github.com/ocaml/opam.git" build: [ ["./configure" "--disable-checks" "--prefix" prefix] [make "%{name}%.install"] ] depends: [ "opam-format" {= "2.0.5"} "mccs" {>= "1.1+9"} "dose3" {>= "5"} "cudf" {>= "0.7"} "dune" {build & >= "1.2.1"} ] available: ocaml-version >= "4.02.3" opam-2.0.5/.gitattributes0000644000175000017500000000057213511367404014355 0ustar nicoonicoo# Default behaviour, for if core.autocrlf isn't set * text=auto # Shell scripts, autoconf, etc. must have LF endings, even on Windows *.sh text eol=lf *.zsh text eol=lf configure text eol=lf -diff configure.ac text eol=lf msvs-detect text eol=lf check_linker text eol=lf *.m4 text eol=lf # Treat patches as binary for safety *.patch binary # Actual binary files *.pdf binary opam-2.0.5/.travis.yml0000644000175000017500000000224613511367404013573 0ustar nicoonicoolanguage: c sudo: false addons: apt: packages: - aspcud - libglpk-dev before_install: - bash -exu .travis-ci.sh prepare install: - bash -exu .travis-ci.sh install cache: directories: - $HOME/.opam.cached - $HOME/local script: - bash -exu .travis-ci.sh build matrix: include: - os: linux env: OCAML_VERSION=4.02.3 stage: Build - os: linux env: OCAML_VERSION=4.03.0 stage: Build - os: linux env: OCAML_VERSION=4.04.2 stage: Build - os: linux env: OCAML_VERSION=4.05.0 stage: Build - os: linux env: OCAML_VERSION=4.06.1 stage: Build - os: linux env: OCAML_VERSION=4.07.1 stage: Build - os: osx env: OCAML_VERSION=4.07.1 OPAM_TEST=1 stage: Test - os: osx env: OCAML_VERSION=4.03.0 stage: Test - os: linux env: OCAML_VERSION=4.07.1 OPAM_TEST=1 stage: Test - os: linux env: OCAML_VERSION=4.07.1 OPAM_TEST=1 EXTERNAL_SOLVER=aspcud stage: Test - os: linux env: COLD=1 stage: Test notifications: email: - opam-commits@lists.ocaml.org irc: - "chat.freenode.net#opam" opam-2.0.5/.gitignore0000644000175000017500000000211513511367404013445 0ustar nicoonicoo_build/ _obuild/ _opam/ _olint/ bootstrap/ tests/tmp/ .*.swp src_ext/lib src_ext/cudf/ src_ext/cppo/ src_ext/dose3/ src_ext/cmdliner/ src_ext/extlib/ src_ext/mccs/ src_ext/re/ src_ext/ocamlgraph/ src_ext/dune-local/ src_ext/result/ src_ext/opam-file-format/ src_ext/camlp4 src_ext/findlib src_ext/ocamlbuild src_ext/topkg src_ext/seq src_ext/*.*stamp src_ext/*.tbz src_ext/*.tar.gz src_ext/archives/* src_ext/*.*download src_ext/*.pkgbuild src_ext/dune Opam.Runtime.*/ *.tar.bz2 *.annot *.tar.gz *~ .#* \#*# opam opam-installer opam-admin.top opam.exe opam-installer.exe opam-admin.top.exe # debug files *.log *.cudf *.dot # Generated files: *.cmo *.cmx *.cmi *.cmt *.cmti *.cma *.cmxa *.cmxs *.a *.lib *.dll *.o *.obj *.install Makefile.config config.log config.status aclocal.m4 autom4te.cache src/*/.merlin src/client/manifest.inc src/client/opamManifest.inc src/client/*.dll src/stubs/dune src/tools/opam-putenv.inc # doc doc/dev-manual/*aux doc/dev-manual/*.html doc/dev-manual/*toc doc/html doc/man-html doc/tutorials/opam.wiki doc/dev-manual/*.out doc/man doc/pages/*.html src/x_build_libs.ocp opam-2.0.5/LICENSE0000644000175000017500000006451713511367404012500 0ustar nicoonicooOpam is distributed under the terms of the GNU Lesser General Public License (LGPL) version 2.1 (included below). As a special exception to the GNU Lesser General Public License, you may link, statically or dynamically, a "work that uses opam" with a publicly distributed version of opam to produce an executable file containing portions of opam, 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 opam", we mean either the unmodified opam as distributed by OCamlPro, or a modified version of the opam that is distributed under the conditions defined in clause 2 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. ---------------------------------------------------------------------- GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the 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 specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. one line to give the library's name and an idea of what it does. Copyright (C) year name of author This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. signature of Ty Coon, 1 April 1990 Ty Coon, President of Vice That's all there is to it! -------------------------------------------------- opam-2.0.5/admin-scripts/0000755000175000017500000000000013511367404014233 5ustar nicoonicooopam-2.0.5/admin-scripts/lint.ml0000755000175000017500000000354213511367404015542 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; open Opam_admin_top;; let includes = ref [] let excludes = ref [] let short = ref false let list = ref false let usage = "Arguments:\n\ \ -s\tshort format, don't print explanations\n\ \ -l\tlist format, only print package names\n\ \ [N]\tshow only the listed warnings\n\ \ -[N]\tskip any packages that trigger any of these warnings\n\ " let () = let args = match Array.to_list Sys.argv with | _::args -> args | [] -> [] in List.iter (function | "-s" -> short := true | "-l" -> list := true | a -> try if String.length a > 0 && a.[0] = '-' then excludes := 0 - int_of_string a :: !excludes else includes := int_of_string a :: !includes with Failure _ -> OpamConsole.msg "%s" usage; OpamStd.Sys.exit_because `Bad_argument) args let () = OpamPackage.Map.iter (fun nv prefix -> let opam_file = OpamRepositoryPath.opam repo prefix nv in let w, _ = OpamFileTools.lint_file opam_file in if List.exists (fun (n,_,_) -> List.mem n !excludes) w then () else let w = if !includes = [] then w else List.filter (fun (n,_,_) -> List.mem n !includes) w in if w <> [] then if !list then print_endline (OpamPackage.to_string nv) else if !short then OpamConsole.msg "%s %s\n" (OpamPackage.to_string nv) (OpamStd.List.concat_map " " (fun (n,k,_) -> OpamConsole.colorise (match k with `Warning -> `yellow | `Error -> `red) (string_of_int n)) w) else OpamConsole.msg "\r\027[KIn %s:\n%s\n" (OpamPackage.to_string nv) (OpamFileTools.warns_to_string w)) (OpamRepository.packages_with_prefixes repo) opam-2.0.5/admin-scripts/add-build-deps.ml0000755000175000017500000000147113511367404017351 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; open Opam_admin_top;; (* Add the "build" dependency flag to all ocamlfind depends *) let to_build = List.map OpamPackage.Name.of_string ["ocamlfind"] let addbuild (pkg, (flags, cstr) as atom) = if List.mem pkg to_build && not (List.mem OpamTypes.Depflag_Build flags) then OpamFormula.Atom (pkg, (OpamTypes.Depflag_Build::flags, cstr)) else OpamFormula.Atom atom ;; iter_packages ~opam:(fun _ opam0 -> let open OpamFile.OPAM in let opam = opam0 in let opam = with_depends opam @@ OpamFormula.map addbuild @@ depends opam in let opam = with_depopts opam @@ OpamFormula.map addbuild @@ depopts opam in let opam = if opam <> opam0 then with_opam_version opam @@ OpamVersion.of_string "1.2" else opam in opam) () opam-2.0.5/admin-scripts/split_install.ml0000755000175000017500000000311213511367404017446 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; #directory "+../re";; open Opam_admin_top;; open OpamTypes;; iter_packages ~opam:(fun _ opam -> let module O = OpamFile.OPAM in if O.install opam <> [] then opam else let rec rev_split_while acc cond = function | [] -> acc, [] | x::r when cond x -> rev_split_while (x::acc) cond r | l -> acc, List.rev l in let condition = function | (CString "install",_)::_, _ -> true | (CString "cp",_)::r, _ -> (try let dest = match List.filter (function | CString s, _ -> not (OpamStd.String.starts_with ~prefix:"-" s) | CIdent _, _ -> true) (List.rev r) with | (d, _)::_ -> d | _ -> raise Not_found in let dests = ["prefix";"bin";"sbin";"lib";"man";"doc";"share";"etc"; "toplevel";"stublibs";"doc"] in match dest with | CIdent i -> List.mem i dests | CString s -> Re.(execp (compile (seq [alt (List.map str dests); str "}%"])) s) with Not_found -> false) | l, _ -> List.exists (function | (CString arg, _) -> OpamStd.String.contains ~sub:"install" arg | _ -> false) l in let install, build = rev_split_while [] condition (List.rev (O.build opam)) in opam |> OpamFile.OPAM.with_build build |> OpamFile.OPAM.with_install install) () ;; opam-2.0.5/admin-scripts/extract_mini_repository.sh0000755000175000017500000000561713511367404021570 0ustar nicoonicoo#! /bin/sh set -e if [ $# = 0 ]; then cat < /dev/null || true done ## Convert the required compilers as packages "${SOURCE_DIR}"/compilers-to-packages.ml ## Fetch the packages and compilers archives for version in ${COMPILERS}; do opam admin make --resolve --compiler ${version} ocaml.${version} ${PACKAGES} done ## Remove the unrequired package "versions unrequired_version() { case "$1" in base-*) return 1;; *) for version in archives/* do if [ "${version}" = "archives/$1+opam.tar.gz" ]; then return 1; fi done esac return 0 } for dir in packages/*/* do if unrequired_version "${dir##packages/*/}"; then rm -r "${dir}" fi done # Remove empty directories in "packages/" for dir in packages/* do rmdir "${dir}" 2> /dev/null || true done ## Remove unrequired files rm -f .gitignore .travis-ci-install.sh .travis-ci.sh .travis.yml README.md ## Build the archive cd "${WORK_DIR}" tar czf "${TARGET_DIR}/opam-mini-repository.tar.gz" ${REPO_DIR_NAME} opam-2.0.5/admin-scripts/Makefile0000644000175000017500000000106613511367404015676 0ustar nicoonicooDEPS = core format repository INCLUDE = $(patsubst %,-I ../src/%,$(DEPS)) -I ../src/tools LIBS = $(patsubst %,../src/opam-%.cma,$(DEPS)) %: %.ml sed 's/^#.*//' $< >$*-tmp.ml ocamlfind ocamlc -package unix,re.glob,ocamlgraph -linkpkg $(INCLUDE) $(LIBS) ../src/tools/opam_admin_top.ml $*-tmp.ml -o $@ rm $*-tmp.ml 1_2_to_2_0: compilers-to-packages cp $< $@ couverture: couverture.ml sed 's/^#.*//' $< >couverture-tmp.ml ocamlfind ocamlopt -package re.glob,opam-lib.state -linkpkg ../src/tools/opam_admin_top.ml couverture-tmp.ml -o $@ rm couverture-tmp.ml opam-2.0.5/admin-scripts/to_1_1.ml0000755000175000017500000001033213511367404015651 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; #directory "+../re";; (* Converts OPAM 1.2 packages for compat with OPAM 1.1 * merge 'install' with 'build' * remove the new fields: install, flags and dev-repo * remove dependency flags ('build', 'test', 'doc') * set file version * replace inequality constraints with '> & <' * remove new global variables from filters in commands, messages, 'patches', 'available' *) open OpamTypes open OpamStd.Option.Op ;; OpamFormatConfig.update ~all_parens:true;; let rewrite_constraint ~conj = (* Rewrites '!=' *) OpamFormula.map OpamFormula.(function | (`Neq,v) -> if conj then And (Atom (`Lt,v), Atom (`Gt,v)) else Or (Atom (`Lt,v), Atom (`Gt,v)) | atom -> Atom atom) ;; let vars_new_1_2 = [ "compiler"; "ocaml-native"; "ocaml-native-tools"; "ocaml-native-dynlink"; "arch" ] let filter_string = let rex = Re.(compile ( seq [ str "%{"; rep (seq [opt (char '%'); opt (char '}'); diff notnl (set "}%")]); str "}%"; ])) in Re_pcre.substitute ~rex ~subst:(fun s -> match String.sub s 2 (String.length s - 4) with | "compiler" -> "ocaml-version" | "ocaml-native" | "ocaml-native-tools" | "ocaml-native-dynlink" -> "true" | s when List.mem s vars_new_1_2 -> "" | s when String.contains s '?' -> (* new if/else printers: use default *) (try let i = String.rindex s ':' + 1 in String.sub s i (String.length s - i) with Not_found -> s) | _ -> s ) let rec filter_vars = function | FIdent ([],i,None) when List.mem (OpamVariable.to_string i) vars_new_1_2 -> None | FString s -> Some (FString (filter_string s)) | FBool _ | FIdent _ as f -> Some f | FOp (f1,op,f2) -> (match filter_vars f1, filter_vars f2 with | Some f1, Some f2 -> Some (FOp (f1, op, f2)) | _ -> Some (FBool false)) | FAnd (f1,f2) -> (match filter_vars f1, filter_vars f2 with | Some f1, Some f2 -> Some (FAnd (f1, f2)) | opt, None | None, opt -> Some (FBool false)) | FOr (f1,f2) -> (match filter_vars f1, filter_vars f2 with | Some f1, Some f2 -> Some (FOr (f1, f2)) | opt, None | None, opt -> opt) | FNot f -> (match filter_vars f with | Some f -> Some (FNot f) | None -> None) | FUndef -> None let filter_vars_optlist ol = List.map (fun (x, filter) -> x, filter >>= filter_vars) ol let filter_args sl = OpamStd.List.filter_map (fun (s, filter) -> match s with | CString s -> Some (CString (filter_string s),filter) | CIdent i when List.mem i vars_new_1_2 -> None | id -> Some (id,filter)) sl let filter_vars_commands ol = List.map (fun (args, filter) -> filter_args (filter_vars_optlist args), filter >>= filter_vars) ol let to_1_1 _ opam = let module OF = OpamFile.OPAM in if OpamVersion.compare (OF.opam_version opam) (OpamVersion.of_string "1.2") < 0 then opam else let opam = OF.with_build opam (filter_vars_commands (OF.build opam @ OF.install opam)) in let opam = OF.with_install opam [] in let opam = OF.with_flags opam [] in let opam = OF.with_dev_repo opam None in let opam = OF.with_features opam [] in let opam = OF.with_opam_version opam (OpamVersion.of_string "1.1") in let remove_ext = OpamFormula.map (fun (n, (_,cstr)) -> OpamFormula.Atom (n, ([], rewrite_constraint ~conj:false cstr))) in let opam = OF.with_depends opam (remove_ext (OF.depends opam)) in let opam = OF.with_depopts opam (remove_ext (OF.depopts opam)) in let opam = OF.with_conflicts opam (OpamFormula.map (fun (n, cstr) -> OpamFormula.Atom (n, rewrite_constraint ~conj:false cstr)) (OF.conflicts opam)) in let opam = OF.with_available opam (filter_vars (OF.available opam) +! FBool true) in let opam = OF.with_patches opam (filter_vars_optlist (OF.patches opam)) in let opam = OF.with_libraries opam [] in let opam = OF.with_syntax opam [] in let opam = OF.with_messages opam (filter_vars_optlist (OF.messages opam)) in let opam = OF.with_post_messages opam (filter_vars_optlist (OF.post_messages opam)) in opam ;; Opam_admin_top.iter_packages ~opam:to_1_1 () opam-2.0.5/admin-scripts/add-github-dev.ml0000755000175000017500000000164313511367404017360 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; open Opam_admin_top;; #use "topfind";; #require "re";; let github_re = Re.compile (Re_perl.re "([^/]*github.com/.*)/archive/.*");; iter_packages_gen @@ fun nv ~prefix:_ ~opam ~descr:_ ~url ~dot_install:_ -> let opam = if OpamFile.OPAM.dev_repo opam <> None then opam else match url with | None -> opam | Some u -> let url = OpamFile.URL.url u in if url.OpamUrl.backend = `http && Re.execp github_re url.OpamUrl.path then let substrings = Re.exec github_re url.OpamUrl.path in let dev_url = { OpamUrl.transport = "git"; path = Re.get substrings 1; hash = None; backend = `git } in let opam = OpamFile.OPAM.with_dev_repo opam dev_url in OpamFile.OPAM.with_opam_version opam (OpamVersion.of_string "1.2") else opam in opam, `Keep, `Keep, `Keep opam-2.0.5/admin-scripts/compilers-to-packages.ml0000755000175000017500000001275413511367404020772 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; #directory "+../re";; (**************************************************************************) (* *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamProcess.Job.Op open Opam_admin_top open OpamStd.Option.Op ;; let () = let error_printer = function | OpamParallel.Errors (_, (_,exc)::_, _) -> Some (Printexc.to_string exc) | _ -> None in Printexc.register_printer error_printer ;; let compilers = let compilers_dir = OpamFilename.Op.(repo.repo_root / "compilers") in if OpamFilename.exists_dir compilers_dir then ( List.fold_left (fun map f -> if OpamFilename.check_suffix f ".comp" then let c = OpamFilename.(Base.to_string (basename (chop_extension f))) in OpamStd.String.Map.add c f map else map) OpamStd.String.Map.empty (OpamFilename.rec_files compilers_dir) ) else OpamStd.String.Map.empty ;; OpamStd.String.Map.iter (fun c comp_file -> let comp = OpamFile.Comp.read (OpamFile.make comp_file) in let descr_file = OpamFilename.(opt_file (add_extension (chop_extension comp_file) "descr")) in let descr = descr_file >>| fun f -> OpamFile.Descr.read (OpamFile.make f) in let comp = let drop_names = [ OpamPackage.Name.of_string "base-ocamlbuild" ] in (* ocamlbuild has requirements on variable ocaml-version: it can't be in the dependencies *) OpamFile.Comp.with_packages (OpamFormula.map (fun ((name, _) as atom) -> if List.mem name drop_names then OpamFormula.Empty else Atom atom) (OpamFile.Comp.packages comp)) comp in let opam = OpamFile.Comp.to_package (OpamPackage.Name.of_string "ocaml") comp descr in let nv = OpamFile.OPAM.package opam in let patches = OpamFile.Comp.patches comp in if patches <> [] then OpamConsole.msg "Fetching patches of %s to check their checksums...\n" (OpamPackage.to_string nv); let cache_file : string list list OpamFile.t = OpamFile.make @@ OpamFilename.of_string "~/.cache/opam-compilers-to-packages/url-hashes" in let url_md5 = (OpamFile.Lines.read_opt cache_file +! [] |> List.map @@ function | [url; md5] -> OpamUrl.of_string url, md5 | _ -> failwith "Bad cache") |> OpamUrl.Map.of_list in let extra_sources = (* Download them just to get their mandatory MD5 *) OpamParallel.map ~jobs:3 ~command:(fun url -> try Done (Some (url, OpamUrl.Map.find url url_md5, None)) with Not_found -> let err e = OpamConsole.error "Could not get patch file for %s from %s (%s), skipping" (OpamPackage.to_string nv) (OpamUrl.to_string url) (Printexc.to_string e); Done None in OpamFilename.with_tmp_dir_job @@ fun dir -> try OpamProcess.Job.catch err (OpamDownload.download ~overwrite:false url dir @@| fun f -> Some (url, OpamFilename.digest f, None)) with e -> err e) (OpamFile.Comp.patches comp) in List.fold_left (fun url_md5 -> function | Some (url,md5,_) -> OpamUrl.Map.add url md5 url_md5 | None -> url_md5) url_md5 extra_sources |> OpamUrl.Map.bindings |> List.map (fun (url,m) -> [OpamUrl.to_string url; m]) |> OpamFile.Lines.write cache_file; if List.mem None extra_sources then () else let opam = opam |> OpamFile.OPAM.with_extra_sources (OpamStd.List.filter_some extra_sources) |> OpamFile.OPAM.with_substs [OpamFilename.Base.of_string "ocaml.config"] in OpamFile.OPAM.write (OpamRepositoryPath.opam repo (Some "ocaml") nv) opam; let config = OpamFile.Dot_config.create @@ List.map (fun (v,c) -> OpamVariable.of_string v, c) @@ [ "ocaml-version", S (OpamFile.Comp.version comp); "compiler", S (OpamFile.Comp.name comp); "preinstalled", B false; (* fixme: generate those from build/config artifacts using a script ? Guess from os and arch vars and use static 'features' + variable expansion ? ... or just let them be fixed by hand ? *) "ocaml-native", B true; "ocaml-native-tools", B true; "ocaml-native-dynlink", B true; "ocaml-stubsdir", S "%{lib}%/stublibs"; ] in OpamFile.Dot_config.write (OpamFile.make OpamFilename.Op.(OpamRepositoryPath.files repo (Some "ocaml") nv // "ocaml.config.in")) config; OpamFilename.remove comp_file; OpamStd.Option.iter OpamFilename.remove descr_file; OpamFilename.rmdir_cleanup (OpamFilename.dirname comp_file); OpamConsole.msg "Compiler %s successfully converted to package %s\n" c (OpamPackage.to_string nv)) compilers ;; opam-2.0.5/admin-scripts/cudf-debug.ml0000755000175000017500000000343113511367404016576 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../cudf";; #directory "+../dose3";; #directory "+../opam-lib";; open Opam_admin_top;; let cudf2opam_name cpkg = OpamPackage.Name.of_string (try Cudf.lookup_package_property cpkg OpamCudf.s_source with Not_found -> Common.CudfAdd.decode cpkg.Cudf.package) let cudf2opam_version cpkg = OpamPackage.Version.of_string (try Cudf.lookup_package_property cpkg OpamCudf.s_source_number with Not_found -> Printf.sprintf "#cudf%d" cpkg.Cudf.version) let cudf_pp cpkg = OpamPackage.Name.to_string (cudf2opam_name cpkg), OpamPackage.Version.to_string (cudf2opam_version cpkg), [] let rebuild_version_map univ = Cudf.fold_packages (fun acc cpkg -> let nv = OpamPackage.create (cudf2opam_name cpkg) (cudf2opam_version cpkg) in OpamPackage.Map.add nv cpkg.Cudf.version acc ) OpamPackage.Map.empty univ let _ = match Cudf_parser.load_from_file Sys.argv.(1) with | Some preamble, univ, Some req -> begin match Algo.Depsolver.check_request ~explain:true (preamble, univ, req) with | Algo.Depsolver.Unsat (Some f) -> OpamConsole.msg "== DOSE MESSAGE ==\n"; flush stdout; Algo.Diagnostic.fprintf_human ~pp:cudf_pp Format.err_formatter f; flush stderr; let version_map = rebuild_version_map univ in begin match OpamCudf.make_conflicts ~version_map univ f with | OpamTypes.Conflicts cs -> OpamConsole.msg "== OPAM MESSAGE ==\n%s\n" (OpamCudf.string_of_conflict (fun a -> Printf.sprintf "%s unavailable" (OpamFormula.string_of_atom a)) cs) | _ -> prerr_endline "unhandled case" end | _ -> () end | _ -> OpamConsole.error_and_exit `Solver_error "unsupported cudf file" opam-2.0.5/admin-scripts/depopts_to_conflicts.ml0000755000175000017500000000545213511367404021022 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; open Opam_admin_top;; let contains_neq f = try OpamFormula.iter (function (_,cs) -> OpamFormula.iter (function (`Neq,_) -> raise Exit | _ -> ()) cs) f; false with Exit -> true ;; iter_packages ~opam:(fun _ opam -> let depopts = let formula = OpamFile.OPAM.depopts opam in let atoms = OpamFormula.fold_left (fun acc (n,(flags,_)) -> OpamFormula.Atom (n, (flags, OpamFormula.Empty)) :: acc) [] formula in OpamFormula.ors @@ OpamStd.List.remove_duplicates @@ List.rev atoms in let conflicts = (* add complement of the depopts as conflicts *) let module NM = OpamPackage.Name.Map in let depopts = (* get back a map (name => version_constraint) *) (* XXX this takes _all_ the atoms not considering con/disjunctions *) OpamFormula.fold_left (fun acc (name,(_,f)) -> try NM.add name ((OpamFormula.ors [f; NM.find name acc])) acc with Not_found -> NM.add name f acc) NM.empty (OpamFile.OPAM.depopts opam) in let neg_depopts = NM.fold (fun name f acc -> if f = OpamFormula.Empty then acc else let f = OpamFormula.(neg (fun (op,v) -> neg_relop op, v) f) in match OpamFormula.to_cnf (OpamFormula.Atom (name,f)) with | [] -> acc | [conj] -> conj @ acc | [x;y] when x = y -> x @ acc | cnf -> (* Formula is not a conjunction, we are left with no choice but to enumerate *) let f = OpamFormula.to_atom_formula @@ OpamFormula.ands @@ List.map OpamFormula.of_disjunction cnf in let conflict_packages = OpamPackage.Set.filter (fun pkg -> OpamFormula.eval (fun atom -> OpamFormula.check atom pkg) f) (OpamPackage.packages_of_name packages name) in OpamPackage.Set.fold (fun nv acc -> (OpamPackage.name nv, Some (`Eq, OpamPackage.version nv)) :: acc) conflict_packages acc) depopts [] in let conflicts = OpamFile.OPAM.conflicts opam in let add_conflicts = let c = OpamFormula.to_disjunction conflicts in List.filter (fun f -> not (List.mem f c)) neg_depopts in OpamFormula.ors (conflicts :: [OpamFormula.of_disjunction add_conflicts]) in let opam = OpamFile.OPAM.with_depopts opam depopts in let opam = OpamFile.OPAM.with_conflicts opam conflicts in let opam = if contains_neq conflicts then OpamFile.OPAM.with_opam_version opam (OpamVersion.of_string "1.2") else opam in opam) () ;; opam-2.0.5/admin-scripts/couverture.ml0000755000175000017500000001216313511367404016776 0ustar nicoonicoo#!/usr/bin/env opam-admin.top #directory "+../opam-lib";; (**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** This script gives scenarios to install all named packages in a given set. This may require several steps, in case of conflicts. Consistent installation steps are printed one per line to stdout. Stderr gives more detail. Relies on the current opam root for the list of available packages, i.e. depends on configured remotes, OS and OCaml version, but not on the set of currently installed packages. *) open OpamTypes let max_install t inst_packages = let universe = OpamState.universe t Query in let wish_field = "wished" in let base = OpamState.base_packages t in let universe = { universe with u_installed = base; u_installed_roots = base; u_attrs = [wish_field, inst_packages]; } in if not (OpamCudf.external_solver_available ()) then failwith "No external solver found"; let preferences = let preferences = OpamSolverConfig.criteria `Default in Some (lazy (Printf.sprintf "+sum(solution,%s),%s" wish_field preferences)) in OpamSolverConfig.update ~solver_preferences_default:preferences (); let version_map = OpamSolver.cudf_versions_map universe universe.u_available in let request = { wish_install = []; wish_remove = []; wish_upgrade = []; extra_attributes = [wish_field]; criteria = `Default; } in let cudf_universe = OpamSolver.load_cudf_universe ~build:true universe ~version_map universe.u_available in match OpamCudf.resolve ~extern:true ~version_map cudf_universe request with | Conflicts _ -> failwith "Solver error (unexpected conflicts)" | Success u -> OpamPackage.Set.diff (OpamPackage.Set.of_list (List.map OpamCudf.cudf2opam (OpamCudf.packages u))) base module P = OpamPackage open P.Set.Op let rec couverture acc t pkgs = Printf.eprintf "# %d packages remaining...\n%!" (P.Name.Set.cardinal (P.names_of_packages pkgs)); let step = max_install t pkgs in let added = P.Name.Set.inter (P.names_of_packages step) (P.names_of_packages pkgs) in if P.Name.Set.is_empty added then let () = Printf.eprintf "# -> %d uninstallable packages remaining.\n%!" (P.Name.Set.cardinal (P.names_of_packages pkgs)) in List.rev acc, pkgs else let n = P.Name.Set.cardinal added in Printf.eprintf "# -> Step %d: covering %d/%d packages%s.\n%!" (List.length acc + 1) n (P.Name.Set.cardinal (P.names_of_packages pkgs)) (if n > 5 then "" else OpamStd.List.concat_map ~left:" (" ~right:")" " " P.Name.to_string (OpamPackage.Name.Set.elements added)); let pkgs = P.Set.filter (fun nv -> not (P.has_name step (P.name nv))) pkgs in couverture (step::acc) t pkgs let () = let root = OpamStateConfig.opamroot () in OpamFormatConfig.init (); if not (OpamStateConfig.load_defaults root) then failwith "Opam root not found"; OpamStd.Config.init (); OpamSolverConfig.init (); OpamStateConfig.init (); let t = OpamState.load_state ~save_cache:false "couverture" (OpamStateConfig.get_switch_opt ()) in let avail = Lazy.force t.OpamState.Types.available_packages in let wanted = match Array.to_list Sys.argv with | [] | _::[] -> avail -- P.packages_of_names avail (OpamState.base_package_names t) | _::l -> List.fold_left (fun wanted name -> let nvs = if String.contains name '.' then P.Set.singleton (P.of_string name) else P.packages_of_name avail (P.Name.of_string name) in if P.Set.is_empty (nvs %% avail) then failwith (Printf.sprintf "Package %s not found" name) else wanted ++ nvs ) P.Set.empty l in let couv,remaining = couverture [] t wanted in let avail_names = P.names_of_packages avail in let remaining_names = P.names_of_packages remaining in Printf.eprintf "# Found a couverture for %d over %d packages in %d steps:\n%!" (P.Name.Set.cardinal (P.Name.Set.diff avail_names remaining_names)) (P.Name.Set.cardinal avail_names) (List.length couv); List.iter (fun s -> print_endline (OpamStd.List.concat_map " " OpamPackage.to_string (P.Set.elements s))) couv; Printf.eprintf "# %d uninstallable packages remain: %s\n%!" (P.Name.Set.cardinal remaining_names) (OpamStd.List.concat_map " " OpamPackage.Name.to_string (P.Name.Set.elements remaining_names)) opam-2.0.5/opam-installer.opam0000644000175000017500000000161713511367404015270 0ustar nicoonicooopam-version: "1.2" version: "2.0.5" maintainer: "opam-devel@lists.ocaml.org" authors: [ "Vincent Bernardoff " "Raja Boujbel " "Roberto Di Cosmo " "Thomas Gazagnaire " "Louis Gesbert " "Fabrice Le Fessant " "Anil Madhavapeddy " "Guillem Rieu " "Ralf Treinen " "Frederic Tuong " ] homepage: "https://opam.ocaml.org/" bug-reports: "https://github.com/ocaml/opam/issues" dev-repo: "https://github.com/ocaml/opam.git" build: [ ["./configure" "--disable-checks" "--prefix" prefix] [make "%{name}%.install"] ] depends: [ "opam-format" {= "2.0.5"} "cmdliner" {>= "0.9.8"} "dune" {build & >= "1.2.1"} ] available: ocaml-version >= "4.02.3" opam-2.0.5/src/0000755000175000017500000000000013511367404012245 5ustar nicoonicooopam-2.0.5/src/stubs/0000755000175000017500000000000013511367404013405 5ustar nicoonicooopam-2.0.5/src/stubs/opamWindows.c0000644000175000017500000004565613511367404016100 0ustar nicoonicoo/**************************************************************************/ /* */ /* Copyright 2015, 2016, 2017, 2018 MetaStack Solutions Ltd. */ /* */ /* All rights reserved. This file is distributed under the terms of the */ /* GNU Lesser General Public License version 2.1, with the special */ /* exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #define CAML_NAME_SPACE /* We need the UTF16 conversion functions */ #define CAML_INTERNALS #include #include #include #include #include #include #include #include #include #include /* In a previous incarnation, dummy C stubs were generated for non-Windows * builds. Although this is no longer used, the C sources retain the ability to * be compiled this way. */ #ifdef _WIN32 #include #include #include static struct custom_operations HandleOps = { "org.ocaml.opam.Win32.Handle/1", custom_finalize_default, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default }; #define HANDLE_val(v) (*((HANDLE*)Data_custom_val(v))) typedef BOOL (WINAPI *LPFN_ISWOW64PROCESS) (HANDLE, PBOOL); static LPFN_ISWOW64PROCESS IsWoW64Process = NULL; static inline BOOL has_IsWoW64Process(void) { return (IsWoW64Process || (IsWoW64Process = (LPFN_ISWOW64PROCESS)GetProcAddress(GetModuleHandle("kernel32"), "IsWow64Process"))); } /* * Taken from otherlibs/win32unix/winwait.c (sadly declared static) * Altered only for CAML_NAME_SPACE */ static value alloc_process_status(HANDLE pid, int status) { value res, st; st = caml_alloc(1, 0); Field(st, 0) = Val_int(status); Begin_root (st); res = caml_alloc_small(2, 0); Field(res, 0) = Val_long((intnat) pid); Field(res, 1) = st; End_roots(); return res; } /* Order must match OpamStubsTypes.registry_root */ static HKEY roots[] = {HKEY_CLASSES_ROOT, HKEY_CURRENT_CONFIG, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS}; /* * OPAMW_process_putenv is implemented using Process Injection. * Idea inspired by Bill Stewart's editvar * (see http://www.westmesatech.com/editv.html) * Full technical details at http://www.codeproject.com/Articles/4610/Three-Ways-to-Inject-Your-Code-into-Another-Proces#section_3 */ static char* getProcessInfo(HANDLE hProcessSnapshot, DWORD processId, PROCESSENTRY32 *entry) { entry->dwSize = sizeof(PROCESSENTRY32); if (hProcessSnapshot == INVALID_HANDLE_VALUE) return "getProcessInfo: could not create snapshot"; /* * Locate our process */ if (!Process32First(hProcessSnapshot, entry)) { CloseHandle(hProcessSnapshot); return "getProcessInfo: could not walk process tree"; } else { while (entry->th32ProcessID != processId) { if (!Process32Next(hProcessSnapshot, entry)) { CloseHandle(hProcessSnapshot); return "getProcessInfo: could not find process!"; } } } return NULL; } char* InjectSetEnvironmentVariable(DWORD pid, char* key, char* val); #define OPAMreturn CAMLreturn #else #define OPAMreturn(v) CAMLreturn(Val_unit) #endif /* Actual primitives from here */ CAMLprim value OPAMW_GetCurrentProcessID(value unit) { CAMLparam1(unit); OPAMreturn(caml_copy_int32(GetCurrentProcessId())); } CAMLprim value OPAMW_GetStdHandle(value nStdHandle) { CAMLparam1(nStdHandle); #ifdef _WIN32 CAMLlocal1(result); HANDLE hResult; if ((hResult = GetStdHandle(-Int_val(nStdHandle) - 10)) == NULL) caml_raise_not_found(); result = caml_alloc_custom(&HandleOps, sizeof(HANDLE), 0, 1); HANDLE_val(result) = hResult; #endif OPAMreturn(result); } CAMLprim value OPAMW_GetConsoleScreenBufferInfo(value hConsoleOutput) { CAMLparam1(hConsoleOutput); #ifdef _WIN32 CAMLlocal2(result, coord); CONSOLE_SCREEN_BUFFER_INFO buffer; if (!GetConsoleScreenBufferInfo(HANDLE_val(hConsoleOutput), &buffer)) caml_raise_not_found(); result = caml_alloc(5, 0); coord = caml_alloc(2, 0); Store_field(coord, 0, Val_int(buffer.dwSize.X)); Store_field(coord, 1, Val_int(buffer.dwSize.Y)); Store_field(result, 0, coord); coord = caml_alloc(2, 0); Store_field(coord, 0, Val_int(buffer.dwCursorPosition.X)); Store_field(coord, 1, Val_int(buffer.dwCursorPosition.Y)); Store_field(result, 1, coord); Store_field(result, 2, Val_int(buffer.wAttributes)); coord = caml_alloc(4, 0); Store_field(coord, 0, Val_int(buffer.srWindow.Left)); Store_field(coord, 1, Val_int(buffer.srWindow.Top)); Store_field(coord, 2, Val_int(buffer.srWindow.Right)); Store_field(coord, 3, Val_int(buffer.srWindow.Bottom)); Store_field(result, 3, coord); coord = caml_alloc(2, 0); Store_field(coord, 0, Val_int(buffer.dwMaximumWindowSize.X)); Store_field(coord, 1, Val_int(buffer.dwMaximumWindowSize.Y)); Store_field(result, 4, coord); #endif OPAMreturn(result); } CAMLprim value OPAMW_SetConsoleTextAttribute(value hConsoleOutput, value wAttributes) { CAMLparam2(hConsoleOutput, wAttributes); #ifdef _WIN32 if (!SetConsoleTextAttribute(HANDLE_val(hConsoleOutput), Int_val(wAttributes))) caml_failwith("setConsoleTextAttribute"); #endif OPAMreturn(Val_unit); } CAMLprim value OPAMW_FillConsoleOutputCharacter(value vhConsoleOutput, value character, value vnLength, value vdwWriteCoord) { CAMLparam4(vhConsoleOutput, character, vnLength, vdwWriteCoord); #ifdef _WIN32 HANDLE hConsoleOutput = HANDLE_val(vhConsoleOutput); CONSOLE_SCREEN_BUFFER_INFO ConsoleScreenBufferInfo; WCHAR cCharacter = Int_val(character) & 0xFF; DWORD nLength = Int_val(vnLength); COORD dwWriteCoord = {Int_val(Field(vdwWriteCoord, 0)), Int_val(Field(vdwWriteCoord, 1))}; DWORD dwNumberOfCharsWritten; BOOL result = FALSE; if (GetConsoleScreenBufferInfo(hConsoleOutput, &ConsoleScreenBufferInfo)) { while ((result = FillConsoleOutputCharacter(hConsoleOutput, cCharacter, nLength, dwWriteCoord, &dwNumberOfCharsWritten)) && dwNumberOfCharsWritten != nLength) { nLength -= dwNumberOfCharsWritten; dwWriteCoord.X += dwNumberOfCharsWritten; dwWriteCoord.Y += dwWriteCoord.X / ConsoleScreenBufferInfo.dwSize.X; dwWriteCoord.X %= ConsoleScreenBufferInfo.dwSize.X; } } #endif OPAMreturn(Val_bool(result)); } CAMLprim value OPAMW_GetConsoleMode(value hConsoleHandle) { CAMLparam1(hConsoleHandle); #ifdef _WIN32 DWORD dwMode; if (!GetConsoleMode(HANDLE_val(hConsoleHandle), &dwMode)) #endif caml_raise_not_found(); OPAMreturn(Val_int(dwMode)); } CAMLprim value OPAMW_SetConsoleMode(value hConsoleMode, value dwMode) { CAMLparam2(hConsoleMode, dwMode); #ifdef _WIN32 BOOL result = SetConsoleMode(HANDLE_val(hConsoleMode), Int_val(dwMode)); #endif OPAMreturn(Val_bool(result)); } CAMLprim value OPAMW_GetWindowsVersion(value unit) { CAMLparam1(unit); #ifdef _WIN32 CAMLlocal1(result); result = caml_alloc_tuple(4); #if OCAML_VERSION >= 40600 Store_field(result, 0, Val_int(caml_win32_major)); Store_field(result, 1, Val_int(caml_win32_minor)); Store_field(result, 2, Val_int(caml_win32_build)); Store_field(result, 3, Val_int(caml_win32_revision)); #else Store_field(result, 0, Val_int(0)); Store_field(result, 1, Val_int(0)); Store_field(result, 2, Val_int(0)); Store_field(result, 3, Val_int(0)); #endif #endif OPAMreturn(result); } CAMLprim value OPAMW_IsWoW64(value unit) { CAMLparam1(unit); #ifdef _WIN32 BOOL result = FALSE; /* * 32-bit versions may or may not have IsWow64Process (depends on age). * Recommended way is to use GetProcAddress to obtain IsWow64Process, rather * than relying on Windows.h. * See http://msdn.microsoft.com/en-gb/library/windows/desktop/ms684139.aspx */ if (has_IsWoW64Process() && !IsWoW64Process(GetCurrentProcess(), &result)) result = FALSE; #endif OPAMreturn(Val_bool(result)); } /* * Adapted from otherlibs/win32unix/winwait.c win_waitpid */ CAMLprim value OPAMW_waitpids(value vpid_reqs, value vpid_len) { #ifdef _WIN32 int i; DWORD status, retcode; HANDLE pid_req; DWORD err = 0; int len = Int_val(vpid_len); HANDLE *lpHandles = (HANDLE*)malloc(sizeof(HANDLE) * len); value ptr = vpid_reqs; if (lpHandles == NULL) caml_raise_out_of_memory(); for (i = 0; i < len; i++) { lpHandles[i] = (HANDLE)Long_val(Field(ptr, 0)); ptr = Field(ptr, 1); } caml_enter_blocking_section(); retcode = WaitForMultipleObjects(len, lpHandles, FALSE, INFINITE); if (retcode == WAIT_FAILED) err = GetLastError(); caml_leave_blocking_section(); if (err) { win32_maperr(err); uerror("waitpids", Nothing); } pid_req = lpHandles[retcode - WAIT_OBJECT_0]; free(lpHandles); if (! GetExitCodeProcess(pid_req, &status)) { win32_maperr(GetLastError()); uerror("waitpids", Nothing); } /* * NB Unlike in win_waitpid, it's not possible to have status == STILL_ACTIVE */ CloseHandle(pid_req); return alloc_process_status(pid_req, status); #else return Val_unit; #endif } CAMLprim value OPAMW_WriteRegistry(value hKey, value lpSubKey, value lpValueName, value dwType, value lpData) { CAMLparam5(hKey, lpSubKey, lpValueName, dwType, lpData); #ifdef _WIN32 HKEY key; void* buf = NULL; DWORD cbData = 0; DWORD type = 0; switch (RegOpenKeyEx(roots[Int_val(hKey)], String_val(lpSubKey), 0, KEY_WRITE, &key)) { case ERROR_SUCCESS: { /* Cases match OpamStubsTypes.registry_value */ switch (Int_val(dwType)) { case 0: { buf = String_val(lpData); cbData = strlen(buf) + 1; type = REG_SZ; break; } default: { caml_failwith("OPAMW_WriteRegistry: value not implemented"); break; } } if (RegSetValueEx(key, String_val(lpValueName), 0, type, (LPBYTE)buf, cbData) != ERROR_SUCCESS) { RegCloseKey(key); caml_failwith("RegSetValueEx"); } RegCloseKey(key); break; } case ERROR_FILE_NOT_FOUND: { caml_raise_not_found(); break; } default: { caml_failwith("RegOpenKeyEx"); break; } } #endif OPAMreturn(Val_unit); } CAMLprim value OPAMW_GetConsoleOutputCP(value unit) { CAMLparam1(unit); OPAMreturn(Val_int(GetConsoleOutputCP())); } CAMLprim value OPAMW_GetCurrentConsoleFontEx(value hConsoleOutput, value bMaximumWindow) { CAMLparam2(hConsoleOutput, bMaximumWindow); #ifdef _WIN32 CAMLlocal3(result, coord, name); int len; CONSOLE_FONT_INFOEX fontInfo; fontInfo.cbSize = sizeof(fontInfo); if (GetCurrentConsoleFontEx(HANDLE_val(hConsoleOutput), Bool_val(bMaximumWindow), &fontInfo)) { result = caml_alloc(5, 0); Store_field(result, 0, Val_int(fontInfo.nFont)); coord = caml_alloc(2, 0); Store_field(coord, 0, Val_int(fontInfo.dwFontSize.X)); Store_field(coord, 0, Val_int(fontInfo.dwFontSize.Y)); Store_field(result, 1, coord); Store_field(result, 2, Val_int(fontInfo.FontFamily)); Store_field(result, 3, Val_int(fontInfo.FontWeight)); Store_field(result, 4, caml_copy_string_of_utf16(fontInfo.FaceName)); } else { caml_raise_not_found(); } #endif OPAMreturn(result); } CAMLprim value OPAMW_CreateGlyphChecker(value fontName) { CAMLparam1(fontName); #ifdef _WIN32 CAMLlocal2(result, handle); /* * Any device context will do to load the font, so use the Screen DC. */ HDC hDC = GetDC(NULL); if (hDC) { wchar_t* lpszFace = caml_stat_strdup_to_utf16(String_val(fontName)); HFONT hFont = CreateFontW(0, 0, 0, 0, FW_DONTCARE, FALSE, FALSE, FALSE, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, lpszFace); caml_stat_free(lpszFace); if (hFont) { if (SelectObject(hDC, hFont)) { result = caml_alloc_tuple(2); handle = caml_alloc_custom(&HandleOps, sizeof(HANDLE), 0, 1); HANDLE_val(handle) = hDC; Store_field(result, 0, handle); handle = caml_alloc_custom(&HandleOps, sizeof(HANDLE), 0, 1); HANDLE_val(handle) = hFont; Store_field(result, 1, handle); } else { caml_failwith("OPAMW_CheckGlyphs: SelectObject"); } } else { caml_failwith("OPAMW_CheckGlyphs: CreateFontW"); } } else { caml_failwith("OPAMW_CheckGlyphs: GetDC"); } #endif OPAMreturn(result); } CAMLprim value OPAMW_DeleteGlyphChecker(value checker) { CAMLparam1(checker); #ifdef _WIN32 DeleteObject(HANDLE_val(Field(checker, 1))); ReleaseDC(NULL, HANDLE_val(Field(checker, 0))); #endif CAMLreturn(Val_unit); } CAMLprim value OPAMW_HasGlyph(value checker, value scalar) { CAMLparam2(checker, scalar); #ifdef _WIN32 BOOL result = FALSE; HDC hDC = HANDLE_val(Field(checker, 0)); WCHAR test = (WCHAR)Int_val(scalar); WORD index = 0; switch (GetGlyphIndicesW(hDC, &test, 1, &index, GGI_MARK_NONEXISTING_GLYPHS)) { case 1: break; case GDI_ERROR: caml_failwith("OPAMW_CheckGlyphs: GetGlyphIndicesW"); default: caml_failwith("OPAMW_CheckGlyphs: GetGlyphIndicesW (unexpected return)"); } #endif OPAMreturn(Val_bool(test != 0xffff)); } CAMLprim value OPAMW_process_putenv(value pid, value key, value val) { CAMLparam3(pid, key, val); #ifdef _WIN32 CAMLlocal1(res); char* result; /* * MSDN is all over the place as to what the technical limits are for * environment variables (looks like 32KiB for both both name and value) * however there's no need to inject 64KiB data each time - hence 4KiB limit. */ if (caml_string_length(key) > 4095 || caml_string_length(val) > 4095) caml_invalid_argument("Strings too long"); result = InjectSetEnvironmentVariable(Int32_val(pid), String_val(key), String_val(val)); if (result == NULL) { res = Val_true; } else if (strlen(result) == 0) { res = Val_false; } else { caml_failwith(result); } #endif OPAMreturn(res); } CAMLprim value OPAMW_IsWoW64Process(value pid) { CAMLparam1(pid); #ifdef _WIN32 BOOL result = FALSE; if (has_IsWoW64Process()) { HANDLE hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, Int32_val(pid)); if (hProcess) { if (!IsWoW64Process(hProcess, &result)) result = FALSE; CloseHandle(hProcess); } } #endif OPAMreturn(Val_bool(result)); } /* * Somewhat against my better judgement, wrap SHGetFolderPath rather than * SHGetKnownFolderPath to maintain XP compatibility. OPAM already requires * Windows Vista+ because of GetCurrentConsoleFontEx, but there may be a * workaround for that for XP lusers. */ CAMLprim value OPAMW_SHGetFolderPath(value nFolder, value dwFlags) { CAMLparam2(nFolder, dwFlags); #ifdef _WIN32 CAMLlocal1(result); TCHAR szPath[MAX_PATH]; if (SUCCEEDED(SHGetFolderPath(NULL, Int_val(nFolder), NULL, Int_val(dwFlags), szPath))) result = caml_copy_string(szPath); else caml_failwith("OPAMW_SHGetFolderPath"); #endif OPAMreturn(result); } CAMLprim value OPAMW_SendMessageTimeout(value hWnd, value uTimeout, value fuFlags, value vmsg, value vwParam, value vlParam) { CAMLparam5(hWnd, vmsg, vwParam, vlParam, fuFlags); CAMLxparam1(uTimeout); #ifdef _WIN32 CAMLlocal1(result); DWORD_PTR dwReturnValue; HRESULT lResult; WPARAM wParam; LPARAM lParam; UINT msg; switch (Int_val(vmsg)) { case 0: { msg = WM_SETTINGCHANGE; wParam = Int_val(vwParam); lParam = (LPARAM)String_val(vlParam); break; } default: { caml_failwith("OPAMW_SendMessageTimeout: message not implemented"); break; } } lResult = SendMessageTimeout((HWND)Nativeint_val(hWnd), msg, wParam, lParam, Int_val(fuFlags), Int_val(uTimeout), &dwReturnValue); switch (Int_val(vmsg)) { case 0: { result = caml_alloc(2, 0); Store_field(result, 0, Val_int(lResult)); Store_field(result, 1, Val_int(dwReturnValue)); break; } } #endif OPAMreturn(result); } CAMLprim value OPAMW_SendMessageTimeout_byte(value * v, int n) { return OPAMW_SendMessageTimeout(v[0], v[1], v[2], v[3], v[4], v[5]); } CAMLprim value OPAMW_GetParentProcessID(value processId) { CAMLparam1(processId); #ifdef _WIN32 PROCESSENTRY32 entry; char* msg; /* * Create a Toolhelp Snapshot of running processes */ HANDLE hProcessSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if ((msg = getProcessInfo(hProcessSnapshot, Int32_val(processId), &entry))) caml_failwith(msg); /* * Finished with the snapshot */ CloseHandle(hProcessSnapshot); #endif OPAMreturn(caml_copy_int32(entry.th32ParentProcessID)); } CAMLprim value OPAMW_GetConsoleAlias(value alias, value exeName) { CAMLparam2(alias, exeName); #ifdef _WIN32 CAMLlocal1(result); DWORD nLength = 8192; LPTSTR buffer = (LPTSTR)malloc(nLength); if (!buffer) caml_raise_out_of_memory(); if (GetConsoleAlias(String_val(alias), buffer, nLength, String_val(exeName))) { result = caml_copy_string(buffer); } else { result = caml_copy_string(""); } free(buffer); #endif OPAMreturn(result); } opam-2.0.5/src/stubs/c-flags.sexp.in0000644000175000017500000000002013511367404016217 0ustar nicoonicoo(@CONF_CFLAGS@) opam-2.0.5/src/stubs/opamInject.c0000644000175000017500000001154613511367404015651 0ustar nicoonicoo/**************************************************************************/ /* */ /* Copyright 2015, 2016, 2017, 2018 MetaStack Solutions Ltd. */ /* */ /* All rights reserved. This file is distributed under the terms of the */ /* GNU Lesser General Public License version 2.1, with the special */ /* exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include /* SetEnvironmentVariable function pointer type */ typedef LRESULT (WINAPI *SETENVIRONMENTVARIABLE)(LPCTSTR,LPCTSTR); /* * Data structure to pass to the remote thread */ typedef struct { SETENVIRONMENTVARIABLE SetEnvironmentVariable; TCHAR lpName[4096]; TCHAR lpValue[4096]; BOOL result; } INJDATA, *PINJDATA; /* * Code to inject into the parent process */ static DWORD WINAPI ThreadFunc (INJDATA *pData) { /* * Call the provided function pointer with its two arguments and return the * result. */ pData->result = pData->SetEnvironmentVariable(pData->lpName, pData->lpValue); return 0; } /* * This is a dummy function used to calculate the code size of ThreadFunc. * This assumes that the linker does not re-order the functions. * If it's a worry, could make the symbols public and use /ORDER * (http://msdn.microsoft.com/en-us/library/00kh39zz.aspx) * Presumably there's a gcc equivalent for mingw. */ static void AfterThreadFunc (void) { return; } char* InjectSetEnvironmentVariable(DWORD pid, char* key, char* val) { /* * Open the parent process for code injection */ HANDLE hProcess = OpenProcess(PROCESS_CREATE_THREAD | PROCESS_QUERY_INFORMATION | PROCESS_VM_OPERATION | PROCESS_VM_WRITE | PROCESS_VM_READ, FALSE, pid); INJDATA payload = {NULL, "", "", FALSE}; INJDATA* pData; DWORD* pCode; const int codeSize = ((LPBYTE)AfterThreadFunc - (LPBYTE)ThreadFunc); HANDLE hThread; if (!hProcess) return "OPAMW_process_putenv: could not open parent process"; payload.SetEnvironmentVariable = (SETENVIRONMENTVARIABLE)GetProcAddress(GetModuleHandle("kernel32"), "SetEnvironmentVariableA"); /* * Set-up the instruction */ strcpy(payload.lpName, key); strcpy(payload.lpValue, val); /* * Allocate a page in the parent process to hold the instruction and copy the * payload to it. */ pData = (INJDATA*)VirtualAllocEx(hProcess, 0, sizeof(INJDATA), MEM_COMMIT, PAGE_READWRITE); if (!pData) { CloseHandle(hProcess); return "OPAMW_process_putenv: VirtualAllocEx (data) in parent failed"; } if (!WriteProcessMemory(hProcess, pData, &payload, sizeof(INJDATA), NULL)) { VirtualFreeEx(hProcess, pData, 0, MEM_RELEASE); CloseHandle(hProcess); return "OPAMW_process_putenv: could not copy data to parent process"; } /* * Allocate a page in the parent process to hold ThreadFunc and copy the code * there. */ pCode = (PDWORD)VirtualAllocEx(hProcess, 0, codeSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE); if (!pCode) { VirtualFreeEx(hProcess, pData, 0, MEM_RELEASE); CloseHandle(hProcess); return "OPAMW_process_putenv: VirtualAllocEx (exec) in parent failed"; } if (!WriteProcessMemory(hProcess, pCode, &ThreadFunc, codeSize, NULL)) { VirtualFreeEx(hProcess, pCode, 0, MEM_RELEASE); VirtualFreeEx(hProcess, pData, 0, MEM_RELEASE); CloseHandle(hProcess); return "OPAMW_process_putenv: could not copy code to parent process"; } /* * Start the remote thread */ hThread = CreateRemoteThread(hProcess, NULL, 0, (LPTHREAD_START_ROUTINE)pCode, pData, 0, NULL); if (!hThread) { VirtualFreeEx(hProcess, pCode, 0, MEM_RELEASE); VirtualFreeEx(hProcess, pData, 0, MEM_RELEASE); CloseHandle(hProcess); return "OPAMW_process_putenv: could not start remote thread in parent"; } /* * Wait for the thread to terminate. */ WaitForSingleObject(hThread, INFINITE); CloseHandle(hThread); /* * Get the result back */ ReadProcessMemory(hProcess, pData, &payload, sizeof(INJDATA), NULL); /* * Release the memory */ VirtualFreeEx(hProcess, pCode, 0, MEM_RELEASE); VirtualFreeEx(hProcess, pData, 0, MEM_RELEASE); CloseHandle(hProcess); return (payload.result ? NULL : ""); } opam-2.0.5/src/stubs/dune-win320000644000175000017500000000135213511367404015224 0ustar nicoonicoo(library (name opam_stubs) (public_name opam-core.stubs) (synopsis "OCaml Package Manager C stubs") (libraries unix) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (c_names opamInject opamWindows) (c_flags (:standard (:include c-flags.sexp))) (c_library_flags (:standard (:include c-libraries.sexp))) (wrapped false)) (rule (with-stdout-to c-flags.sexp (run ocaml %{dep:../../shell/subst_var.ml} CONF_CFLAGS "" %{dep:c-flags.sexp.in}))) (rule (with-stdout-to c-libraries.sexp (run ocaml %{dep:../../shell/context_flags.ml} clibs))) opam-2.0.5/src/stubs/opamWin32Stubs.ml0000644000175000017500000000515113511367404016541 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 MetaStack Solutions Ltd. *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) external getCurrentProcessID : unit -> int32 = "OPAMW_GetCurrentProcessID" (* Polymorphic parameters below are used as placeholders for types in * OpamStubsTypes - it's not worth the effort of propagating the types here, * even if it does result in some ugly-looking primitives! *) external getStdHandle : 'a -> 'b = "OPAMW_GetStdHandle" external getConsoleScreenBufferInfo : 'a -> 'b = "OPAMW_GetConsoleScreenBufferInfo" external setConsoleTextAttribute : 'a -> int -> unit = "OPAMW_SetConsoleTextAttribute" external fillConsoleOutputCharacter : 'a -> char -> int -> int * int -> bool = "OPAMW_FillConsoleOutputCharacter" external getConsoleMode : 'a -> int = "OPAMW_GetConsoleMode" external setConsoleMode : 'a -> int -> bool = "OPAMW_SetConsoleMode" external getWindowsVersion : unit -> int * int * int * int = "OPAMW_GetWindowsVersion" external isWoW64 : unit -> bool = "OPAMW_IsWoW64" external waitpids : int list -> int -> int * Unix.process_status = "OPAMW_waitpids" external writeRegistry : 'a -> string -> string -> 'b -> 'c -> unit = "OPAMW_WriteRegistry" external getConsoleOutputCP : unit -> int = "OPAMW_GetConsoleOutputCP" external getCurrentConsoleFontEx : 'a -> bool -> 'b = "OPAMW_GetCurrentConsoleFontEx" external create_glyph_checker : string -> 'a * 'a = "OPAMW_CreateGlyphChecker" external delete_glyph_checker : 'a * 'a -> unit = "OPAMW_DeleteGlyphChecker" external has_glyph : 'a * 'a -> Uchar.t -> bool = "OPAMW_HasGlyph" external isWoW64Process : int32 -> bool = "OPAMW_IsWoW64Process" external process_putenv : int32 -> string -> string -> bool = "OPAMW_process_putenv" external shGetFolderPath : int -> 'a -> string = "OPAMW_SHGetFolderPath" external sendMessageTimeout : nativeint -> int -> int -> 'a -> 'b -> 'c -> int * 'd = "OPAMW_SendMessageTimeout_byte" "OPAMW_SendMessageTimeout" external getParentProcessID : int32 -> int32 = "OPAMW_GetParentProcessID" external getConsoleAlias : string -> string -> string = "OPAMW_GetConsoleAlias" opam-2.0.5/src/dune0000644000175000017500000000052013511367404013120 0ustar nicoonicoo(rule (targets ocaml-flags-standard.sexp) (deps (:input ocaml-flags-standard.sexp.in) (:script ../shell/subst_var.ml) ../config.status) (action (with-stdout-to %{targets} (run ocaml %{script} CONF_OCAMLFLAGS "" %{input})))) (rule (with-stdout-to ocaml-context-flags.sexp (run ocaml %{dep:../shell/context_flags.ml} flags))) opam-2.0.5/src/tools/0000755000175000017500000000000013511367404013405 5ustar nicoonicooopam-2.0.5/src/tools/opam_admin_top.ml0000644000175000017500000001121113511367404016721 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2014 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* To be used for quick repo scripts using the toplevel *) open OpamFilename.Op open OpamStd.Op open OpamTypes let identity _ x = x let true_ _ = true let repo = OpamRepositoryBackend.local (OpamFilename.cwd ()) let packages = OpamRepository.packages repo let wopt w f = function | None -> OpamFilename.remove (OpamFile.filename f) | Some contents -> w f contents let apply f x prefix y = match f with | None -> () | Some f -> f x prefix y type 'a action = [`Update of 'a | `Remove | `Keep] let to_action f x y = match f with | None -> `Keep | Some f -> match y with | None -> `Keep | Some y -> `Update (f x y) let of_action o = function | `Keep -> o | `Update x -> Some x | `Remove -> None let iter_packages_gen ?(quiet=false) f = let packages = OpamRepository.packages_with_prefixes repo in let changed_pkgs = ref 0 in let changed_files = ref 0 in (* packages *) OpamPackage.Map.iter (fun package prefix -> if not quiet then OpamConsole.msg "Processing package %s... " (OpamPackage.to_string package); let opam_file = OpamRepositoryPath.opam repo.repo_root prefix package in let opam = OpamFile.OPAM.read opam_file in let descr_file = OpamRepositoryPath.descr repo.repo_root prefix package in let descr = OpamFile.Descr.read_opt descr_file in let url_file = OpamRepositoryPath.url repo.repo_root prefix package in let url = OpamFile.URL.read_opt url_file in let dot_install_file : OpamFile.Dot_install.t OpamFile.t = OpamFile.make (OpamRepositoryPath.files repo.repo_root prefix package // (OpamPackage.Name.to_string (OpamPackage.name package) ^ ".install")) in let dot_install = OpamFile.Dot_install.read_opt dot_install_file in let opam2, descr2, url2, dot_install2 = f package ~prefix ~opam ~descr ~url ~dot_install in let descr2 = of_action descr descr2 in let url2 = of_action url url2 in let dot_install2 = of_action dot_install dot_install2 in let changed = ref false in let upd () = changed := true; incr changed_files in if opam <> opam2 then (upd (); OpamFile.OPAM.write_with_preserved_format opam_file opam2); if descr <> descr2 then (upd (); wopt OpamFile.Descr.write descr_file descr2); if url <> url2 then (upd (); wopt OpamFile.URL.write url_file url2); if dot_install <> dot_install2 then (upd (); wopt OpamFile.Dot_install.write dot_install_file dot_install2); if !changed then (incr changed_pkgs; if not quiet then begin OpamConsole.carriage_delete (); OpamConsole.msg "Updated %s\n" (OpamPackage.to_string package) end) else if not quiet then OpamConsole.carriage_delete (); ) packages; if not quiet then OpamConsole.msg "Done. Updated %d files in %d packages.\n" !changed_files !changed_pkgs let iter_packages ?quiet ?(filter=true_) ?f ?(opam=identity) ?descr ?url ?dot_install () = iter_packages_gen ?quiet (fun p ~prefix ~opam:o ~descr:d ~url:u ~dot_install:i -> if filter p then ( apply f p prefix o; opam p o, to_action descr p d , to_action url p u, to_action dot_install p i ) else o, `Keep, `Keep, `Keep) let regexps_of_patterns patterns = let contains_dot str = let len = String.length str in let rec aux = function | -1 -> false | i -> str.[i] = '.' || aux (i-1) in aux (len-1) in List.map (fun pattern -> if contains_dot pattern then pattern else pattern ^ ".*" ) patterns |> List.map (fun pattern -> Re.compile (Re.Glob.globx pattern)) let filter fn patterns = let regexps = regexps_of_patterns patterns in fun t -> match regexps with | [] -> true | _ -> let str = fn t in List.exists (fun re -> OpamStd.String.exact_match re str) regexps let filter_packages = filter OpamPackage.to_string let _ = Topmain.main () opam-2.0.5/src/tools/opam-putenv.inc.in0000644000175000017500000000027713511367404016766 0ustar nicoonicoo(rule (targets opam-putenv.exe) (deps (:source opam-putenv.c) ../stubs/opamInject.c) (action @CC64_JBUILD@)) (install (section bin) (package opam) (files opam-putenv.exe)) opam-2.0.5/src/tools/opam_installer.ml0000644000175000017500000003527513511367404016764 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open Cmdliner type options = { file: OpamFile.Dot_install.t OpamFile.t; pkgname: OpamPackage.Name.t; prefix: OpamFilename.Dir.t; script: bool; mandir: OpamFilename.Dir.t option; libdir: OpamFilename.Dir.t option; stubsdir: OpamFilename.Dir.t option; topdir: OpamFilename.Dir.t option; docdir: OpamFilename.Dir.t option; } (* A wrapper on top of commands to either proceed, or output a script *) type commands = { mkdir: OpamFilename.Dir.t -> unit; rmdir: opt:bool -> OpamFilename.Dir.t -> unit; cp: ?exec:bool -> opt:bool -> src:OpamFilename.t -> dst:OpamFilename.t -> unit -> unit; rm: opt:bool -> OpamFilename.t -> unit; confirm: string -> (unit -> unit) -> unit; } let do_commands project_root = let mkdir d = if not (OpamFilename.exists_dir d) then (OpamConsole.msg "Creating directory %s\n" (OpamFilename.Dir.to_string d); OpamFilename.mkdir d) in let rec rmdir ~opt d = if not (OpamFilename.exists_dir d) then () else if Sys.readdir (OpamFilename.Dir.to_string d) = [||] then (OpamConsole.msg "Removing empty dir %S\n" (OpamFilename.Dir.to_string d); OpamFilename.rmdir d; let parent = OpamFilename.dirname_dir d in if parent <> d then rmdir ~opt:true parent) else if not opt then OpamConsole.warning "Directory %S is not empty\n" (OpamFilename.Dir.to_string d) in let do_cp ?exec ~opt ~src ~dst () = if OpamFilename.exists src then (mkdir (OpamFilename.dirname dst); OpamConsole.msg "%-32s => %s\n" (OpamFilename.remove_prefix project_root src) (OpamFilename.to_string dst); OpamFilename.install ?exec ~src ~dst ()) else if not opt then OpamConsole.error "Could not find %S" (OpamFilename.to_string src) in let cp = if Sys.win32 then fun ?exec ~opt ~src ~dst -> let (src, dst) = if not (OpamFilename.exists src) then let test = OpamFilename.add_extension src "exe" in if OpamFilename.exists test then begin let dst = OpamFilename.add_extension dst "exe" in OpamConsole.warning "Adding .exe for %s" (OpamFilename.to_string test); (test, dst) end else (src, dst) else (src, dst) in do_cp ?exec ~opt ~src ~dst else do_cp in let do_rm ~opt f = if OpamFilename.exists f then (OpamConsole.msg "Removing %s\n" (OpamFilename.to_string f); OpamFilename.remove f) else if not opt then OpamConsole.warning "%S doesn't exist" (OpamFilename.to_string f) in let rm = if Sys.win32 then fun ~opt f -> let f = if OpamFilename.exists f then f else let test = OpamFilename.add_extension f "exe" in if OpamFilename.exists test then begin OpamConsole.warning "Removing %s instead of %s" (OpamFilename.to_string test) (OpamFilename.to_string f); test end else f in do_rm ~opt f else do_rm in let confirm s f = if OpamConsole.confirm "%s" s then f () in { mkdir; rmdir; cp; rm; confirm } let script_commands project_root ochan = let made_dirs = ref [] in Printf.fprintf ochan "#!/bin/sh\n"; let mkdir d = if not (List.mem d !made_dirs) then ( Printf.fprintf ochan "mkdir -p %S\n" (OpamFilename.Dir.to_string d); made_dirs := d :: !made_dirs ) in let rmdir ~opt d = let f = OpamFilename.Dir.to_string d in Printf.fprintf ochan "if [ -d %S ]\n" f; Printf.fprintf ochan "then rmdir -p %S 2>/dev/null" f; if not opt then Printf.fprintf ochan " ||\n echo \"Warning: could not remove directory %s\"" f; Printf.fprintf ochan "\nfi\n" in let cp ?exec ~opt ~src ~dst () = mkdir (OpamFilename.dirname dst); let mode = match exec with | Some true -> "-m 0755" | Some false -> "-m 0644" | None -> "" in let src = OpamFilename.remove_prefix project_root src in let dst = OpamFilename.to_string dst in Printf.fprintf ochan "if [ -e %S ]\n" src; Printf.fprintf ochan "then install %s %S %S\n" mode src dst; if not opt then Printf.fprintf ochan "else echo \"Error: %s doesn't exist\"\n" src; Printf.fprintf ochan "fi\n" in let rm ~opt file = let f = OpamFilename.to_string file in Printf.fprintf ochan "if [ -e %S ]; then rm -f %S\n" f f; if not opt then Printf.fprintf ochan "else echo \"Warning: %s doesn't exist\"\n" f; Printf.fprintf ochan "fi\n" in let confirm msg f = Printf.fprintf ochan "read -p %S' [y/n] ' -n 1 -r; echo; if [ \"$REPLY\" = 'y' ]; then\n" msg; f (); Printf.fprintf ochan "fi\n"; in { mkdir; rmdir; cp; rm; confirm } (* [f (dest, file_list, is_exec)] should take care of the processing, where [dest src dst] returns the destination of a file with a ["src" {"dst"}] line in the .install *) let iter_install f instfile o = let module D = OpamPath.Switch.Default in let module S = OpamFile.Dot_install in let dest ?fix dir = let dir = OpamStd.Option.default dir fix in fun src dst -> OpamFilename.create dir (OpamStd.Option.default (OpamFilename.basename src) dst) in let dest_global ?fix instdir_f = dest ?fix (instdir_f o.prefix (OpamSwitch.of_string "")) in let dest_pkg ?fix instdir_f = let fix = OpamStd.Option.map OpamFilename.Op.(fun d -> d / OpamPackage.Name.to_string o.pkgname) fix in dest ?fix (instdir_f o.prefix (OpamSwitch.of_string "") o.pkgname) in List.iter f [ dest_global D.bin, S.bin instfile, true; dest_global D.sbin, S.sbin instfile, true; dest_pkg ?fix:o.libdir D.lib, S.lib instfile, false; dest_pkg ?fix:o.libdir D.lib, S.libexec instfile, true; dest_global ?fix:o.libdir D.lib_dir, S.lib_root instfile, false; dest_global ?fix:o.libdir D.lib_dir, S.libexec_root instfile, true; dest_global ?fix:o.topdir D.toplevel, S.toplevel instfile, false; dest_global ?fix:o.stubsdir D.stublibs, S.stublibs instfile, true; dest_global ?fix:o.mandir D.man_dir, S.man instfile, false; dest_pkg D.share, S.share instfile, false; dest_global D.share_dir,S.share_root instfile, false; dest_pkg D.etc, S.etc instfile, false; dest_pkg ?fix:o.docdir D.doc, S.doc instfile, false; ] let install options = let instfile = OpamFile.Dot_install.safe_read options.file in let project_root = OpamFilename.cwd () in let cmd = if options.script then script_commands project_root stdout else do_commands project_root in let install_files (dest, files, exec) = List.iter (fun (base, dst) -> let src_file = OpamFilename.create project_root base.c in let dst_file = dest src_file dst in cmd.cp ~exec ~opt:base.optional ~src:src_file ~dst:dst_file ()) files in iter_install install_files instfile options; List.iter (fun (src, dst) -> let src_file = OpamFilename.create (OpamFilename.cwd ()) src.c in cmd.confirm (Printf.sprintf "Do you want to install %s to %s?" (OpamFilename.Base.to_string src.c) (OpamFilename.to_string dst)) (fun () -> cmd.cp ~opt:false ~src:src_file ~dst ()) ) (OpamFile.Dot_install.misc instfile) let uninstall options = let instfile = OpamFile.Dot_install.safe_read options.file in let project_root = OpamFilename.cwd () in let cmd = if options.script then script_commands project_root stdout else do_commands project_root in let dirs_to_remove = ref OpamFilename.Dir.Set.empty in let remove_files (dest, files, _) = List.iter (fun (base, dst) -> let src_file = OpamFilename.create project_root base.c in let dst_file = dest src_file dst in cmd.rm ~opt:base.optional dst_file; dirs_to_remove := OpamFilename.Dir.Set.add (OpamFilename.dirname dst_file) !dirs_to_remove) files in iter_install remove_files instfile options; List.iter (cmd.rmdir ~opt:true) (List.rev (OpamFilename.Dir.Set.elements !dirs_to_remove)); List.iter (fun df -> cmd.rmdir ~opt:false (df options.prefix (OpamSwitch.of_string "") options.pkgname)) OpamPath.Switch.Default.([ lib; share; etc; doc ]); List.iter (fun (_src, dst) -> cmd.confirm (Printf.sprintf "Remove %s?" (OpamFilename.to_string dst)) (fun () -> cmd.rm ~opt:false dst)) (OpamFile.Dot_install.misc instfile) let options = let file = let doc = "The opam .install file to read for installation instructions" in Arg.(value & pos 0 (some string) None & info ~docv:"PKG.install" ~doc []) in let prefix = let doc = "The prefix to install to. You can use eg '\\$PREFIX' to output a \ relocatable script" in Arg.(value & opt string "/usr/local" & info ~docv:"PREFIX" ~doc ["prefix"]) in let script = let doc = "Don't execute the commands, but output a shell-script \ (experimental)" in Arg.(value & flag & info ~doc ["script"]) in let pkgname = let doc = "Specify the package name. Used to set install directory under \ `share/', etc. \ By default, basename of the .install file" in Arg.(value & opt (some string) None & info ~docv:"NAME" ~doc ["name"]) in let mandir = let doc = "Manpages dir. Relative to $(b,prefix) or absolute. \ By default $(i,\\$prefix/man)." in Arg.(value & opt (some string) None & info ~docv:"PATH" ~doc ["mandir"]) in let libdir = let doc = "OCaml lib dir. Relative to $(b,prefix) or absolute. \ By default $(i,\\$prefix/lib) ; sometimes setting this to \ $(i,\\$(ocamlc -where)) is preferable." in Arg.(value & opt (some string) None & info ~docv:"PATH" ~doc ["libdir"]) in let stubsdir = let doc = "Stubs installation dir. Relative to $(b,prefix) or absolute. \ By default $(i,\\$libdir/stublibs)." in Arg.(value & opt (some string) None & info ~docv:"PATH" ~doc ["stubsdir"]) in let topdir = let doc = "Toplevel install dir. Relative to $(b,prefix) or absolute. \ By default $(i,\\$libdir/toplevel)." in Arg.(value & opt (some string) None & info ~docv:"PATH" ~doc ["topdir"]) in let docdir = let doc = "Documentation dir. Relative to $(b,prefix) or absolute. \ By default $(i,\\$prefix/doc)." in Arg.(value & opt (some string) None & info ~docv:"PATH" ~doc ["docdir"]) in let make_options file prefix script name mandir libdir stubsdir topdir docdir = let file = match file with | Some file -> let f = OpamFilename.of_string (file ^ ".install") in if OpamFilename.exists f then f else let f = OpamFilename.of_string file in if OpamFilename.exists f then f else raise (Invalid_argument ("File not found: " ^ file)) | None -> let candidates = OpamFilename.files (OpamFilename.cwd ()) in match List.filter (fun f -> OpamFilename.check_suffix f ".install") candidates with | [f] -> f | [] -> raise (Invalid_argument "No .install file found") | files -> let msg = Printf.sprintf "Please specify a .install file, %s found in current dir" (OpamStd.Format.pretty_list (List.map (fun f -> OpamFilename.(Base.to_string (basename f))) files)) in raise (Invalid_argument msg) in let file = (OpamFile.make file: OpamFile.Dot_install.t OpamFile.t) in let prefix = OpamFilename.Dir.of_string prefix in let pkgname = match name with | Some n -> OpamPackage.Name.of_string n | None when OpamFilename.check_suffix (OpamFile.filename file) ".install" -> OpamPackage.Name.of_string (OpamFilename.Base.to_string (OpamFilename.basename (OpamFilename.chop_extension (OpamFile.filename file)))) | None -> raise (Invalid_argument "Could not guess the package name, please specify `--name'") in let mk_dir = function | None -> None | Some d when Filename.is_relative d -> Some OpamFilename.Op.(prefix / d) | Some d -> Some (OpamFilename.Dir.of_string d) in let mandir = mk_dir mandir in let libdir = mk_dir libdir in let stubsdir = match mk_dir stubsdir, libdir with | None, Some d -> Some OpamFilename.Op.(d / "stublibs") | d, None | (Some _ as d), _ -> d in let topdir = match mk_dir topdir, libdir with | None, Some d -> Some OpamFilename.Op.(d / "toplevel") | d, None | (Some _ as d), _ -> d in let docdir = mk_dir docdir in { file; prefix; script; pkgname; mandir; libdir; stubsdir; topdir; docdir } in Term.(const make_options $ file $ prefix $ script $ pkgname $ mandir $ libdir $ stubsdir $ topdir $ docdir) let command = let remove = Arg.(value & vflag false & [ false, Arg.info ["i";"install"] ~doc:"Install the package (the default)"; true, Arg.info ["u";"uninstall";"remove"] ~doc:"Remove the package"; ]) in Term.( const (fun options remove -> if remove then uninstall options else install options) $ options $ remove) let info = let doc = "Handles (un)installation of package files following instructions from \ opam *.install files." in Term.info "opam-installer" ~version:OpamVersion.(to_string current) ~doc let () = OpamSystem.init (); OpamStd.Config.init (); try match Term.eval ~catch:false (command,info) with | `Error _ -> exit 2 | _ -> exit 0 with | Invalid_argument s -> OpamConsole.error "%s" s; exit 2 | OpamStd.Sys.Exit i -> exit i | e -> OpamConsole.error "Failure during install"; OpamConsole.errmsg "%s\n" (Printexc.to_string e); exit 1 opam-2.0.5/src/tools/opam_admin_top.mli0000644000175000017500000000370113511367404017077 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Small lib for writing opam-repo admin scripts *) (** The current repo (taken from CWD!) *) val repo : OpamTypes.repository (** All defined packages in the current repo *) val packages : OpamPackage.Set.t open OpamFile type 'a action = [`Update of 'a | `Remove | `Keep ] (** Maps on the files of every package. Only changed files are written back to disk. *) val iter_packages_gen: ?quiet:bool -> (OpamPackage.t -> prefix:string option -> opam:OPAM.t -> descr:Descr.t option -> url:URL.t option -> dot_install:Dot_install.t option -> OPAM.t * Descr.t action * URL.t action * Dot_install.t action) -> unit (** Turn a list of glob patterns into a proper filtering function on package names. *) val filter_packages: string list -> (OpamPackage.t -> bool) (** Quicker interface when considering a single type of file *) val iter_packages: ?quiet:bool -> ?filter:(OpamPackage.t -> bool) -> ?f:(OpamPackage.t -> string option -> OPAM.t -> unit) -> ?opam:(OpamPackage.t -> OPAM.t -> OPAM.t) -> ?descr:(OpamPackage.t -> Descr.t -> Descr.t) -> ?url:(OpamPackage.t -> URL.t -> URL.t) -> ?dot_install:(OpamPackage.t -> Dot_install.t -> Dot_install.t) -> unit -> unit opam-2.0.5/src/tools/opam_check.ml0000644000175000017500000000473113511367404016035 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Utility helper to check if a given set of packages is installed *) let usage = "opam-check [--root root] [-l label] +" let label = ref "" let root_dir_ref = ref "" let spec = Arg.align [ ("--root", Arg.Set_string root_dir_ref, " Set opam path"); ("-l" , Arg.Set_string label , " Set a test label"); ("--version", Arg.Unit OpamVersion.message , " Display version information"); ] let packages = ref [] let ano x = packages := x :: !packages let () = Arg.parse spec ano usage; let root_dir = match !root_dir_ref with | "" -> None | d -> Some (OpamFilename.Dir.of_string d) in OpamSystem.init(); OpamStd.Config.init(); OpamFormatConfig.init(); OpamRepositoryConfig.init(); OpamStateConfig.init ?root_dir () let packages = OpamPackage.Set.of_list (List.map OpamPackage.of_string !packages) let installed () = let root = OpamStateConfig.(!r.root_dir) in let config = OpamFile.Config.read (OpamPath.config root) in let version = match OpamFile.Config.switch config with | Some sw -> sw | None -> failwith "No switch set" in let state = OpamFile.SwitchSelections.safe_read (OpamPath.Switch.selections root version) in state.OpamTypes.sel_installed let () = let installed = installed () in let diff1 = OpamPackage.Set.diff packages installed in let diff2 = OpamPackage.Set.diff installed packages in let diff = OpamPackage.Set.union diff1 diff2 in let label = if !label = "" then "" else Printf.sprintf "[%s] " !label in if not (OpamPackage.Set.is_empty diff) then ( OpamConsole.error "%swaiting for: %s" label (OpamPackage.Set.to_string diff1); OpamConsole.error "%sgot: %s" label (OpamPackage.Set.to_string diff2); exit 1 ) opam-2.0.5/src/tools/dune0000644000175000017500000000170313511367404014264 0ustar nicoonicoo(executable (name opam_admin_top) (modules opam_admin_top) (ocamlc_flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp) -linkall)) (libraries opam-client opam-file-format compiler-libs.toplevel re)) (install (section bin) (package opam-admin) (files (opam_admin_top.bc as opam-admin.top))) (executable (name opam_check) (modules opam_check) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (libraries opam-state)) (include opam-putenv.inc) (executable (name opam_installer) (package opam-installer) (public_name opam-installer) (modules opam_installer) (libraries opam-format cmdliner) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp)))) opam-2.0.5/src/tools/opam-putenv.c0000644000175000017500000000462313511367404016031 0ustar nicoonicoo/**************************************************************************/ /* */ /* Copyright 2015, 2016, 2017, 2018 MetaStack Solutions Ltd. */ /* */ /* OPAM is distributed in the hope that it will be useful, but WITHOUT */ /* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY */ /* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public */ /* License for more details. */ /* */ /**************************************************************************/ #include /* * This will be being built for a different architecture, so it's easier just to * #include the code, rather than having to deal with .o(obj) files for * different architectures. */ #include "../stubs/opamInject.c" /* * This trivially simple utility takes a single PID and then reads CRLF * terminated lines from STDIN. The line ::QUIT causes the program to terminate * otherwise a further line is read and the two lines together form the * key/value pair to be set in the process's environment. * * This utility is always compiled x86 if OPAM is compiled x64 and vice versa * and allows OPAM to manipulate a parent whose architecture differs from its * own. When the architecture matches, OPAM injects the code itself, but * injecting from a 64-bit process to a 32-bit parent is quite hard (and * potentially unstable) and injecting from a 32-bit process to a 64-bit parent * is phenomenally hard! */ int main(int argc, char *argv[], char *envp[]) { if (argc != 2) { printf("Invalid command line: this utility is an internal part of OPAM\n"); } else { DWORD pid = atoi(argv[1]); BOOL running = TRUE; char* key = (char*)malloc(4097); char* value = (char*)malloc(4097); while (running) { if (fgets(key, 4097, stdin)) { if (strcmp(key, "::QUIT\n") && fgets(value, 4097, stdin)) { key[strlen(key) - 1] = value[strlen(value) - 1] = '\0'; InjectSetEnvironmentVariable(pid, key, value); } else { running = FALSE; } } else { running = FALSE; } } free(key); free(value); } } opam-2.0.5/src/ocaml-flags-standard.sexp.in0000644000175000017500000000006513511367404017537 0ustar nicoonicoo(-w +a-4-40-42-44-48 -safe-string @CONF_OCAMLFLAGS@) opam-2.0.5/src/core/0000755000175000017500000000000013511367404013175 5ustar nicoonicooopam-2.0.5/src/core/opamStubs.mli0000644000175000017500000001404013511367404015654 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 MetaStack Solutions Ltd. *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** OS-specific functions requiring C code on at least one platform. Most functions are Windows-specific and raise an exception on other platforms. *) include module type of struct include OpamStubsTypes end val getpid : unit -> int (** On Windows, this returns the actual process ID, rather than the non-unique faked process ID returned by the Microsoft C Runtime (see https://caml.inria.fr/mantis/view.php?id=4034). On all other platforms, this is just an alias for [Unix.getpid]. *) val getCurrentProcessID : unit -> int32 (** Windows only. As {!getpid}, but without the possibility of truncating the ID on 32-bit platforms. *) val getStdHandle : stdhandle -> handle (** Windows only. Return a standard handle. *) val getConsoleScreenBufferInfo : handle -> console_screen_buffer_info (** Windows only. Return current Console screen buffer information. *) val setConsoleTextAttribute : handle -> int -> unit (** Windows only. Set the console's text attribute setting. *) val fillConsoleOutputCharacter : handle -> char -> int -> int * int -> bool (** Windows only. [fillConsoleOutputCharacter buffer c n (x, y)] writes [c] [n] times starting at the given coordinate (and wrapping if required). *) val getConsoleMode : handle -> int (** Windows only. Returns the input/output mode of the console screen buffer referred to by the handle. @raise Not_found If the handle does not refer to a console. *) val setConsoleMode : handle -> int -> bool (** Windows only. Sets the input/output mode of the console screen buffer referred to by the handle, returning [true] if the operation isr successful. *) val getWindowsVersion : unit -> int * int * int * int (** Windows only. Returns the Windows version as [(major, minor, build, revision)]. This function only works if opam is compiled OCaml 4.06.0 or later, it returns [(0, 0, 0, 0)] otherwise. *) val isWoW64 : unit -> bool (** Returns [false] unless this process is a 32-bit Windows process running in the WoW64 sub-system (i.e. is being run on 64-bit Windows). *) val waitpids : int list -> int -> int * Unix.process_status (** Windows only. Given a list [pids] with [length] elements, [waitpids pids length] behaves like [Unix.wait], returning the pid and exit status of the first process to terminate. *) val writeRegistry : registry_root -> string -> string -> 'a registry_value -> 'a -> unit (** Windows only. [writeRegistry root key name value_type value] sets the value [name] of type [value_type] in registry key [key] of [root] to [value]. @raise Failure If the value could not be set. @raise Not_found If [key] does not exist. *) val getConsoleOutputCP : unit -> int (** Windows only. Retrieves the current Console Output Code Page. *) val getCurrentConsoleFontEx : handle -> bool -> console_font_infoex (** Windows only. Gets information on the current console output font. *) val create_glyph_checker : string -> handle * handle (** Windows only. Given a font name, returns a pair consisting of a screen DC and a font object, which will have been selected into the DC. @raise Failure If anything goes wrong with the GDI calls. *) val delete_glyph_checker : handle * handle -> unit (** Windows only. Given [(dc, font)], deletes the font object and releases the DC. *) val has_glyph : handle * handle -> OpamCompat.Uchar.t -> bool (** Windows only. [has_glyph (dc, font) scalar] returns [true] if [font] contains a glyph for [scalar]. @raise Failure If the call to [GetGlyphIndicesW] fails. *) val isWoW64Process : int32 -> bool (** Windows only. General version of {!isWoW64} for any given process ID. See https://msdn.microsoft.com/en-us/library/windows/desktop/ms684139.aspx *) val process_putenv : int32 -> string -> string -> bool (** Windows only. [process_putenv pid name value] sets the environment variable [name] to [value] in given process ID ([Unix.putenv] must also be called to update the value in the current process). This function must not be called if the target process is 32-bit and the current process is 64-bit or vice versa (outcomes vary from a no-op to a segfault). *) val shGetFolderPath : int -> shGFP_type -> string (** Windows only. [shGetFolderPath nFolder dwFlags] retrieves the location of a special folder by CSIDL value. See https://msdn.microsoft.com/en-us/library/windows/desktop/bb762181.aspx *) val sendMessageTimeout : nativeint -> int -> int -> ('a, 'b, 'c) winmessage -> 'a -> 'b -> int * 'c (** Windows only. [sendMessageTimeout hwnd timeout flags message wParam lParam] sends a message to the given handle, but is guaranteed to return within [timeout] milliseconds. The result consists of two parts, [fst] is the return value from SendMessageTimeout, [snd] depends on both the message and [fst]. See https://msdn.microsoft.com/en-us/library/windows/desktop/ms644952.aspx *) val getParentProcessID : int32 -> int32 (** Windows only. [getParentProcessID pid] returns the process ID of the parent of [pid]. @raise Failure If walking the process tree fails to find the process. *) val getConsoleAlias : string -> string -> string (** Windows only. [getConsoleAlias alias exeName] retrieves the value for a given executable or [""] if the alias is not defined. See https://docs.microsoft.com/en-us/windows/console/getconsolealias *) opam-2.0.5/src/core/opamSHA.ml0000644000175000017500000003311013511367404015015 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module type ConvSig = sig type t val bytes: int val toggle_big_endian: t -> t end module type BufSig = sig module Conv: ConvSig type t val unsafe_get: t -> int -> Conv.t val unsafe_set: t -> int -> Conv.t -> unit end module type InputSig = sig type src type t type chunk type elt val init: blocksize:int -> src -> t val close: t -> unit val byte_size: t -> int (** padded with 0, getting chunks after the end of input is allowed *) val get_chunk: t -> int -> chunk val get: chunk -> int -> elt (** only allowed after the end of input *) val set: chunk -> int -> elt -> unit (** only allowed after the end of input*) val set_byte: chunk -> int -> char -> unit end module Conv32 = struct type t = int32 let bytes = 4 external swap: t -> t = "%bswap_int32" let toggle_big_endian = if Sys.big_endian then fun x -> x else swap end module Conv64 = struct type t = int64 let bytes = 8 external swap: t -> t = "%bswap_int64" let toggle_big_endian = if Sys.big_endian then fun x -> x else swap end module B = Bigarray module A = B.Array1 type bigstring = (char, B.int8_unsigned_elt, B.c_layout) A.t module Buf_Bigstring32 = struct module Conv = Conv32 type t = bigstring external unsafe_get: t -> int -> Conv.t = "%caml_bigstring_get32u" external unsafe_set: t -> int -> Conv.t -> unit = "%caml_bigstring_set32u" end module Buf_Bigstring64 = struct module Conv = Conv64 type t = bigstring external unsafe_get: t -> int -> Conv.t = "%caml_bigstring_get64u" external unsafe_set: t -> int -> Conv.t -> unit = "%caml_bigstring_set64u" end module Buf_String32 = struct module Conv = Conv32 type t = Bytes.t external unsafe_get: t -> int -> Conv.t = "%caml_string_get32u" external unsafe_set: t -> int -> Conv.t -> unit = "%caml_string_set32u" end module Buf_String64 = struct module Conv = Conv64 type t = Bytes.t external unsafe_get: t -> int -> Conv.t = "%caml_string_get64u" external unsafe_set: t -> int -> Conv.t -> unit = "%caml_string_set64u" end module Input_file(Buf: BufSig with type t = bigstring) = struct type src = string (* filename *) type t = { fd: Unix.file_descr; blocksize: int; buf: Buf.t; } type chunk = Buf.t type elt = Buf.Conv.t let init ~blocksize src = let fd = Unix.openfile src [Unix.O_RDONLY] 0 in let buf = B.(array1_of_genarray (OpamCompat.Unix.map_file fd B.char c_layout false [|-1|])) in { fd; blocksize; buf } let close {fd; _} = Unix.close fd let byte_size {buf; _} = A.dim buf let get_chunk {blocksize; buf; _} i = let len = A.dim buf in let block_bytes = blocksize * Buf.Conv.bytes in if (i + 1) * block_bytes <= len then A.sub buf (i * block_bytes) (block_bytes) else let ba = A.create B.char B.c_layout (block_bytes) in A.fill ba '\x00'; if i * block_bytes < len then A.blit (A.sub buf (i * block_bytes) (len mod block_bytes)) (A.sub ba 0 (len mod block_bytes)); ba let get chunk i = Buf.Conv.toggle_big_endian (Buf.unsafe_get chunk (i * Buf.Conv.bytes)) let set chunk i x = Buf.unsafe_set chunk (i * Buf.Conv.bytes) (Buf.Conv.toggle_big_endian x) let set_byte chunk i c = A.unsafe_set chunk i c end module Input_string(Buf: BufSig with type t = Bytes.t) = struct type src = Bytes.t type t = { blocksize: int; buf: Bytes.t; } type chunk = { offset: int; b: Bytes.t; } type elt = Buf.Conv.t let init ~blocksize buf = { blocksize; buf } let close _ = () let byte_size {buf; _} = Bytes.length buf let get_chunk {blocksize; buf} i = let len = Bytes.length buf in let block_bytes = blocksize * Buf.Conv.bytes in if (i + 1) * block_bytes <= len then { offset = i * block_bytes; b = buf } else let b = Bytes.make block_bytes '\x00' in if i * block_bytes < len then Bytes.blit buf (i * block_bytes) b 0 (len mod block_bytes); { offset = 0; b } let get {offset; b} i = Buf.Conv.toggle_big_endian (Buf.unsafe_get b (offset + i * Buf.Conv.bytes)) let set {offset; b} i x = Buf.unsafe_set b (offset + i * Buf.Conv.bytes) (Buf.Conv.toggle_big_endian x) let set_byte {offset; b} i c = Bytes.unsafe_set b (offset + i) c end module Make_SHA256(I: InputSig with type elt = int32) = struct open Int32 let k = [| 0x428a2f98l; 0x71374491l; 0xb5c0fbcfl; 0xe9b5dba5l; 0x3956c25bl; 0x59f111f1l; 0x923f82a4l; 0xab1c5ed5l; 0xd807aa98l; 0x12835b01l; 0x243185bel; 0x550c7dc3l; 0x72be5d74l; 0x80deb1fel; 0x9bdc06a7l; 0xc19bf174l; 0xe49b69c1l; 0xefbe4786l; 0x0fc19dc6l; 0x240ca1ccl; 0x2de92c6fl; 0x4a7484aal; 0x5cb0a9dcl; 0x76f988dal; 0x983e5152l; 0xa831c66dl; 0xb00327c8l; 0xbf597fc7l; 0xc6e00bf3l; 0xd5a79147l; 0x06ca6351l; 0x14292967l; 0x27b70a85l; 0x2e1b2138l; 0x4d2c6dfcl; 0x53380d13l; 0x650a7354l; 0x766a0abbl; 0x81c2c92el; 0x92722c85l; 0xa2bfe8a1l; 0xa81a664bl; 0xc24b8b70l; 0xc76c51a3l; 0xd192e819l; 0xd6990624l; 0xf40e3585l; 0x106aa070l; 0x19a4c116l; 0x1e376c08l; 0x2748774cl; 0x34b0bcb5l; 0x391c0cb3l; 0x4ed8aa4al; 0x5b9cca4fl; 0x682e6ff3l; 0x748f82eel; 0x78a5636fl; 0x84c87814l; 0x8cc70208l; 0x90befffal; 0xa4506cebl; 0xbef9a3f7l; 0xc67178f2l; |] let ch x y z = logxor (logand x y) (logand (lognot x) z) let maj x y z = logxor (logand x y) (logxor (logand x z) (logand y z)) let sum0 x = logxor (logor (shift_right_logical x 2) (shift_left x (32 - 2))) (logxor (logor (shift_right_logical x 13) (shift_left x (32 - 13))) (logor (shift_right_logical x 22) (shift_left x (32 - 22)))) let sum1 x = logxor (logor (shift_right_logical x 6) (shift_left x (32 - 6))) (logxor (logor (shift_right_logical x 11) (shift_left x (32 - 11))) (logor (shift_right_logical x 25) (shift_left x (32 - 25)))) let lsig0 x = logxor (logor (shift_right_logical x 7) (shift_left x (32 - 7))) (logxor (logor (shift_right_logical x 18) (shift_left x (32 - 18))) (logor (shift_right_logical x 3) (shift_right_logical x 3))) let lsig1 x = logxor (logor (shift_right_logical x 17) (shift_left x (32 - 17))) (logxor (logor (shift_right_logical x 19) (shift_left x (32 - 19))) (logor (shift_right_logical x 10) (shift_right_logical x 10))) let sha_init = ( 0x6a09e667l, 0xbb67ae85l, 0x3c6ef372l, 0xa54ff53al, 0x510e527fl, 0x9b05688cl, 0x1f83d9abl, 0x5be0cd19l ) let hash_block = let warr = Array.make 64 0l in fun hh block -> for t = 0 to 15 do warr.(t) <- I.get block t done; for t = 16 to 63 do warr.(t) <- add (add (lsig1 warr.(t - 2)) warr.(t - 7)) (add (lsig0 warr.(t - 15)) warr.(t - 16)) done; let rec stir t (a, b, c, d, e, f, g, h) = if t >= 64 then let a', b', c', d', e', f', g', h' = hh in add a a', add b b', add c c', add d d', add e e', add f f', add g g', add h h' else let t1 = add (add h (sum1 e)) (add (add (ch e f g) k.(t)) warr.(t)) in let t2 = add (sum0 a) (maj a b c) in stir (t + 1) (add t1 t2, a, b, c, add d t1, e, f, g) in stir 0 hh let blocksize = 16 let hash src = let bs = I.init ~blocksize src in let nbytes = I.byte_size bs in let blocks = nbytes / (blocksize * 4) in let rem = nbytes mod (blocksize * 4) in let h = ref sha_init in for i = 0 to blocks - 1 do h := hash_block !h (I.get_chunk bs i) done; let lastblock = I.get_chunk bs blocks in I.set_byte lastblock rem '\x80'; let lastblock = if rem <= 55 then lastblock else (h := hash_block !h lastblock; I.get_chunk bs (blocks + 1)) in let bitsz = Int64.mul 8L (Int64.of_int nbytes) in I.set lastblock 14 Int64.(to_int32 (shift_right_logical bitsz 32)); I.set lastblock 15 Int64.(to_int32 (logand 0xffffffffL bitsz)); let (a, b, c, d, e, f, g, h) = hash_block !h lastblock in I.close bs; Printf.sprintf "%08lx%08lx%08lx%08lx%08lx%08lx%08lx%08lx" a b c d e f g h end module Make_SHA512(I: InputSig with type elt = int64) = struct open Int64 let k = [| 0x428a2f98d728ae22L; 0x7137449123ef65cdL; 0xb5c0fbcfec4d3b2fL; 0xe9b5dba58189dbbcL; 0x3956c25bf348b538L; 0x59f111f1b605d019L; 0x923f82a4af194f9bL; 0xab1c5ed5da6d8118L; 0xd807aa98a3030242L; 0x12835b0145706fbeL; 0x243185be4ee4b28cL; 0x550c7dc3d5ffb4e2L; 0x72be5d74f27b896fL; 0x80deb1fe3b1696b1L; 0x9bdc06a725c71235L; 0xc19bf174cf692694L; 0xe49b69c19ef14ad2L; 0xefbe4786384f25e3L; 0x0fc19dc68b8cd5b5L; 0x240ca1cc77ac9c65L; 0x2de92c6f592b0275L; 0x4a7484aa6ea6e483L; 0x5cb0a9dcbd41fbd4L; 0x76f988da831153b5L; 0x983e5152ee66dfabL; 0xa831c66d2db43210L; 0xb00327c898fb213fL; 0xbf597fc7beef0ee4L; 0xc6e00bf33da88fc2L; 0xd5a79147930aa725L; 0x06ca6351e003826fL; 0x142929670a0e6e70L; 0x27b70a8546d22ffcL; 0x2e1b21385c26c926L; 0x4d2c6dfc5ac42aedL; 0x53380d139d95b3dfL; 0x650a73548baf63deL; 0x766a0abb3c77b2a8L; 0x81c2c92e47edaee6L; 0x92722c851482353bL; 0xa2bfe8a14cf10364L; 0xa81a664bbc423001L; 0xc24b8b70d0f89791L; 0xc76c51a30654be30L; 0xd192e819d6ef5218L; 0xd69906245565a910L; 0xf40e35855771202aL; 0x106aa07032bbd1b8L; 0x19a4c116b8d2d0c8L; 0x1e376c085141ab53L; 0x2748774cdf8eeb99L; 0x34b0bcb5e19b48a8L; 0x391c0cb3c5c95a63L; 0x4ed8aa4ae3418acbL; 0x5b9cca4f7763e373L; 0x682e6ff3d6b2b8a3L; 0x748f82ee5defb2fcL; 0x78a5636f43172f60L; 0x84c87814a1f0ab72L; 0x8cc702081a6439ecL; 0x90befffa23631e28L; 0xa4506cebde82bde9L; 0xbef9a3f7b2c67915L; 0xc67178f2e372532bL; 0xca273eceea26619cL; 0xd186b8c721c0c207L; 0xeada7dd6cde0eb1eL; 0xf57d4f7fee6ed178L; 0x06f067aa72176fbaL; 0x0a637dc5a2c898a6L; 0x113f9804bef90daeL; 0x1b710b35131c471bL; 0x28db77f523047d84L; 0x32caab7b40c72493L; 0x3c9ebe0a15c9bebcL; 0x431d67c49c100d4cL; 0x4cc5d4becb3e42b6L; 0x597f299cfc657e2aL; 0x5fcb6fab3ad6faecL; 0x6c44198c4a475817L; |] let rotate x n = logor (shift_right_logical x n) (shift_left x (64 - n)) let ch x y z = logxor (logand x y) (logand (lognot x) z) let maj x y z = logxor (logand x y) (logxor (logand x z) (logand y z)) let sum0 x = logxor (rotate x 28) (logxor (rotate x 34) (rotate x 39)) let sum1 x = logxor (rotate x 14) (logxor (rotate x 18) (rotate x 41)) let lsig0 x = logxor (rotate x 1) (logxor (rotate x 8) (shift_right_logical x 7)) let lsig1 x = logxor (rotate x 19) (logxor (rotate x 61) (shift_right_logical x 6)) let sha_init = ( 0x6a09e667f3bcc908L, 0xbb67ae8584caa73bL, 0x3c6ef372fe94f82bL, 0xa54ff53a5f1d36f1L, 0x510e527fade682d1L, 0x9b05688c2b3e6c1fL, 0x1f83d9abfb41bd6bL, 0x5be0cd19137e2179L ) let hash_block = let warr = Array.make 80 0L in fun hh block -> for t = 0 to 15 do warr.(t) <- I.get block t done; for t = 16 to 79 do warr.(t) <- add (add (lsig1 warr.(t - 2)) warr.(t - 7)) (add (lsig0 warr.(t - 15)) warr.(t - 16)) done; let rec stir t (a, b, c, d, e, f, g, h) = if t >= 80 then let a', b', c', d', e', f', g', h' = hh in add a a', add b b', add c c', add d d', add e e', add f f', add g g', add h h' else let t1 = add (add h (sum1 e)) (add (add (ch e f g) k.(t)) warr.(t)) in let t2 = add (sum0 a) (maj a b c) in stir (t + 1) (add t1 t2, a, b, c, add d t1, e, f, g) in stir 0 hh let blocksize = 16 let hash src = let bs = I.init ~blocksize src in let nbytes = I.byte_size bs in let blocks = nbytes / (blocksize * 8) in let rem = nbytes mod (blocksize * 8) in let h = ref sha_init in for i = 0 to blocks - 1 do h := hash_block !h (I.get_chunk bs i) done; let lastblock = I.get_chunk bs blocks in I.set_byte lastblock rem '\x80'; let lastblock = if rem <= 111 then lastblock else (h := hash_block !h lastblock; I.get_chunk bs (blocks+1)) in (* We assume sz fits in 61 bits... *) let bitsz = Int64.mul 8L (Int64.of_int nbytes) in I.set lastblock 15 bitsz; let (a, b, c, d, e, f, g, h) = hash_block !h lastblock in I.close bs; Printf.sprintf "%016Lx%016Lx%016Lx%016Lx%016Lx%016Lx%016Lx%016Lx" a b c d e f g h end module SHA256_file = Make_SHA256 (Input_file(Buf_Bigstring32)) module SHA512_file = Make_SHA512 (Input_file(Buf_Bigstring64)) module SHA256_string = Make_SHA256 (Input_string(Buf_String32)) module SHA512_string = Make_SHA512 (Input_string(Buf_String64)) let sha256_file = SHA256_file.hash let sha512_file = SHA512_file.hash let hash_file = function | `SHA256 -> sha256_file | `SHA512 -> sha512_file let sha256_bytes = SHA256_string.hash let sha512_bytes = SHA512_string.hash let hash_bytes = function | `SHA256 -> sha256_bytes | `SHA512 -> sha512_bytes let sha256 = sha256_file let sha512 = sha512_file let hash = hash_file opam-2.0.5/src/core/opamHash.mli0000644000175000017500000000306213511367404015441 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Stored as hexadecimal strings *) type kind = [ `MD5 | `SHA256 | `SHA512 ] type t val kind: t -> kind (** The value of the hash, as a string of hexadecimal characters *) val contents: t -> string val string_of_kind: kind -> string val md5: string -> t val sha256: string -> t val sha512: string -> t include OpamStd.ABSTRACT with type t := t val of_string_opt: string -> t option (** returns a sub-path specific to this hash, e.g. "md5/d4/d41d8cd98f00b204e9800998ecf8427e", as a list *) val to_path: t -> string list val check_file: string -> t -> bool (** Like [check_file], but returns the actual mismatching hash of the file, or [None] in case of match *) val mismatch: string -> t -> t option (** Compute hash of the given file *) val compute: ?kind:kind -> string -> t (** Compute the hash of the given string *) val compute_from_string: ?kind:kind -> string -> t opam-2.0.5/src/core/opamVersion.ml.in0000644000175000017500000000457213511367404016446 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type t = string let to_string x = x let of_string x = x let to_json x = `String x let compare v w = OpamVersionCompare.compare v w module O = struct type t = string let to_string = to_string let to_json = to_json let compare = compare end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) let current_raw = "@PACKAGE_VERSION@" let current = of_string current_raw let major v = try let i = String.index v '.' in of_string (String.sub v 0 i) with Not_found -> v let nopatch v = try let i = String.index v '.' in let i = String.index_from v (i+1) '.' in (String.sub v 0 i) with Not_found -> let rec f i = if i >= String.length v then v else match String.get v i with | '0'..'9' | '.' -> f (i+1) | _ -> String.sub v 0 i in f 0 let current_nopatch = nopatch current_raw let message () = OpamConsole.msg "\n\ %s version %s\n\ \n\ Copyright (C) 2012 OCamlPro - INRIA, 2013-2015 OCamlPro\n\ \n\ This is free software; see the source for copying conditions. There is NO\n\ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" Sys.argv.(0) current_raw; exit 0 let gitversion = ref None let set_git s = gitversion := Some s let git () = match !gitversion with | None -> None | Some v -> Some (of_string v) let full () = let git_version = match git () with | None -> "" | Some v -> Printf.sprintf " (%s)" (to_string v) in Printf.sprintf "%s%s" (to_string current) git_version let magic () = let hash = Hashtbl.hash (full ()) in String.sub (Printf.sprintf "%08X" hash) 0 8 opam-2.0.5/src/core/opamFilename.ml0000644000175000017500000003527413511367404016137 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Base = struct include OpamStd.AbstractString let check_suffix filename s = Filename.check_suffix filename s let add_extension filename suffix = filename ^ "." ^ suffix end let log fmt = OpamConsole.log "FILENAME" fmt let slog = OpamConsole.slog module Dir = struct include OpamStd.AbstractString let of_string dirname = let dirname = if dirname = "~" then OpamStd.Sys.home () else if OpamStd.String.starts_with ~prefix:("~"^Filename.dir_sep) dirname then Filename.concat (OpamStd.Sys.home ()) (OpamStd.String.remove_prefix ~prefix:("~"^Filename.dir_sep) dirname) else dirname in OpamSystem.real_path dirname let to_string dirname = dirname end let raw_dir s = s let with_tmp_dir fn = OpamSystem.with_tmp_dir (fun dir -> fn (Dir.of_string dir)) let with_tmp_dir_job fjob = OpamSystem.with_tmp_dir_job (fun dir -> fjob (Dir.of_string dir)) let rmdir dirname = OpamSystem.remove_dir (Dir.to_string dirname) let rec rmdir_cleanup dirname = let sd = Dir.to_string dirname in if OpamSystem.dir_is_empty sd then ( rmdir dirname; let parent = Filename.dirname sd in if parent <> sd then rmdir_cleanup parent ) let cwd () = Dir.of_string (Unix.getcwd ()) let mkdir dirname = OpamSystem.mkdir (Dir.to_string dirname) let cleandir dirname = log "cleandir %a" (slog Dir.to_string) dirname; OpamSystem.remove (Dir.to_string dirname); mkdir dirname let rec_dirs d = let fs = OpamSystem.rec_dirs (Dir.to_string d) in List.rev (List.rev_map Dir.of_string fs) let dirs d = let fs = OpamSystem.dirs (Dir.to_string d) in List.rev (List.rev_map Dir.of_string fs) let dir_is_empty d = OpamSystem.dir_is_empty (Dir.to_string d) let in_dir dirname fn = OpamSystem.in_dir dirname fn let env_of_list l = Array.of_list (List.rev_map (fun (k,v) -> k^"="^v) l) let exec dirname ?env ?name ?metadata ?keep_going cmds = let env = match env with | None -> None | Some l -> Some (env_of_list l) in in_dir dirname (fun () -> OpamSystem.commands ?env ?name ?metadata ?keep_going cmds) let move_dir ~src ~dst = OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ()) [ "mv"; Dir.to_string src; Dir.to_string dst ] let exists_dir dirname = try (Unix.stat (Dir.to_string dirname)).Unix.st_kind = Unix.S_DIR with Unix.Unix_error _ -> false let opt_dir dirname = if exists_dir dirname then Some dirname else None let basename_dir dirname = Base.of_string (Filename.basename (Dir.to_string dirname)) let dirname_dir dirname = Filename.dirname (Dir.to_string dirname) let link_dir ~target ~link = if exists_dir link then OpamSystem.internal_error "Cannot link: %s already exists." (Dir.to_string link) else OpamSystem.link (Dir.to_string target) (Dir.to_string link) let to_list_dir dir = let base d = Dir.of_string (Filename.basename (Dir.to_string d)) in let rec aux acc dir = let d = dirname_dir dir in if d <> dir then aux (base dir :: acc) d else base dir :: acc in aux [] dir let (/) d1 s2 = let s1 = Dir.to_string d1 in raw_dir (Filename.concat s1 s2) let concat_and_resolve d1 s2 = let s1 = Dir.to_string d1 in Dir.of_string (Filename.concat s1 s2) type t = { dirname: Dir.t; basename: Base.t; } let create dirname basename = let b1 = Filename.dirname (Base.to_string basename) in let b2 = Base.of_string (Filename.basename (Base.to_string basename)) in if basename = b2 then { dirname; basename } else { dirname = dirname / b1; basename = b2 } let of_basename basename = let dirname = Dir.of_string Filename.current_dir_name in { dirname; basename } let raw str = let dirname = raw_dir (Filename.dirname str) in let basename = Base.of_string (Filename.basename str) in create dirname basename let to_string t = Filename.concat (Dir.to_string t.dirname) (Base.to_string t.basename) let touch t = OpamSystem.write (to_string t) "" let chmod t p = Unix.chmod (to_string t) p let of_string s = let dirname = Filename.dirname s in let basename = Filename.basename s in { dirname = Dir.of_string dirname; basename = Base.of_string basename; } let dirname t = t.dirname let basename t = t.basename let read filename = OpamSystem.read (to_string filename) let open_in filename = try open_in (to_string filename) with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename)) let open_out filename = try open_out (to_string filename) with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename)) let write filename raw = OpamSystem.write (to_string filename) raw let remove filename = OpamSystem.remove_file (to_string filename) let exists filename = try (Unix.stat (to_string filename)).Unix.st_kind = Unix.S_REG with Unix.Unix_error _ -> false let opt_file filename = if exists filename then Some filename else None let with_contents fn filename = fn (read filename) let check_suffix filename s = Filename.check_suffix (to_string filename) s let add_extension filename suffix = of_string ((to_string filename) ^ "." ^ suffix) let chop_extension filename = of_string (Filename.chop_extension (to_string filename)) let rec_files d = let fs = OpamSystem.rec_files (Dir.to_string d) in List.rev_map of_string fs let files d = let fs = OpamSystem.files (Dir.to_string d) in List.rev_map of_string fs let copy ~src ~dst = if src <> dst then OpamSystem.copy_file (to_string src) (to_string dst) let copy_dir ~src ~dst = if src <> dst then OpamSystem.copy_dir (Dir.to_string src) (Dir.to_string dst) let install ?exec ~src ~dst () = if src <> dst then OpamSystem.install ?exec (to_string src) (to_string dst) let move ~src ~dst = if src <> dst then OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ()) [ "mv"; to_string src; to_string dst ] let readlink src = if exists src then try let rl = Unix.readlink (to_string src) in if Filename.is_relative rl then of_string (Filename.concat (dirname src) rl) else of_string rl with Unix.Unix_error _ -> src else OpamSystem.internal_error "%s does not exist." (to_string src) let is_symlink src = try let s = Unix.lstat (to_string src) in s.Unix.st_kind = Unix.S_LNK with Unix.Unix_error _ -> false let is_symlink_dir src = try let s = Unix.lstat (Dir.to_string src) in s.Unix.st_kind = Unix.S_LNK with Unix.Unix_error _ -> false let is_exec file = try OpamSystem.is_exec (to_string file) with Unix.Unix_error _ -> OpamSystem.internal_error "%s does not exist." (to_string file) let starts_with dirname filename = OpamStd.String.starts_with ~prefix:(Dir.to_string dirname) (to_string filename) let dir_starts_with pfx dir = OpamStd.String.starts_with ~prefix:(Dir.to_string pfx) (Dir.to_string dir) let remove_prefix prefix filename = let prefix = let str = Dir.to_string prefix in if str = "" then "" else Filename.concat str "" in let filename = to_string filename in OpamStd.String.remove_prefix ~prefix filename let remove_prefix_dir prefix dir = let prefix = Dir.to_string prefix in let dirname = Dir.to_string dir in if prefix = "" then dirname else OpamStd.String.remove_prefix ~prefix dirname |> OpamStd.String.remove_prefix ~prefix:Filename.dir_sep let process_in ?root fn src dst = let basename = match root with | None -> basename src | Some r -> if starts_with r src then remove_prefix r src else OpamSystem.internal_error "%s is not a prefix of %s" (Dir.to_string r) (to_string src) in let dst = Filename.concat (Dir.to_string dst) basename in fn ~src ~dst:(of_string dst) let copy_in ?root = process_in ?root copy let is_archive filename = OpamSystem.is_archive (to_string filename) let extract filename dirname = OpamSystem.extract (to_string filename) ~dir:(Dir.to_string dirname) let extract_job filename dirname = OpamSystem.extract_job (to_string filename) ~dir:(Dir.to_string dirname) let extract_in filename dirname = OpamSystem.extract_in (to_string filename) ~dir:(Dir.to_string dirname) let extract_in_job filename dirname = OpamSystem.extract_in_job (to_string filename) ~dir:(Dir.to_string dirname) type generic_file = | D of Dir.t | F of t let extract_generic_file filename dirname = match filename with | F f -> log "extracting %a to %a" (slog to_string) f (slog Dir.to_string) dirname; extract f dirname | D d -> if d <> dirname then ( log "copying %a to %a" (slog Dir.to_string) d (slog Dir.to_string) dirname; copy_dir ~src:d ~dst:dirname ) let ends_with suffix filename = OpamStd.String.ends_with ~suffix (to_string filename) let dir_ends_with suffix dirname = OpamStd.String.ends_with ~suffix (Dir.to_string dirname) let remove_suffix suffix filename = let suffix = Base.to_string suffix in let filename = to_string filename in OpamStd.String.remove_suffix ~suffix filename let rec find_in_parents f dir = if f dir then Some dir else let parent = dirname_dir dir in if parent = dir then None else find_in_parents f parent let link ?(relative=false) ~target ~link = if target = link then () else let target = if not relative then to_string target else match find_in_parents (fun d -> d <> "/" && starts_with d link) (dirname target) with | None -> to_string target | Some ancestor -> let back = let rel = remove_prefix_dir ancestor (dirname link) in OpamStd.List.concat_map Filename.dir_sep (fun _ -> "..") (OpamStd.String.split rel Filename.dir_sep.[0]) in let forward = remove_prefix ancestor target in Filename.concat back forward in OpamSystem.link target (to_string link) let patch ?preprocess filename dirname = OpamSystem.patch ?preprocess ~dir:(Dir.to_string dirname) (to_string filename) let flock flag ?dontblock file = OpamSystem.flock flag ?dontblock (to_string file) let with_flock flag ?dontblock file f = let lock = OpamSystem.flock flag ?dontblock (to_string file) in try let (fd, ch) = match OpamSystem.get_lock_fd lock with | exception Not_found -> let null = if OpamStd.Sys.(os () = Win32) then "nul" else "/dev/null" in let ch = Pervasives.open_out null in Unix.descr_of_out_channel ch, Some ch | fd -> fd, None in let r = f fd in OpamSystem.funlock lock; OpamStd.Option.iter Pervasives.close_out ch; r with e -> OpamStd.Exn.finalise e @@ fun () -> OpamSystem.funlock lock let with_flock_upgrade flag ?dontblock lock f = if OpamSystem.lock_isatleast flag lock then f (OpamSystem.get_lock_fd lock) else ( let old_flag = OpamSystem.get_lock_flag lock in OpamSystem.flock_update flag ?dontblock lock; try let r = f (OpamSystem.get_lock_fd lock) in OpamSystem.flock_update old_flag lock; r with e -> OpamStd.Exn.finalise e @@ fun () -> OpamSystem.flock_update old_flag lock ) let with_flock_write_then_read ?dontblock file write read = let lock = OpamSystem.flock `Lock_write ?dontblock (to_string file) in try let r = write (OpamSystem.get_lock_fd lock) in OpamSystem.flock_update `Lock_read lock; let r = read r in OpamSystem.funlock lock; r with e -> OpamStd.Exn.finalise e @@ fun () -> OpamSystem.funlock lock let prettify_path s = let aux ~short ~prefix = let prefix = Filename.concat prefix "" in if OpamStd.String.starts_with ~prefix s then let suffix = OpamStd.String.remove_prefix ~prefix s in Some (Filename.concat short suffix) else None in try match aux ~short:"~" ~prefix:(OpamStd.Sys.home ()) with | Some p -> p | None -> s with Not_found -> s let prettify_dir d = prettify_path (Dir.to_string d) let prettify s = prettify_path (to_string s) let to_json x = `String (to_string x) module O = struct type tmp = t type t = tmp let compare = compare let to_string = to_string let to_json = to_json end module Map = OpamStd.Map.Make(O) module Set = OpamStd.Set.Make(O) module Op = struct let (/) = (/) let (//) d1 s2 = let d = Filename.dirname s2 in let b = Filename.basename s2 in if d <> "." then create (d1 / d) (Base.of_string b) else create d1 (Base.of_string s2) end module Attribute = struct type t = { base: Base.t; md5 : OpamHash.t; perm: int option; } let base t = t.base let md5 t = t.md5 let perm t = t.perm let create base md5 perm = { base; md5; perm=perm } let to_string_list t = let perm = match t.perm with | None -> [] | Some p -> [Printf.sprintf "0o%o" p] in Base.to_string t.base :: OpamHash.to_string t.md5 :: perm let of_string_list = function | [base; md5] -> { base=Base.of_string base; md5=OpamHash.of_string md5; perm=None } | [base;md5; perm] -> { base=Base.of_string base; md5=OpamHash.of_string md5; perm=Some (int_of_string perm) } | k -> OpamSystem.internal_error "remote_file: '%s' is not a valid line." (String.concat " " k) let to_string t = String.concat " " (to_string_list t) let of_string s = of_string_list (OpamStd.String.split s ' ') let to_json x = `O ([ ("base" , Base.to_json x.base); ("md5" , `String (OpamHash.to_string x.md5))] @ match x. perm with | None -> [] | Some p -> ["perm", `String (string_of_int p)]) module O = struct type tmp = t type t = tmp let to_string = to_string let compare = compare let to_json = to_json end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) end let to_attribute root file = let basename = Base.of_string (remove_prefix root file) in let perm = let s = Unix.stat (to_string file) in s.Unix.st_perm in let digest = OpamHash.compute ~kind:`MD5 (to_string file) in Attribute.create basename digest (Some perm) opam-2.0.5/src/core/opamStd.ml0000644000175000017500000010577413511367404015154 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat module type SET = sig include Set.S val map: (elt -> elt) -> t -> t val is_singleton: t -> bool val choose_one : t -> elt val of_list: elt list -> t val to_string: t -> string val to_json: t -> OpamJson.t val find: (elt -> bool) -> t -> elt val find_opt: (elt -> bool) -> t -> elt option val safe_add: elt -> t -> t module Op : sig val (++): t -> t -> t val (--): t -> t -> t val (%%): t -> t -> t end end module type MAP = sig include Map.S val to_string: ('a -> string) -> 'a t -> string val to_json: ('a -> OpamJson.t) -> 'a t -> OpamJson.t val keys: 'a t -> key list val values: 'a t -> 'a list val find_opt: key -> 'a t -> 'a option val union: ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t val is_singleton: 'a t -> bool val of_list: (key * 'a) list -> 'a t val safe_add: key -> 'a -> 'a t -> 'a t val update: key -> ('a -> 'a) -> 'a -> 'a t -> 'a t end module type ABSTRACT = sig type t val of_string: string -> t val to_string: t -> string val to_json: t -> OpamJson.t module Set: SET with type elt = t module Map: MAP with type key = t end module type OrderedType = sig include Set.OrderedType val to_string: t -> string val to_json: t -> OpamJson.t end let max_print = 100 module OpamList = struct let cons x xs = x :: xs let concat_map ?(left="") ?(right="") ?nil ?last_sep sep f = let last_sep = match last_sep with None -> sep | Some sep -> sep in function | [] -> (match nil with Some s -> s | None -> left^right) | l -> let seplen = String.length sep in let strs,len = List.fold_left (fun (strs,len) x -> let s = f x in s::strs, String.length s + seplen + len) ([], String.length left + String.length right - seplen) l in let len = match l with | _::_::_ -> len + String.length last_sep - seplen | _ -> len in let buf = Bytes.create len in let prepend i s = let slen = String.length s in Bytes.blit_string s 0 buf (i - slen) slen; i - slen in let pos = prepend len right in let pos = prepend pos (List.hd strs) in let pos = List.fold_left (fun (pos, cur_sep) s -> (prepend (prepend pos cur_sep) s, sep)) (pos, last_sep) (List.tl strs) |> fst in let pos = prepend pos left in assert (pos = 0); Bytes.to_string buf let rec find_opt f = function | [] -> None | x::r -> if f x then Some x else find_opt f r let to_string f = concat_map ~left:"{ " ~right:" }" ~nil:"{}" ", " f let rec remove_duplicates = function | a::(b::_ as r) when a = b -> remove_duplicates r | a::r -> a::remove_duplicates r | [] -> [] let sort_nodup cmp l = remove_duplicates (List.sort cmp l) let filter_map f l = let rec loop accu = function | [] -> List.rev accu | h :: t -> match f h with | None -> loop accu t | Some x -> loop (x::accu) t in loop [] l let filter_some l = filter_map (fun x -> x) l let rec find_map f = function | [] -> raise Not_found | x::r -> match f x with | Some r -> r | None -> find_map f r let insert comp x l = let rec aux = function | [] -> [x] | h::t when comp h x < 0 -> h::aux t | l -> x :: l in aux l let rec insert_at index value = function | [] -> [value] | l when index <= 0 -> value :: l | x::l -> x :: insert_at (index - 1) value l let pick_assoc x l = let rec aux acc = function | [] -> None, l | (k,v) as b::r -> if k = x then Some v, List.rev_append acc r else aux (b::acc) r in aux [] l let update_assoc k v l = let rec aux acc = function | [] -> List.rev ((k,v)::acc) | (k1,_) as b::r -> if k1 = k then List.rev_append acc ((k,v)::r) else aux (b::acc) r in aux [] l end module Set = struct module Make (O : OrderedType) = struct module S = Set.Make(O) include S let fold f set i = let r = ref i in S.iter (fun elt -> r := f elt !r ) set; !r let is_singleton s = not (is_empty s) && min_elt s == max_elt s let choose_one s = if is_empty s then raise Not_found else if is_singleton s then choose s else failwith "choose_one" let of_list l = List.fold_left (fun set e -> add e set) empty l let to_string s = if S.cardinal s > max_print then Printf.sprintf "%d elements" (S.cardinal s) else let l = S.fold (fun nv l -> O.to_string nv :: l) s [] in OpamList.to_string (fun x -> x) (List.rev l) let map f t = S.fold (fun e set -> S.add (f e) set) t S.empty exception Found of elt let find_opt fn t = try iter (fun x -> if fn x then raise (Found x)) t; None with Found x -> Some x let find fn t = match find_opt fn t with | Some x -> x | None -> raise Not_found let to_json t = let elements = S.elements t in let jsons = List.map O.to_json elements in `A jsons module Op = struct let (++) = union let (--) = diff let (%%) = inter end let safe_add elt t = if mem elt t then failwith (Printf.sprintf "duplicate entry %s" (O.to_string elt)) else add elt t end end module Map = struct module Make (O : OrderedType) = struct module M = Map.Make(O) include M let fold f map i = let r = ref i in M.iter (fun key value-> r:= f key value !r ) map; !r let map f map = fold (fun key value map -> add key (f value) map ) map empty let mapi f map = fold (fun key value map -> add key (f key value) map ) map empty let values map = List.rev (M.fold (fun _ v acc -> v :: acc) map []) let keys map = List.rev (M.fold (fun k _ acc -> k :: acc) map []) let union f m1 m2 = M.merge (fun _ a b -> match a, b with | Some _ as s, None | None, (Some _ as s) -> s | Some v1, Some v2 -> Some (f v1 v2) | None, None -> assert false) m1 m2 let is_singleton s = not (is_empty s) && fst (min_binding s) == fst (max_binding s) let to_string string_of_value m = if M.cardinal m > max_print then Printf.sprintf "%d elements" (M.cardinal m) else let s (k,v) = Printf.sprintf "%s:%s" (O.to_string k) (string_of_value v) in let l = fold (fun k v l -> s (k,v)::l) m [] in OpamList.to_string (fun x -> x) l let of_list l = List.fold_left (fun map (k,v) -> add k v map) empty l let to_json json_of_value t = let bindings = M.bindings t in let jsons = List.map (fun (k,v) -> `O [ ("key" , O.to_json k); ("value", json_of_value v) ] ) bindings in `A jsons let find_opt k map = try Some (find k map) with Not_found -> None let safe_add k v map = if mem k map then failwith (Printf.sprintf "duplicate entry %s" (O.to_string k)) else add k v map let update k f zero map = let v = try find k map with Not_found -> zero in add k (f v) map end end module AbstractString = struct type t = string let of_string x = x let to_string x = x let to_json x = `String x module O = struct type t = string let to_string = to_string let compare = compare let to_json = to_json end module Set = Set.Make(O) module Map = Map.Make(O) end module OInt = struct type t = int let compare = compare let to_string = string_of_int let to_json i = `String (string_of_int i) end module IntMap = Map.Make(OInt) module IntSet = Set.Make(OInt) module Option = struct let map f = function | None -> None | Some x -> Some (f x) let iter f = function | None -> () | Some x -> f x let default dft = function | None -> dft | Some x -> x let default_map dft = function | None -> dft | some -> some let replace f = function | None -> None | Some x -> f x let map_default f dft = function | None -> dft | Some x -> f x let compare cmp o1 o2 = match o1,o2 with | None, None -> 0 | Some _, None -> 1 | None, Some _ -> -1 | Some x1, Some x2 -> cmp x1 x2 let to_string ?(none="") f = function | Some x -> f x | None -> none let some x = Some x let none _ = None let of_Not_found f x = try Some (f x) with Not_found -> None module Op = struct let (>>=) = function | None -> fun _ -> None | Some x -> fun f -> f x let (>>|) opt f = map f opt let (>>+) opt f = match opt with | None -> f () | some -> some let (+!) opt dft = default dft opt let (++) = function | None -> fun opt -> opt | some -> fun _ -> some end end module OpamString = struct module OString = struct type t = string let compare = compare let to_string x = x let to_json x = `String x end module StringSet = Set.Make(OString) module StringMap = Map.Make(OString) module SetSet = Set.Make(StringSet) module SetMap = Map.Make(StringSet) module Set = StringSet module Map = StringMap let starts_with ~prefix s = let x = String.length prefix in let n = String.length s in n >= x && String.sub s 0 x = prefix let ends_with ~suffix s = let x = String.length suffix in let n = String.length s in n >= x && String.sub s (n - x) x = suffix let contains_char s c = try let _ = String.index s c in true with Not_found -> false let contains ~sub = Re.(execp (compile (str sub))) let exact_match re s = try let subs = Re.exec re s in let subs = Array.to_list (Re.get_all_ofs subs) in let n = String.length s in let subs = List.filter (fun (s,e) -> s=0 && e=n) subs in List.length subs > 0 with Not_found -> false let map f s = let len = String.length s in let b = Bytes.create len in for i = 0 to len - 1 do Bytes.set b i (f s.[i]) done; Bytes.to_string b let is_whitespace = function | ' ' | '\t' | '\r' | '\n' -> true | _ -> false let strip str = let p = ref 0 in let l = String.length str in while !p < l && is_whitespace (String.unsafe_get str !p) do incr p; done; let p = !p in let l = ref (l - 1) in while !l >= p && is_whitespace (String.unsafe_get str !l) do decr l; done; String.sub str p (!l - p + 1) let strip_right str = let rec aux i = if i < 0 || not (is_whitespace str.[i]) then i else aux (i-1) in let l = String.length str in let i = aux (l-1) in if i = l - 1 then str else String.sub str 0 (i+1) let sub_at n s = if String.length s <= n then s else String.sub s 0 n let remove_prefix ~prefix s = if starts_with ~prefix s then let x = String.length prefix in let n = String.length s in String.sub s x (n - x) else s let remove_suffix ~suffix s = if ends_with ~suffix s then let x = String.length suffix in let n = String.length s in String.sub s 0 (n - x) else s let cut_at_aux fn s sep = try let i = fn s sep in let name = String.sub s 0 i in let version = String.sub s (i+1) (String.length s - i - 1) in Some (name, version) with Invalid_argument _ | Not_found -> None let cut_at = cut_at_aux String.index let rcut_at = cut_at_aux String.rindex let split s c = (* old compat version (Re 1.2.0) {[Re_str.split (Re_str.regexp (Printf.sprintf "[%c]+" c)) s]} *) Re.(split (compile (rep1 (char c)))) s let split_delim s c = let tokens = Re.(split_full (compile (char c)) s) in let rec aux acc = function | [] -> acc | (`Delim _)::[] -> ""::acc | (`Text s)::tl -> aux (s::acc) tl | (`Delim _)::tl -> aux acc tl in let acc0 = match tokens with | (`Delim _)::_ -> [""] |_ -> [] in List.rev (aux acc0 tokens) let fold_left f acc s = let acc = ref acc in for i = 0 to String.length s - 1 do acc := f !acc s.[i] done; !acc end type warning_printer = {mutable warning : 'a . ('a, unit, string, unit) format4 -> 'a} let console = ref {warning = fun fmt -> Printf.ksprintf prerr_string fmt} module Env = struct (* Remove from a c-separated list of string the one with the given prefix *) let reset_value ~prefix c v = let v = OpamString.split v c in List.filter (fun v -> not (OpamString.starts_with ~prefix v)) v (* Split the list in two according to the first occurrence of the string starting with the given prefix. *) let cut_value ~prefix c v = let v = OpamString.split v c in let rec aux before = function | [] -> [], List.rev before | curr::after when OpamString.starts_with ~prefix curr -> before, after | curr::after -> aux (curr::before) after in aux [] v let list = let lazy_env = lazy ( let e = Unix.environment () in List.rev_map (fun s -> match OpamString.cut_at s '=' with | None -> s, "" | Some p -> p ) (Array.to_list e) ) in fun () -> Lazy.force lazy_env let get = if Sys.win32 then fun n -> let n = String.uppercase_ascii n in snd (List.find (fun (k,_) -> String.uppercase_ascii k = n) (list ())) else fun n -> List.assoc n (list ()) let getopt n = try Some (get n) with Not_found -> None let escape_single_quotes ?(using_backslashes=false) = if using_backslashes then Re.(replace (compile (set "\\\'")) ~f:(fun g -> "\\"^Group.get g 0)) else Re.(replace_string (compile (char '\'')) ~by:"'\"'\"'") end (** To use when catching default exceptions: ensures we don't catch fatal errors like C-c *) let fatal e = match e with | Sys.Break -> prerr_newline (); raise e | Assert_failure _ | Match_failure _ -> raise e | _ -> () module OpamSys = struct let path_sep = if Sys.win32 then ';' else ':' let split_path_variable ?(clean=true) = if Sys.win32 then fun path -> let length = String.length path in let rec f acc index current last normal = if index = length then let current = current ^ String.sub path last (index - last) in if current <> "" then current::acc else acc else let c = path.[index] and next = succ index in if c = ';' && normal || c = '"' then let current = current ^ String.sub path last (index - last) in if c = '"' then f acc next current next (not normal) else let acc = if current = "" then acc else current::acc in f acc next "" next true else f acc next current last normal in f [] 0 "" 0 true else fun path -> let split = if clean then OpamString.split else OpamString.split_delim in split path path_sep let with_process_in cmd args f = if Sys.win32 then assert false; let path = split_path_variable (Env.get "PATH") in let cmd = List.find Sys.file_exists (List.map (fun d -> Filename.concat d cmd) path) in let ic = Unix.open_process_in (cmd^" "^args) in try let r = f ic in ignore (Unix.close_process_in ic) ; r with exn -> ignore (Unix.close_process_in ic) ; raise exn let tty_out = Unix.isatty Unix.stdout let tty_in = Unix.isatty Unix.stdin let default_columns = let default = 16_000_000 in let cols = try int_of_string (Env.get "COLUMNS") with | Not_found | Failure _ -> default in if cols > 0 then cols else default let get_terminal_columns () = let fallback = 80 in let cols = try (* terminfo *) with_process_in "tput" "cols" (fun ic -> int_of_string (input_line ic)) with | Unix.Unix_error _ | Sys_error _ | Failure _ | End_of_file | Not_found -> try (* GNU stty *) with_process_in "stty" "size" (fun ic -> match OpamString.split (input_line ic) ' ' with | [_ ; v] -> int_of_string v | _ -> failwith "stty") with | Unix.Unix_error _ | Sys_error _ | Failure _ | End_of_file | Not_found -> fallback in if cols > 0 then cols else fallback let win32_get_console_width () = let hConsoleOutput = OpamStubs.(getStdHandle STD_OUTPUT_HANDLE) in let {OpamStubs.size = (width, _); _} = OpamStubs.getConsoleScreenBufferInfo hConsoleOutput in width let terminal_columns = let v = ref (lazy (get_terminal_columns ())) in let () = try Sys.set_signal 28 (* SIGWINCH *) (Sys.Signal_handle (fun _ -> v := lazy (get_terminal_columns ()))) with Invalid_argument _ -> () in if Sys.win32 then fun () -> if tty_out then win32_get_console_width () else default_columns else fun () -> if tty_out then Lazy.force !v else default_columns let home = let home = lazy (try Env.get "HOME" with Not_found -> Sys.getcwd ()) in fun () -> Lazy.force home let etc () = "/etc" let uname = let memo = Hashtbl.create 7 in fun arg -> try Hashtbl.find memo arg with Not_found -> let r = try with_process_in "uname" arg (fun ic -> Some (OpamString.strip (input_line ic))) with Unix.Unix_error _ | Sys_error _ | Not_found -> None in Hashtbl.add memo arg r; r type os = | Darwin | Linux | FreeBSD | OpenBSD | NetBSD | DragonFly | Cygwin | Win32 | Unix | Other of string let os = let os = lazy ( match Sys.os_type with | "Unix" -> begin match uname "-s" with | Some "Darwin" -> Darwin | Some "Linux" -> Linux | Some "FreeBSD" -> FreeBSD | Some "OpenBSD" -> OpenBSD | Some "NetBSD" -> NetBSD | Some "DragonFly" -> DragonFly | _ -> Unix end | "Win32" -> Win32 | "Cygwin" -> Cygwin | s -> Other s ) in fun () -> Lazy.force os type shell = SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish let shell_of_string = function | "tcsh" | "bsd-csh" | "csh" -> Some SH_csh | "zsh" -> Some SH_zsh | "bash" -> Some SH_bash | "fish" -> Some SH_fish | "sh" -> Some SH_sh | _ -> None let executable_name = if Sys.win32 then fun name -> if Filename.check_suffix name ".exe" then name else name ^ ".exe" else fun x -> x let guess_shell_compat () = let parent_guess = if Sys.win32 then None else let ppid = Unix.getppid () in let dir = Filename.concat "/proc" (string_of_int ppid) in try Some (Unix.readlink (Filename.concat dir "exe")) with e -> fatal e; try with_process_in "ps" (Printf.sprintf "-p %d -o comm= 2>/dev/null" ppid) (fun ic -> Some (input_line ic)) with | Unix.Unix_error _ | Sys_error _ | Failure _ | End_of_file | Not_found -> try let c = open_in_bin ("/proc/" ^ string_of_int ppid ^ "/cmdline") in begin try let s = input_line c in close_in c; Some (String.sub s 0 (String.index s '\000')) with | Not_found -> None | e -> close_in c; fatal e; None end with e -> fatal e; None in let test shell = shell_of_string (Filename.basename shell) in let shell = match Option.replace test parent_guess with | None -> Option.of_Not_found Env.get "SHELL" |> Option.replace test | some -> some in Option.default SH_sh shell let guess_dot_profile shell = let home f = try Filename.concat (home ()) f with Not_found -> f in match shell with | SH_fish -> List.fold_left Filename.concat (home ".config") ["fish"; "config.fish"] | SH_zsh -> home ".zshrc" | SH_bash -> (try List.find Sys.file_exists [ (* Bash looks up these 3 files in order and only loads the first, for LOGIN shells *) home ".bash_profile"; home ".bash_login"; home ".profile"; (* Bash loads .bashrc INSTEAD, for interactive NON login shells only; but it's often included from the above. We may include our variables in both to be sure ; for now we rely on non-login shells inheriting their env from a login shell somewhere... *) ] with Not_found -> (* iff none of the above exist, creating this should be safe *) home ".bash_profile") | SH_csh -> let cshrc = home ".cshrc" in let tcshrc = home ".tcshrc" in if Sys.file_exists cshrc then cshrc else tcshrc | SH_sh -> home ".profile" let registered_at_exit = ref [] let at_exit f = Pervasives.at_exit f; registered_at_exit := f :: !registered_at_exit let exec_at_exit () = List.iter (fun f -> try f () with _ -> ()) !registered_at_exit exception Exit of int exception Exec of string * string array * string array let exit i = raise (Exit i) type exit_reason = [ `Success | `False | `Bad_arguments | `Not_found | `Aborted | `Locked | `No_solution | `File_error | `Package_operation_error | `Sync_error | `Configuration_error | `Solver_failure | `Internal_error | `User_interrupt ] let exit_codes : (exit_reason * int) list = [ (* Normal return values *) `Success, 0; `False, 1; (* Errors happening in normal use (user related, or impossible requests) *) `Bad_arguments, 2; `Not_found, 5; `Aborted, 10; `Locked, 15; `No_solution, 20; (* Errors related to the database (repository and package definitions) *) `File_error, 30; `Package_operation_error, 31; (* Network related error *) `Sync_error, 40; (* Opam setup error *) `Configuration_error, 50; (* Errors that shouldn't happen and are likely bugs *) `Solver_failure, 60; `Internal_error, 99; (* Received signals *) `User_interrupt, 130; ] let get_exit_code reason = List.assoc reason exit_codes let exit_because reason = exit (get_exit_code reason) type nonrec warning_printer = warning_printer = {mutable warning : 'a . ('a, unit, string, unit) format4 -> 'a} let set_warning_printer = let called = ref false in fun printer -> if !called then invalid_arg "Just what do you think you're doing, Dave?"; called := true; console := printer end module Win32 = struct module RegistryHive = struct let to_string = function | OpamStubs.HKEY_CLASSES_ROOT -> "HKEY_CLASSES_ROOT" | OpamStubs.HKEY_CURRENT_CONFIG -> "HKEY_CURRENT_CONFIG" | OpamStubs.HKEY_CURRENT_USER -> "HKEY_CURRENT_USER" | OpamStubs.HKEY_LOCAL_MACHINE -> "HKEY_LOCAL_MACHINE" | OpamStubs.HKEY_USERS -> "HKEY_USERS" let of_string = function | "HKCR" | "HKEY_CLASSES_ROOT" -> OpamStubs.HKEY_CLASSES_ROOT | "HKCC" | "HKEY_CURRENT_CONFIG" -> OpamStubs.HKEY_CURRENT_CONFIG | "HKCU" | "HKEY_CURRENT_USER" -> OpamStubs.HKEY_CURRENT_USER | "HKLM" | "HKEY_LOCAL_MACHINE" -> OpamStubs.HKEY_LOCAL_MACHINE | "HKU" | "HKEY_USERS" -> OpamStubs.HKEY_USERS | _ -> failwith "RegistryHive.of_string" end let (set_parent_pid, parent_putenv) = let ppid = ref (lazy (OpamStubs.(getCurrentProcessID () |> getParentProcessID))) in let parent_putenv = lazy ( let ppid = Lazy.force !ppid in if OpamStubs.isWoW64 () <> OpamStubs.isWoW64Process ppid then (* * Expect to see opam-putenv.exe in the same directory as opam.exe, * rather than PATH (allow for crazy users like developers who may have * both builds of opam) *) let putenv_exe = Filename.(concat (dirname Sys.executable_name) "opam-putenv.exe") in let ctrl = ref stdout in let quit_putenv () = if !ctrl <> stdout then let () = Printf.fprintf !ctrl "::QUIT\n%!" in ctrl := stdout in at_exit quit_putenv; if Sys.file_exists putenv_exe then fun key value -> if !ctrl = stdout then begin let (inCh, outCh) = Unix.pipe () in let _ = Unix.create_process putenv_exe [| putenv_exe; Int32.to_string ppid |] inCh Unix.stdout Unix.stderr in ctrl := (Unix.out_channel_of_descr outCh); set_binary_mode_out !ctrl true; end; Printf.fprintf !ctrl "%s\n%s\n%!" key value; if key = "::QUIT" then ctrl := stdout; true else let warning = lazy ( !console.warning "opam-putenv was not found - \ OPAM is unable to alter environment variables"; false) in fun _ _ -> Lazy.force warning else function "::QUIT" -> fun _ -> true | key -> OpamStubs.process_putenv ppid key) in ((fun pid -> if Lazy.is_val parent_putenv then failwith "Target parent already known"; ppid := Lazy.from_val pid), (fun key -> (Lazy.force parent_putenv) key)) let persistHomeDirectory dir = (* Update our environment *) Unix.putenv "HOME" dir; (* Update our parent's environment *) ignore (parent_putenv "HOME" dir); (* Persist the value to the user's environment *) OpamStubs.(writeRegistry HKEY_CURRENT_USER "Environment" "HOME" REG_SZ dir); (* Broadcast the change (or a reboot would be required) *) (* These constants are defined in WinUser.h *) let hWND_BROADCAST = 0xffffn in let sMTO_ABORTIFHUNG = 0x2 in OpamStubs.(sendMessageTimeout hWND_BROADCAST 5000 sMTO_ABORTIFHUNG WM_SETTINGCHANGE 0 "Environment") |> ignore end module OpamFormat = struct let visual_length_substring s ofs len = let rec aux acc i = if i >= len then acc else match s.[ofs + i] with | '\xc2'..'\xdf' -> aux (acc - min 1 (len - i)) (i + 2) | '\xe0'..'\xef' -> aux (acc - min 2 (len - i)) (i + 3) | '\xf0'..'\xf4' -> aux (acc - min 3 (len - i)) (i + 4) | '\027' -> (try let j = String.index_from s (ofs+i+1) 'm' - ofs in if j > len then acc - (len - i) else aux (acc - (j - i + 1)) (j + 1) with Not_found | Invalid_argument _ -> acc - (len - i)) | _ -> aux acc (i + 1) in aux len 0 let visual_length s = visual_length_substring s 0 (String.length s) let visual_width s = List.fold_left max 0 (List.map visual_length (OpamString.split s '\n')) let cut_at_visual s width = let rec aux extra i = try let j = String.index_from s i '\027' in let k = String.index_from s (j+1) 'm' in if j - extra > width then width + extra else aux (extra + k - j + 1) (k + 1) with Not_found -> min (String.length s) (width + extra) | Invalid_argument _ -> String.length s in let cut_at = aux 0 0 in if cut_at = String.length s then s else let sub = String.sub s 0 cut_at in let rec rem_escapes i = try let j = String.index_from s i '\027' in let k = String.index_from s (j+1) 'm' in String.sub s j (k - j + 1) :: rem_escapes (k+1) with Not_found | Invalid_argument _ -> [] in String.concat "" (sub :: rem_escapes cut_at) let indent_left s ?(visual=s) nb = let nb = nb - String.length visual in if nb <= 0 then s else s ^ String.make nb ' ' let indent_right s ?(visual=s) nb = let nb = nb - String.length visual in if nb <= 0 then s else String.make nb ' ' ^ s let align_table ll = let rec transpose ll = if List.for_all ((=) []) ll then [] else let col, rest = List.fold_left (fun (col,rest) -> function | hd::tl -> hd::col, tl::rest | [] -> ""::col, []::rest) ([],[]) ll in List.rev col::transpose (List.rev rest) in let columns = transpose ll in let pad n s = let sn = visual_length s in if sn >= n then s else s ^ (String.make (n - sn) ' ') in let pad_multi n s = match OpamString.split s '\n' with | [] | [_] -> pad n s ^"\n" | ls -> String.concat "\n" (List.map (pad n) ls) in let align sl = let (len, multiline) = List.fold_left (fun (len,ml) s -> if String.contains s '\n' then max len (visual_width s), true else max len (visual_length s), ml) (0, false) sl in List.map (if multiline then pad_multi len else pad len) sl in let rec map_but_last f = function | ([] | [_]) as l -> l | x::r -> f x :: map_but_last f r in transpose (map_but_last align columns) let reformat ?(start_column=0) ?(indent=0) ?(width=OpamSys.terminal_columns ()) s = let slen = String.length s in let buf = Buffer.create 1024 in let rec find_nonsp i = if i >= slen then i else match s.[i] with ' ' -> find_nonsp (i+1) | _ -> i in let rec find_split i = if i >= slen then i else match s.[i] with ' ' | '\n' -> i | _ -> find_split (i+1) in let newline i = Buffer.add_char buf '\n'; if i+1 < slen && s.[i+1] <> '\n' then for _i = 1 to indent do Buffer.add_char buf ' ' done in let rec print i col = if i >= slen then () else if s.[i] = '\n' then (newline i; print (i+1) indent) else let j = find_nonsp i in let k = find_split j in let len_visual = visual_length_substring s i (k - i) in if col + len_visual >= width && col > indent then (newline i; Buffer.add_substring buf s j (k - j); print k (indent + len_visual - j + i)) else (Buffer.add_substring buf s i (k - i); print k (col + len_visual)) in print 0 start_column; Buffer.contents buf let itemize ?(bullet=" - ") f = let indent = visual_length bullet in OpamList.concat_map ~left:bullet ~right:"\n" ~nil:"" ("\n"^bullet) (fun s -> reformat ~start_column:indent ~indent (f s)) let rec pretty_list ?(last="and") = function | [] -> "" | [a] -> a | [a;b] -> Printf.sprintf "%s %s %s" a last b | h::t -> Printf.sprintf "%s, %s" h (pretty_list t) end module Exn = struct let fatal = fatal let register_backtrace, get_backtrace = let registered_backtrace = ref None in (fun e -> registered_backtrace := match !registered_backtrace with | Some (e1, _) as reg when e1 == e -> reg | _ -> Some (e, Printexc.get_backtrace ())), (fun e -> match !registered_backtrace with | Some(e1,bt) when e1 == e -> bt | _ -> Printexc.get_backtrace ()) let pretty_backtrace e = match get_backtrace e with | "" -> "" | b -> let b = OpamFormat.itemize ~bullet:" " (fun x -> x) (OpamString.split b '\n') in Printf.sprintf "Backtrace:\n%s" b let finalise e f = let bt = Printexc.get_raw_backtrace () in f (); Printexc.raise_with_backtrace e bt let finally f k = match k () with | r -> f (); r | exception e -> finalise e f end module Op = struct let (@@) f x = f x let (|>) x f = f x let (@*) g f x = g (f x) let (@>) f g x = g (f x) end module Config = struct module type Sig = sig type t type 'a options_fun val default: t val set: t -> (unit -> t) options_fun val setk: (t -> 'a) -> t -> 'a options_fun val r: t ref val update: ?noop:_ -> (unit -> unit) options_fun val init: ?noop:_ -> (unit -> unit) options_fun val initk: 'a -> 'a options_fun end type env_var = string let env conv var = try Option.map conv (Env.getopt ("OPAM"^var)) with Failure _ -> flush stdout; !console.warning "Invalid value for environment variable OPAM%s, ignored." var; None let env_bool var = env (fun s -> match String.lowercase_ascii s with | "" | "0" | "no" | "false" -> false | "1" | "yes" | "true" -> true | _ -> failwith "env_bool") var let env_int var = env int_of_string var let env_level var = env (fun s -> match String.lowercase_ascii s with | "" | "no" | "false" -> 0 | "yes" | "true" -> 1 | s -> int_of_string s) var let env_string var = env (fun s -> s) var let env_float var = env float_of_string var let when_ext s = match String.lowercase_ascii s with | "extended" -> `Extended | "always" -> `Always | "never" -> `Never | "auto" -> `Auto | _ -> failwith "env_when" let env_when_ext var = env when_ext var let env_when var = env (fun v -> match when_ext v with | (`Always | `Never | `Auto) as w -> w | `Extended -> failwith "env_when") var let resolve_when ~auto = function | `Always -> true | `Never -> false | `Auto -> Lazy.force auto let initk k = let utf8 = Option.Op.( env_when_ext "UTF8" ++ (env_bool "UTF8MSGS" >>= function | true -> Some `Extended | false -> None) ) in let answer = match env_bool "YES", env_bool "NO" with | Some true, _ -> Some (Some true) | _, Some true -> Some (Some false) | None, None -> None | _ -> Some None in OpamCoreConfig.(setk (setk (fun c -> r := c; k)) !r) ?debug_level:(env_level "DEBUG") ?verbose_level:(env_level "VERBOSE") ?color:(env_when "COLOR") ?utf8 ?disp_status_line:(env_when "STATUSLINE") ?answer ?safe_mode:(env_bool "SAFE") ?log_dir:(env_string "LOGS") ?keep_log_dir:(env_bool "KEEPLOGS") ?errlog_length:(env_int "ERRLOGLEN") ?merged_output:(env_bool "MERGEOUT") ?use_openssl:(env_bool "USEOPENSSL") ?precise_tracking:(env_bool "PRECISETRACKING") let init ?noop:_ = initk (fun () -> ()) end module List = OpamList module String = OpamString module Sys = OpamSys module Format = OpamFormat opam-2.0.5/src/core/opamDirTrack.mli0000644000175000017500000000431513511367404016263 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** uniquely identifies a filesystem item value *) type digest (** Defines a change concerning a fs item; The [digest] parameter is the new value of the item *) type change = | Added of digest | Removed | Contents_changed of digest (** For links, corresponds to a change of target *) | Perm_changed of digest | Kind_changed of digest (** Used e.g. when a file is replaced by a directory, a link or a fifo *) type t = change OpamStd.String.Map.t (** Returns a printable, multi-line string *) val to_string: t -> string val digest_of_string: string -> digest val string_of_digest: digest -> string (** Wraps a job to track the changes that happened under [dirname] during its execution (changes done by the application of the job function to [()] are tracked too, for consistency with jobs without commands) *) val track: OpamFilename.Dir.t -> ?except:OpamFilename.Base.Set.t -> (unit -> 'a OpamProcess.job) -> ('a * t) OpamProcess.job (** Removes the added and kind-changed items unless their contents changed and [force] isn't set, and prints warnings for other changes unless [verbose] is set to [false]. Ignores non-existing files. [title] is used to prefix messages if specified. *) val revert: ?title:string -> ?verbose:bool -> ?force:bool -> ?dryrun:bool -> OpamFilename.Dir.t -> t -> unit (** Checks the items that were added or kind-changed in the given diff, and returns their status *) val check: OpamFilename.Dir.t -> t -> (OpamFilename.t * [`Unchanged | `Removed | `Changed]) list opam-2.0.5/src/core/opamStubs.ml.win320000644000175000017500000000143213511367404016445 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 MetaStack Solutions Ltd. *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include OpamStubsTypes include OpamWin32Stubs let getpid () = Int32.to_int (getCurrentProcessID ()) opam-2.0.5/src/core/opamVersionCompare.ml0000644000175000017500000001527513511367404017352 0ustar nicoonicoo(******************************************************************************) (* This file is part of the Dose library http://www.irill.org/software/dose *) (* *) (* Copyright (C) 2011 Ralf Treinen *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (* Work developed with the support of the Mancoosi Project *) (* http://www.mancoosi.org *) (* *) (******************************************************************************) let is_digit = function | '0'..'9' -> true | _ -> false ;; (* [skip_while_from i f w m] yields the index of the leftmost character * in the string [s], starting from [i], end ending at [m], that does * not satisfy the predicate [f], or [length w] if no such index exists. *) let skip_while_from i f w m = let rec loop i = if i = m then i else if f w.[i] then loop (i + 1) else i in loop i ;; (* splits a version into (epoch,rest), without the separating ':'. The * epoch is delimited by the leftmost occurrence of ':' in x, and is "" * in case there is no ':' in x. *) let extract_epoch x = try let ci = String.index x ':' in let epoch = String.sub x 0 ci and rest = String.sub x (ci + 1) (String.length x - ci - 1) in (epoch,rest) with | Not_found -> ("",x) ;; (* splits a version into (prefix,revision). The revision starts on the * right-most occurrence of '-', or is empty in case the version does * not contain '-'. *) let extract_revision x = try let di = String.rindex x '-' in let before = String.sub x 0 di in let after = String.sub x (di+1) (String.length x - di -1) in (before,after) with | Not_found -> (x,"") ;; (* character comparison uses a modified character ordering: '~' first, then letters, then anything else *) let compare_chars c1 c2 = match c1 with | '~' -> (match c2 with | '~' -> 0 | _ -> -1) | 'a'..'z'|'A'..'Z' -> (match c2 with | '~' -> 1 | 'a'..'z'|'A'..'Z' -> Char.compare c1 c2 | _ -> -1) | _ -> (match c2 with | '~'|'a'..'z'|'A'..'Z' -> 1 | _ -> Char.compare c1 c2) ;; (* return the first index of x, starting from xi, of a nun-null * character in x. or (length x) in case x contains only 0's starting * from xi on. *) let skip_zeros x xi xl = skip_while_from xi (fun c -> c = '0') x xl;; (* compare versions chunks, that is parts of version strings that are * epoch, upstream version, or revisision. Alternates string comparison * and numerical comparison. *) let compare_chunks x y = (* x and y may be empty *) let xl = String.length x and yl = String.length y in let rec loop_lexical xi yi = assert (xi <= xl && yi <= yl); match (xi=xl,yi=yl) with (* which of x and y is exhausted? *) | true,true -> 0 | true,false -> (* if y continues numerically than we have to continue by * comparing numerically. In this case the x part is * interpreted as 0 (since empty). If the y part consists * only of 0's then both parts are equal, otherwise the y * part is larger. If y continues non-numerically then y is * larger anyway, so we only have to skip 0's in the y part * and check whether this exhausts the y part. *) let ys = skip_zeros y yi yl in if ys = yl then 0 else if y.[ys]='~' then 1 else -1 | false,true -> (* symmetric to the preceding case *) let xs = skip_zeros x xi xl in if xs = xl then 0 else if x.[xs]='~' then -1 else 1 | false,false -> (* which of x and y continues numerically? *) match (is_digit x.[xi], is_digit y.[yi]) with | true,true -> (* both continue numerically. Skip leading zeros in the * remaining parts, and then continue by * comparing numerically. *) compare_numerical (skip_zeros x xi xl) (skip_zeros y yi yl) | true,false -> (* '~' is smaller than any numeric part *) if y.[yi]='~' then 1 else -1 | false,true -> (* '~' is smaller than any numeric part *) if x.[xi]='~' then -1 else 1 | false,false -> (* continue comparing lexically *) let comp = compare_chars x.[xi] y.[yi] in if comp = 0 then loop_lexical (xi+1) (yi+1) else comp and compare_numerical xi yi = assert (xi = xl || (xi < xl && x.[xi] <> '0')); (* leading zeros have been stripped *) assert (yi = yl || (yi < yl && y.[yi] <> '0')); (* leading zeros have been stripped *) let xn = skip_while_from xi is_digit x xl (* length of numerical part *) and yn = skip_while_from yi is_digit y yl (* length of numerical part *) in let comp = compare (xn-xi) (yn-yi) in if comp = 0 then (* both numerical parts have same length: compare digit by digit *) loop_numerical xi yi yn else (* if one numerical part is longer than the other we have found the * answer since leading 0 have been striped when switching * to numerical comparison. *) comp and loop_numerical xi yi yn = assert (xi <= xl && yi <= yn && yn <= yl); (* invariant: the two numerical parts that remain to compare are of the same length *) if yi=yn then (* both numerical parts are exhausted, we switch to lexical comparison *) loop_lexical xi yi else (* both numerical parts are not exhausted, we continue comparing digit by digit *) let comp = Char.compare x.[xi] y.[yi] in if comp = 0 then loop_numerical (xi+1) (yi+1) yn else comp in loop_lexical 0 0 ;; let compare (x : string) (y : string) = let normalize_comp_result x = if x=0 then 0 else if x < 0 then -1 else 1 in if x = y then 0 else let (e1,rest1) = extract_epoch x and (e2,rest2) = extract_epoch y in let e_comp = compare_chunks e1 e2 in if e_comp <> 0 then normalize_comp_result e_comp else let (u1,r1) = extract_revision rest1 and (u2,r2) = extract_revision rest2 in let u_comp = compare_chunks u1 u2 in if u_comp <> 0 then normalize_comp_result u_comp else normalize_comp_result (compare_chunks r1 r2) ;; let equal (x : string) (y : string) = if x = y then true else (compare x y) = 0 ;; opam-2.0.5/src/core/opamUrl.ml0000644000175000017500000001676013511367404015160 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamStd.Op type version_control = [ `git | `darcs | `hg ] type backend = [ `http | `rsync | version_control ] type t = { transport: string; path: string; hash: string option; backend: backend; } let empty = { backend = `http; transport = "https"; path = ""; hash = None; } let split_url = let re = Re.(compile @@ whole_string @@ seq [ (* Parse the scheme, which is either backend+protocol or just a protocol *) opt @@ seq [ (* Backend *) opt @@ seq [ group @@ rep @@ diff any (set "+:"); alt [ char '+'; str "://"] ]; (* Protocol *) group @@ rep @@ diff any (char ':'); (* Separator *) str "://" ]; (* Parse the path, with is either path or path.suffix (suffix contains no .) *) group @@ seq [ non_greedy @@ rep @@ diff any (char '#'); (* If there's a .suffix, group it separately (used for backend guessing) *) opt @@ seq [ char '.'; group @@ rep1 @@ diff any (set "\\/.#")] ]; (* Parse the fragment (git branch, etc.) *) opt @@ seq [ char '#'; group @@ rep any ]; ]) in fun u -> match Re.get_all (Re.exec re u) with | [| _; vc; transport; path; suffix; hash |] -> let opt = function "" -> None | s -> Some s in opt vc, opt transport, path, opt suffix, opt hash | _ -> assert false let vc_of_string = function | "git" -> `git | "hg" -> `hg | "darcs" -> `darcs | x -> failwith (Printf.sprintf "Unsupported version control system %S" x) let string_of_vc = function | `git -> "git" | `darcs -> "darcs" | `hg -> "hg" let string_of_backend = function | `http -> "http" | `rsync -> "rsync" | #version_control as vc -> string_of_vc vc let backend_of_string = function | "http" | "https" | "ftp" | "wget" | "curl" -> `http | "file" -> `rsync | "git" -> `git | "darcs" -> `darcs | "hg" -> `hg | "path" | "local" | "rsync" | "ssh" | "scp" | "sftp" -> `rsync | p -> failwith (Printf.sprintf "Unsupported protocol %S" p) let looks_like_ssh_path = (* ':' before any '/' : assume ssh, like git does. Exception for 'x:' with single char, because Windows *) let re = Re.(compile @@ seq [ group @@ repn (diff any (set "/:")) 2 None; char ':'; opt @@ char '/'; opt @@ group @@ seq [ alt [ diff any digit; seq [rep digit; compl [digit; char '/']] ]; rep any; ]; eos; ]) in fun path -> try let sub = Re.exec re path in Some (Re.get sub 1 ^ try "/" ^ Re.get sub 2 with Not_found -> "") with Not_found -> None let parse ?backend ?(handle_suffix=true) s = let vc, transport, path, suffix, hash = split_url s in let backend = match backend with | Some b -> b | None -> match vc with | Some vc -> vc_of_string vc | None -> let of_suffix ~default = if not handle_suffix then default else match suffix with | Some sf -> (try vc_of_string sf with Failure _ -> default) | None -> match OpamStd.String.cut_at path '@' with | Some (user, _) -> (try vc_of_string user with Failure _ -> default) | None -> default in match transport with | None -> of_suffix ~default:`rsync | Some tr -> try vc_of_string tr with Failure _ -> of_suffix ~default:(backend_of_string tr) in let transport, path = match backend, transport, looks_like_ssh_path path with | `http, None, _ -> "http", path | _, (None | Some ("git"|"hg"|"darcs")), Some path -> "ssh", path | _, (None | Some ("hg"|"darcs")), None -> "file", OpamSystem.real_path path |> OpamSystem.back_to_forward | _, Some tr, _ -> tr, path in { transport; path; hash; backend; } let of_string url = parse ~handle_suffix:false url let to_string url = let hash = match url.hash with Some h -> "#" ^ h | None -> "" in match url.backend with | #version_control as vc -> let vc = string_of_backend vc in if url.transport = vc then (* Don't be redundant on e.g git:// protocols *) Printf.sprintf "%s://%s%s" vc url.path hash else Printf.sprintf "%s+%s://%s%s" vc url.transport url.path hash | `rsync | `http -> Printf.sprintf "%s://%s%s" url.transport url.path hash let base_url url = match url.transport with | "" -> url.path | tr -> Printf.sprintf "%s://%s" tr url.path let local_path = function | { transport = ("file"|"path"|"local"|"rsync"); path; hash = _; backend = (#version_control | `rsync); } when looks_like_ssh_path path = None -> Some path | _ -> None let local_dir url = let open OpamStd.Option.Op in local_path url >>| OpamFilename.Dir.of_string >>= fun d -> if OpamFilename.exists_dir d then Some d else None let local_file url = let open OpamStd.Option.Op in local_path url >>| OpamFilename.of_string >>= fun f -> if OpamFilename.exists f then Some f else None let guess_version_control s = let vc,transport,path,_,_ = split_url s in if vc = None && transport = None && looks_like_ssh_path path = None then let open OpamFilename in let open Op in let dir = Dir.of_string path in if exists_dir (dir / ".git") || exists (dir // ".git") then Some`git else if exists_dir (dir / ".hg") then Some `hg else if exists_dir (dir / "_darcs") then Some `darcs else None else None let basename = let re = Re.(compile @@ seq [ opt @@ seq [rep any; char '/']; group @@ rep1 (diff any (char '/')); rep @@ char '/'; ]) in fun t -> try Re.get (Re.exec re t.path) 1 with Not_found -> "" let root = let re = Re.(compile @@ seq [char '/'; rep any]) in fun t -> let path = (* The special-casing of "file" is needed for Windows *) if t.transport = "file" then "" else Re.replace_string re ~by:"" t.path in { t with path} let has_trailing_slash url = OpamStd.String.ends_with ~suffix:"/" url.path let to_json url = `String (to_string url) type url = t module O = struct type t = url let to_string = to_string let to_json = to_json let compare = compare end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) module Op = struct (** appending to an url path *) let ( / ) url dir = let url = if Filename.is_relative dir then url else root url in (* Even on Windows, a file:// _should_ use slash *) let dir = OpamSystem.back_to_forward dir in let path = if has_trailing_slash url || url.path = "" then url.path ^ dir else url.path ^ "/" ^ dir in {url with path } end opam-2.0.5/src/core/opamCoreConfig.ml.in0000644000175000017500000000575013511367404017036 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat type t = { debug_level: int; verbose_level: int; color: [ `Always | `Never | `Auto ]; utf8: [ `Extended | `Always | `Never | `Auto ]; disp_status_line: [ `Always | `Never | `Auto ]; answer: bool option; safe_mode: bool; log_dir: string; keep_log_dir: bool; errlog_length: int; merged_output: bool; use_openssl: bool; precise_tracking: bool; } type 'a options_fun = ?debug_level:int -> ?verbose_level:int -> ?color:[ `Always | `Never | `Auto ] -> ?utf8:[ `Extended | `Always | `Never | `Auto ] -> ?disp_status_line:[ `Always | `Never | `Auto ] -> ?answer:bool option -> ?safe_mode:bool -> ?log_dir:string -> ?keep_log_dir:bool -> ?errlog_length:int -> ?merged_output:bool -> ?use_openssl:bool -> ?precise_tracking:bool -> 'a let default = { debug_level = 0; verbose_level = 0; color = `Auto; utf8 = `Auto; disp_status_line = `Auto; answer = None; safe_mode = false; log_dir = (let user = try Unix.getlogin() with Unix.Unix_error _ -> "xxx" in let base = Printf.sprintf "opam-%s-%d" user (OpamStubs.getpid()) in Filename.(concat (get_temp_dir_name ()) base)); keep_log_dir = false; errlog_length = 12; merged_output = true; use_openssl = true; precise_tracking = false; } let setk k t ?debug_level ?verbose_level ?color ?utf8 ?disp_status_line ?answer ?safe_mode ?log_dir ?keep_log_dir ?errlog_length ?merged_output ?use_openssl ?precise_tracking = let (+) x opt = match opt with Some x -> x | None -> x in k { debug_level = t.debug_level + debug_level; verbose_level = t.verbose_level + verbose_level; color = t.color + color; utf8 = t.utf8 + utf8; disp_status_line = t.disp_status_line + disp_status_line; answer = t.answer + answer; safe_mode = t.safe_mode + safe_mode; log_dir = t.log_dir + log_dir; keep_log_dir = t.keep_log_dir + keep_log_dir; errlog_length = t.errlog_length + errlog_length; merged_output = t.merged_output + merged_output; use_openssl = t.use_openssl + use_openssl; precise_tracking = t.precise_tracking + precise_tracking; } let set t = setk (fun x () -> x) t (* Global configuration reference *) let r = ref default let update ?noop:_ = setk (fun cfg () -> r := cfg) !r let developer = @DEVELOPER@ opam-2.0.5/src/core/opamProcess.ml0000644000175000017500000005030613511367404016026 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) let log ?level fmt = OpamConsole.log "PROC" ?level fmt (** Shell commands *) type command = { cmd: string; args: string list; cmd_text: string option; cmd_dir: string option; cmd_env: string array option; cmd_stdin: bool option; cmd_stdout: string option; cmd_verbose: bool option; cmd_name: string option; cmd_metadata: (string * string) list option; } let string_of_command c = String.concat " " (c.cmd::c.args) let text_of_command c = c.cmd_text let default_verbose () = OpamCoreConfig.(!r.verbose_level) >= 2 let is_verbose_command c = OpamStd.Option.default (default_verbose ()) c.cmd_verbose let make_command_text ?(color=`green) str ?(args=[]) cmd = let summary = match List.filter (fun s -> String.length s > 0 && s.[0] <> '-' && not (String.contains s '/') && not (String.contains s '=')) args with | hd::_ -> String.concat " " [cmd; hd] | [] -> cmd in Printf.sprintf "[%s: %s]" (OpamConsole.colorise color str) summary let command ?env ?verbose ?name ?metadata ?dir ?allow_stdin ?stdout ?text cmd args = { cmd; args; cmd_env=env; cmd_verbose=verbose; cmd_name=name; cmd_metadata=metadata; cmd_dir=dir; cmd_stdin=allow_stdin; cmd_stdout=stdout; cmd_text=text; } (** Running processes *) type t = { p_name : string; p_args : string list; p_pid : int; p_cwd : string; p_time : float; p_stdout : string option; p_stderr : string option; p_env : string option; p_info : string option; p_metadata: (string * string) list; p_verbose: bool; p_tmp_files: string list; } let open_flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND] let output_lines oc lines = List.iter (fun line -> output_string oc line; output_string oc "\n"; flush oc; ) lines; output_string oc "\n"; flush oc let option_map fn = function | None -> None | Some o -> Some (fn o) let option_default d = function | None -> d | Some v -> v let make_info ?code ?signal ~cmd ~args ~cwd ~env_file ~stdout_file ~stderr_file ~metadata () = let b = ref [] in let home = OpamStd.Sys.home () in let print name str = let str = if OpamStd.String.starts_with ~prefix:home str then "~"^OpamStd.String.remove_prefix ~prefix:home str else str in b := (name, str) :: !b in let print_opt name = function | None -> () | Some s -> print name s in List.iter (fun (k,v) -> print k v) metadata; print "path" cwd; print "command" (String.concat " " (cmd :: args)); print_opt "exit-code" (option_map string_of_int code); print_opt "signalled" (option_map string_of_int signal); print_opt "env-file" env_file; if stderr_file = stdout_file then print_opt "output-file" stdout_file else ( print_opt "stdout-file" stdout_file; print_opt "stderr-file" stderr_file; ); List.rev !b let string_of_info ?(color=`yellow) info = let b = Buffer.create 1024 in List.iter (fun (k,v) -> Printf.bprintf b "%s %-20s %s\n" (OpamConsole.colorise color "#") (OpamConsole.colorise color k) v) info; Buffer.contents b (** [create cmd args] create a new process to execute the command [cmd] with arguments [args]. If [stdout_file] or [stderr_file] are set, the channels are redirected to the corresponding files. The outputs are discarded is [verbose] is set to false. The current environment can also be overridden if [env] is set. The environment which is used to run the process is recorded into [env_file] (if set). *) let create ?info_file ?env_file ?(allow_stdin=true) ?stdout_file ?stderr_file ?env ?(metadata=[]) ?dir ~verbose ~tmp_files cmd args = let nothing () = () in let tee f = let fd = Unix.openfile f open_flags 0o644 in let close_fd () = Unix.close fd in fd, close_fd in let oldcwd = Sys.getcwd () in let cwd = OpamStd.Option.default oldcwd dir in OpamStd.Option.iter Unix.chdir dir; let stdin_fd,close_stdin = if allow_stdin then Unix.stdin, nothing else let fd,outfd = Unix.pipe () in let close_stdin () = Unix.close fd in Unix.close outfd; fd, close_stdin in let stdout_fd, close_stdout = match stdout_file with | None -> Unix.stdout, nothing | Some f -> tee f in let stderr_fd, close_stderr = match stderr_file with | None -> Unix.stderr, nothing | Some f -> if stdout_file = Some f then stdout_fd, nothing else tee f in let env = match env with | None -> Unix.environment () | Some e -> e in let time = Unix.gettimeofday () in let () = (* write the env file before running the command*) match env_file with | None -> () | Some f -> let chan = open_out f in let env = Array.to_list env in (* Remove dubious variables *) let env = List.filter (fun line -> not (OpamStd.String.contains_char line '$')) env in output_lines chan env; close_out chan in let () = (* write the info file *) match info_file with | None -> () | Some f -> let chan = open_out f in let info = make_info ~cmd ~args ~cwd ~env_file ~stdout_file ~stderr_file ~metadata () in output_string chan (string_of_info info); close_out chan in let pid = try Unix.create_process_env cmd (Array.of_list (cmd :: args)) env stdin_fd stdout_fd stderr_fd with e -> close_stdin (); close_stdout (); close_stderr (); raise e in close_stdin (); close_stdout (); close_stderr (); Unix.chdir oldcwd; { p_name = cmd; p_args = args; p_pid = pid; p_cwd = cwd; p_time = time; p_stdout = stdout_file; p_stderr = stderr_file; p_env = env_file; p_info = info_file; p_metadata = metadata; p_verbose = verbose; p_tmp_files = tmp_files; } type result = { r_code : int; r_signal : int option; r_duration : float; r_info : (string * string) list; r_stdout : string list; r_stderr : string list; r_cleanup : string list; } (* XXX: the function might block for ever for some channels kinds *) let read_lines f = try let ic = open_in f in let lines = ref [] in begin try while true do let line = input_line ic in lines := line :: !lines; done with End_of_file | Sys_error _ -> () end; close_in ic; List.rev !lines with Sys_error _ -> [] (* Compat function (Windows) *) let interrupt p = if Sys.win32 then Unix.kill p.p_pid Sys.sigkill else Unix.kill p.p_pid Sys.sigint let run_background command = let { cmd; args; cmd_env=env; cmd_verbose=_; cmd_name=name; cmd_text=_; cmd_metadata=metadata; cmd_dir=dir; cmd_stdin=allow_stdin; cmd_stdout } = command in let verbose = is_verbose_command command in let allow_stdin = OpamStd.Option.default false allow_stdin in let env = match env with Some e -> e | None -> Unix.environment () in let file ext = match name with | None -> None | Some n -> let d = if Filename.is_relative n then match dir with | Some d -> d | None -> OpamCoreConfig.(!r.log_dir) else "" in Some (Filename.concat d (Printf.sprintf "%s.%s" n ext)) in let stdout_file = OpamStd.Option.Op.(cmd_stdout >>+ fun () -> file "out") in let stderr_file = if OpamCoreConfig.(!r.merged_output) then file "out" else file "err" in let env_file = file "env" in let info_file = file "info" in let tmp_files = OpamStd.List.filter_some [ info_file; env_file; stderr_file; if cmd_stdout <> None || stderr_file = stdout_file then None else stdout_file; ] in create ~env ?info_file ?env_file ?stdout_file ?stderr_file ~verbose ?metadata ~allow_stdin ?dir ~tmp_files cmd args let dry_run_background c = { p_name = c.cmd; p_args = c.args; p_pid = -1; p_cwd = OpamStd.Option.default (Sys.getcwd ()) c.cmd_dir; p_time = Unix.gettimeofday (); p_stdout = None; p_stderr = None; p_env = None; p_info = None; p_metadata = OpamStd.Option.default [] c.cmd_metadata; p_verbose = is_verbose_command c; p_tmp_files = []; } let verbose_print_cmd p = OpamConsole.msg "%s %s %s%s\n" (OpamConsole.colorise `yellow "+") p.p_name (OpamStd.List.concat_map " " (Printf.sprintf "%S") p.p_args) (if p.p_cwd = Sys.getcwd () then "" else Printf.sprintf " (CWD=%s)" p.p_cwd) let verbose_print_out = let pfx = OpamConsole.colorise `yellow "- " in fun s -> OpamConsole.msg "%s%s\n" pfx s (** Semi-synchronous printing of the output of a command *) let set_verbose_f, print_verbose_f, isset_verbose_f, stop_verbose_f = let verbose_f = ref None in let stop () = match !verbose_f with | None -> () | Some (ics,_) -> List.iter close_in_noerr ics; verbose_f := None in let set files = stop (); (* implem relies on sigalrm, not implemented on win32. This will fall back to buffered output. *) if Sys.win32 then () else let files = OpamStd.List.sort_nodup compare files in let ics = List.map (open_in_gen [Open_nonblock;Open_rdonly;Open_text;Open_creat] 0o600) files in let f () = List.iter (fun ic -> try while true do verbose_print_out (input_line ic) done with End_of_file -> flush stdout ) ics in verbose_f := Some (ics, f) in let print () = match !verbose_f with | Some (_, f) -> f () | None -> () in let isset () = !verbose_f <> None in let flush_and_stop () = print (); stop () in set, print, isset, flush_and_stop let set_verbose_process p = if p.p_verbose then let fs = OpamStd.List.filter_some [p.p_stdout;p.p_stderr] in if fs <> [] then ( verbose_print_cmd p; set_verbose_f fs ) let exit_status p return = let duration = Unix.gettimeofday () -. p.p_time in let stdout = option_default [] (option_map read_lines p.p_stdout) in let stderr = option_default [] (option_map read_lines p.p_stderr) in let cleanup = p.p_tmp_files in let code,signal = match return with | Unix.WEXITED r -> Some r, None | Unix.WSIGNALED s | Unix.WSTOPPED s -> None, Some s in if isset_verbose_f () then stop_verbose_f () else if p.p_verbose then (verbose_print_cmd p; List.iter verbose_print_out stdout; List.iter verbose_print_out stderr; flush Pervasives.stdout); let info = make_info ?code ?signal ~cmd:p.p_name ~args:p.p_args ~cwd:p.p_cwd ~metadata:p.p_metadata ~env_file:p.p_env ~stdout_file:p.p_stdout ~stderr_file:p.p_stderr () in { r_code = OpamStd.Option.default 256 code; r_signal = signal; r_duration = duration; r_info = info; r_stdout = stdout; r_stderr = stderr; r_cleanup = cleanup; } let safe_wait fallback_pid f x = let sh = if isset_verbose_f () then let hndl _ = print_verbose_f () in Some (Sys.signal Sys.sigalrm (Sys.Signal_handle hndl)) else None in let cleanup () = match sh with | Some sh -> ignore (Unix.alarm 0); (* cancels the alarm *) Sys.set_signal Sys.sigalrm sh | None -> () in let rec aux () = if sh <> None then ignore (Unix.alarm 1); match try f x with | Unix.Unix_error (Unix.EINTR,_,_) -> aux () (* handled signal *) | Unix.Unix_error (Unix.ECHILD,_,_) -> log "Warn: no child to wait for %d" fallback_pid; fallback_pid, Unix.WEXITED 256 with | _, Unix.WSTOPPED _ -> (* shouldn't happen as we don't use WUNTRACED *) aux () | r -> r in try let r = aux () in cleanup (); r with e -> cleanup (); raise e let wait p = set_verbose_process p; let _, return = safe_wait p.p_pid (Unix.waitpid []) p.p_pid in exit_status p return let dontwait p = match safe_wait p.p_pid (Unix.waitpid [Unix.WNOHANG]) p.p_pid with | 0, _ -> None | _, return -> Some (exit_status p return) let dead_childs = Hashtbl.create 13 let wait_one processes = if processes = [] then raise (Invalid_argument "wait_one"); try let p = List.find (fun p -> Hashtbl.mem dead_childs p.p_pid) processes in let return = Hashtbl.find dead_childs p.p_pid in Hashtbl.remove dead_childs p.p_pid; p, exit_status p return with Not_found -> let rec aux () = let pid, return = if Sys.win32 then (* No Unix.wait on Windows, so use a stub wrapping WaitForMultipleObjects *) let pids, len = let f (l, n) t = (t.p_pid::l, succ n) in List.fold_left f ([], 0) processes in OpamStubs.waitpids pids len else safe_wait (List.hd processes).p_pid Unix.wait () in try let p = List.find (fun p -> p.p_pid = pid) processes in p, exit_status p return with Not_found -> Hashtbl.add dead_childs pid return; aux () in aux () let dry_wait_one = function | {p_pid = -1; _} as p :: _ -> if p.p_verbose then (verbose_print_cmd p; flush stdout); p, { r_code = 0; r_signal = None; r_duration = 0.; r_info = []; r_stdout = []; r_stderr = []; r_cleanup = []; } | _ -> raise (Invalid_argument "dry_wait_one") let run command = let command = { command with cmd_stdin = OpamStd.Option.Op.(command.cmd_stdin ++ Some true) } in let p = run_background command in try wait p with e -> match (try dontwait p with _ -> raise e) with | None -> (* still running *) (try interrupt p with Unix.Unix_error _ -> ()); raise e | _ -> raise e let is_failure r = r.r_code <> 0 || r.r_signal <> None let is_success r = not (is_failure r) let safe_unlink f = try log ~level:2 "safe_unlink: %s" f; Unix.unlink f with Unix.Unix_error _ -> log ~level:2 "safe_unlink: %s (FAILED)" f let cleanup ?(force=false) r = if force || (not (OpamConsole.debug ()) && is_success r) then List.iter safe_unlink r.r_cleanup let check_success_and_cleanup r = List.iter safe_unlink r.r_cleanup; is_success r let log_line_limit = 5 * 80 let truncate_str = "[...]" (* Truncate long lines *) let truncate_line str = if String.length str <= log_line_limit then str else String.sub str 0 (log_line_limit - String.length truncate_str) ^ truncate_str (* Take the last [n] elements of [l] (trying to keep an unindented header line for context, like diff) *) let truncate l = let unindented s = String.length s > 0 && s.[0] <> ' ' && s.[0] <> '\t' in let rec cut n acc = function | [] -> acc | [x] when n = 0 -> truncate_line x :: acc | _ when n = 0 -> truncate_str :: acc | x::l when n = 1 -> (if unindented x then truncate_str :: truncate_line x :: acc else try truncate_line (List.find unindented l) :: truncate_str :: acc with Not_found -> truncate_str :: truncate_line x :: acc) | x::r -> cut (n-1) (truncate_line x :: acc) r in let len = OpamCoreConfig.(!r.errlog_length) in if len <= 0 then l else cut len [] (List.rev l) let string_of_result ?(color=`yellow) r = let b = Buffer.create 2048 in let print = Buffer.add_string b in let println str = print str; Buffer.add_char b '\n' in print (string_of_info ~color r.r_info); if r.r_stdout <> [] then if r.r_stderr = r.r_stdout then print (OpamConsole.colorise color "### output ###\n") else print (OpamConsole.colorise color "### stdout ###\n"); List.iter (fun s -> print (OpamConsole.colorise color "# "); println s) (truncate r.r_stdout); if r.r_stderr <> [] && r.r_stderr <> r.r_stdout then ( print (OpamConsole.colorise color "### stderr ###\n"); List.iter (fun s -> print (OpamConsole.colorise color "# "); println s) (truncate r.r_stderr) ); Buffer.contents b let result_summary r = Printf.sprintf "%S exited with code %d%s" (try List.assoc "command" r.r_info with Not_found -> "command") r.r_code (if r.r_code = 0 then "" else match r.r_stderr, r.r_stdout with | [e], _ | [], [e] -> Printf.sprintf " \"%s\"" e | [], es | es, _ -> try Printf.sprintf " \"%s\"" (List.find Re.(execp (compile (seq [ bos; rep (diff any alpha); no_case (str "error") ]))) (List.rev es)) with Not_found -> "" | _ -> "") (* Higher-level interface to allow parallelism *) module Job = struct module Op = struct type 'a job = (* Open the variant type *) | Done of 'a | Run of command * (result -> 'a job) (* Parallelise shell commands *) let (@@>) command f = Run (command, f) (* Sequentialise jobs *) let rec (@@+) job1 fjob2 = match job1 with | Done x -> fjob2 x | Run (cmd,cont) -> Run (cmd, fun r -> cont r @@+ fjob2) let (@@|) job f = job @@+ fun x -> Done (f x) end open Op let run = let rec aux = function | Done x -> x | Run (cmd,cont) -> OpamStd.Option.iter (if OpamConsole.disp_status_line () then OpamConsole.status_line "Processing: %s" else OpamConsole.msg "%s\n") (text_of_command cmd); let r = run cmd in let k = try cont r with e -> cleanup r; OpamConsole.clear_status (); raise e in cleanup r; OpamConsole.clear_status (); aux k in aux let rec dry_run = function | Done x -> x | Run (_command,cont) -> let result = { r_code = 0; r_signal = None; r_duration = 0.; r_info = []; r_stdout = []; r_stderr = []; r_cleanup = []; } in dry_run (cont result) let rec catch handler fjob = try match fjob () with | Done x -> Done x | Run (cmd,cont) -> Run (cmd, fun r -> catch handler (fun () -> cont r)) with e -> handler e let ignore_errors ~default ?message job = catch (fun e -> OpamStd.Exn.fatal e; OpamStd.Option.iter (OpamConsole.error "%s") message; Done default) job let rec finally fin fjob = try match fjob () with | Done x -> fin (); Done x | Run (cmd,cont) -> Run (cmd, fun r -> finally fin (fun () -> cont r)) with e -> fin (); raise e let of_list ?(keep_going=false) l = let rec aux err = function | [] -> Done err | cmd::commands -> let cont = fun r -> if is_success r then aux err commands else if keep_going then aux OpamStd.Option.Op.(err ++ Some (cmd,r)) commands else Done (Some (cmd,r)) in Run (cmd,cont) in aux None l let of_fun_list ?(keep_going=false) l = let rec aux err = function | [] -> Done err | cmdf::commands -> let cmd = cmdf () in let cont = fun r -> if is_success r then aux err commands else if keep_going then aux OpamStd.Option.Op.(err ++ Some (cmd,r)) commands else Done (Some (cmd,r)) in Run (cmd,cont) in aux None l let seq job start = List.fold_left (@@+) (Done start) job let seq_map f l = List.fold_left (fun job x -> job @@+ fun acc -> f x @@| fun y -> y :: acc) (Done []) l @@| List.rev let rec with_text text = function | Done _ as j -> j | Run (cmd, cont) -> Run ({cmd with cmd_text = Some text}, fun r -> with_text text (cont r)) end type 'a job = 'a Job.Op.job opam-2.0.5/src/core/dune0000644000175000017500000000205513511367404014055 0ustar nicoonicoo(library (name opam_core) (public_name opam-core) (synopsis "OCaml Package Manager core internal stdlib") (libraries re ocamlgraph unix bigarray (select opamStubs.ml from (opam-core.stubs -> opamStubs.ml.win32) ( -> opamStubs.ml.dummy))) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (preprocess (per_module ((action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})) opamCompat))) (wrapped false)) (rule (targets opamVersion.ml) (deps (:input opamVersion.ml.in) (:script ../../shell/subst_var.ml) ../../config.status) (action (with-stdout-to %{targets} (run ocaml %{script} PACKAGE_VERSION "" %{input})))) (rule (targets opamCoreConfig.ml) (deps (:input opamCoreConfig.ml.in) (:script ../../shell/subst_var.ml) ../../config.status) (action (with-stdout-to %{targets} (run ocaml %{script} DEVELOPER false %{input})))) opam-2.0.5/src/core/opamSystem.mli0000644000175000017500000002541513511367404016050 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Bindings of lots of filesystem and system operations *) (** Exception raised when subprocess fails *) exception Process_error of OpamProcess.result exception Command_not_found of string (** raise [Process_error] *) val process_error: OpamProcess.result -> 'a (** raise [Process_error] if the process didn't return 0 *) val raise_on_process_error: OpamProcess.result -> unit (** Exception raised when a computation in the current process fails. *) exception Internal_error of string (** Raise [Internal_error] *) val internal_error: ('a, unit, string, 'b) format4 -> 'a (** [with_tmp_dir fn] executes [fn] in a tempory directory *) val with_tmp_dir: (string -> 'a) -> 'a (** Runs a job with a temp dir that is cleaned up afterwards *) val with_tmp_dir_job: (string -> 'a OpamProcess.job) -> 'a OpamProcess.job (** Returns true if the default verbose level for base commands (cp, mv, etc.) is reached *) val verbose_for_base_commands: unit -> bool (** Returns a directory name, in the temporary directory, composed by {i opam} (if [prefix] is not set), pid, and random number. *) val mk_temp_dir: ?prefix:string -> unit -> string (** [copy_file src dst] copies [src] to [dst]. Remove [dst] before the copy if it is a link. *) val copy_file: string -> string -> unit (** [copy_dir src dst] copies the contents of directory [src] into directory [dst], creating it if necessary, merging directory contents and ovewriting files otherwise *) val copy_dir: string -> string -> unit val mv: string -> string -> unit (** [install ?exec src dst] copies file [src] as file [dst] using [install]. If [exec], make the resulting file executable (otherwise, look at the permissions of the original file to decide). *) val install: ?exec:bool -> string -> string -> unit (** Checks if a file is an executable (regular file with execution permission) *) val is_exec: string -> bool val file_is_empty: string -> bool (** [link src dst] links [src] to [dst]. Remove [dst] if it is a file, not a directory. *) val link: string -> string -> unit (** [real_path p] returns the real path associated to [p]: [..] are expanded and relative paths become absolute. *) val real_path: string -> string (** Return the contents of a channel. *) val string_of_channel: in_channel -> string (** Raised when a file or directory can't be accessed (doesn't exist, bad permissions, etc.) *) exception File_not_found of string (** [read filename] returns the contents of [filename] (while taking an advisory read lock to prevent concurrent writes) *) val read: string -> string (** [write filename contents] write [contents] to [filename] (while taking an advisory write lock to prevent concurrent reads or writes) *) val write: string -> string -> unit (** [remove filename] removes [filename]. Works whether [filename] is a file or a directory *) val remove: string -> unit (** [remove_file filename] removes [filename]. Works only for normal files (or also at least for symlinks) *) val remove_file: string -> unit (** [remove_dir filename] removes [filename]. Works only for directory (not for symlinks or other files). *) val remove_dir: string -> unit (** Change the current working directory *) val chdir: string -> unit (** [in_dir dir fn] evaluates [fn] in the directory [dir] *) val in_dir: string -> (unit -> 'a) -> 'a (** Returns the list of files and directories in the given directory (full names) *) val ls: string -> string list (** [files_with_links dir] returns the files in the directory [dir]. Links simulating directory are ignored, others links are returned. *) val files_with_links: string -> string list (** [rec_files dir] returns the list of all files in [dir], recursively. Links behaving like directory are crossed. *) val rec_files: string -> string list (** Return the list of files in the current directory. *) val files: string -> string list (** [rec_dirs dir] return the list list of all directories recursively (going through symbolink links). *) val rec_dirs: string -> string list (** Return the list of directories in the current directory. *) val dirs: string -> string list val dir_is_empty: string -> bool (** [directories_with_links dir] returns the directories in the directory [dir]. Links pointing to directory are also returned. *) val directories_with_links: string -> string list (** Make a comman suitable for OpamProcess.Job. if [verbose], is set, command and output will be displayed (at command end for the latter, if concurrent commands are running). [name] is used for naming log files. [text] is what is displayed in the status line for this command. May raise Command_not_found, unless [resolve_path] is set to false (in which case you can end up with a process error instead) *) val make_command: ?verbose:bool -> ?env:string array -> ?name:string -> ?text:string -> ?metadata:(string * string) list -> ?allow_stdin:bool -> ?stdout:string -> ?dir:string -> ?resolve_path:bool -> string -> string list -> OpamProcess.command (** OLD COMMAND API, DEPRECATED *) (** a command is a list of words *) type command = string list (** Test whether a command exists in the environment, and returns it (resolved if found in PATH) *) val resolve_command: ?env:string array -> ?dir:string -> string -> string option (** [command cmd] executes the command [cmd] in the correct OPAM environment. *) val command: ?verbose:bool -> ?env:string array -> ?name:string -> ?metadata:(string * string) list -> ?allow_stdin:bool -> command -> unit (** [commands cmds] executes the commands [cmds] in the correct OPAM environment. It stops whenever one command fails unless [keep_going] is set to [true]. In this case, the first error is re-raised at the end. *) val commands: ?verbose:bool -> ?env:string array -> ?name:string -> ?metadata:(string * string) list -> ?keep_going:bool -> command list -> unit (** [read_command_output cmd] executes the command [cmd] in the correct OPAM environment and return the lines from stdout if the command exists normally. If the command does not exist or if the command exited with a non-empty exit-code, throw an error. *) val read_command_output: ?verbose:bool -> ?env:string array -> ?metadata:(string * string) list -> ?allow_stdin:bool -> command -> string list (** END *) (** Test whether the file is an archive, by looking as its extension *) val is_archive: string -> bool (** [extract ~dir:dirname filename] extracts the archive [filename] into [dirname]. [dirname] should not exists and [filename] should contain only one top-level directory.*) val extract: dir:string -> string -> unit (** Same as [extract], but as an OpamProcess.job *) val extract_job: dir:string -> string -> exn option OpamProcess.job (** [extract_in ~dir:dirname filename] extracts the archive [filename] into [dirname]. *) val extract_in: dir:string -> string -> unit (** [extract_in_job] is similar to [extract_in], but as a job *) val extract_in_job: dir:string -> string -> exn option OpamProcess.job (** Create a directory. Do not fail if the directory already exist. *) val mkdir: string -> unit (** Get the number of active processors on the system *) val cpu_count: unit -> int (** {2 File locking function} *) (** Unix file locks (mutable structure, to follow actual semantics) *) type lock (** The different kinds of unix advisory locks available (`Lock_none doesn't actually lock anything, or even create the lock file) *) type actual_lock_flag = [ `Lock_read | `Lock_write ] type lock_flag = [ `Lock_none | actual_lock_flag ] (** Dummy lock *) val lock_none: lock (** Raised when locks can't be acquired and [dontblock] was specified) *) exception Locked (** Force releases all open locks in the process. Required for Windows if an exception has been raised, since Windows doesn't permit unlinking while handles are open. *) val release_all_locks: unit -> unit (** Acquires a lock on the given file. Raises [Locked] if the lock can't be acquired and [dontblock] is set. Raises [OpamStd.Sys.Exit] if [safe_mode] is set and a write lock is required. Also raises Unix errors if the lock file can't be opened. *) val flock: [< lock_flag ] -> ?dontblock:bool -> string -> lock (** Updates an existing lock to the given level. Raises the same exceptions as [flock]. *) val flock_update: [< lock_flag ] -> ?dontblock:bool -> lock -> unit (** Releases an acquired lock (equivalent to [flock_update `Lock_none]) *) val funlock: lock -> unit (** Returns the highest of the two lock flags (with the order no lock < read lock < write lock) *) val lock_max: lock_flag -> lock_flag -> lock_flag (** Returns true if the lock already has the lock_flag rights or more *) val lock_isatleast: [< lock_flag ] -> lock -> bool (** Returns the current kind of the lock *) val get_lock_flag: lock -> lock_flag (** Returns the underlying fd for the lock or raises Not_found for `No_lock *) val get_lock_fd: lock -> Unix.file_descr (** {2 Misc} *) (** Apply a patch file in the current directory. If [preprocess] is set to false, there is no CRLF translation. Returns the error if the patch didn't apply. *) val patch: ?preprocess:bool -> dir:string -> string -> exn option OpamProcess.job (** Create a temporary file in {i ~/.opam/logs/XXX}, if [dir] is not set. ?auto_clean controls whether the file is automatically deleted when opam terminates (default: [true]). *) val temp_file: ?auto_clean:bool -> ?dir:string -> string -> string (** Print stats *) val print_stats: unit -> unit (** Registers an exception printer that adds some OPAM version info, and details on process and Unix errors *) val register_printer: unit -> unit (** Initialises signal handlers, catch_break and some exception printers. The lib may not perform properly without this if [Sys.catch_break] isn't set and SIGPIPE isn't handled (with a no-op) *) val init: unit -> unit (** On Unix, a no-op. On Windows, convert / to \ *) val forward_to_back : string -> string (** On Unix, a no-op. On Windows, convert \ to / *) val back_to_forward : string -> string opam-2.0.5/src/core/opamDirTrack.ml0000644000175000017500000002055213511367404016113 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat open OpamStd.Op open OpamProcess.Job.Op let log ?level fmt = OpamConsole.log ?level "TRACK" fmt let slog = OpamConsole.slog module SM = OpamStd.String.Map type digest = string let digest_of_string dg = dg let string_of_digest dg = dg type change = | Added of digest | Removed | Contents_changed of digest | Perm_changed of digest | Kind_changed of digest type t = change SM.t let string_of_change = function | Added _ -> "addition" | Removed -> "removal" | Contents_changed _ -> "modifications" | Perm_changed _ -> "permission change" | Kind_changed _ -> "kind change" let to_string t = OpamStd.Format.itemize (fun (f, change) -> Printf.sprintf "%s of %s" (String.capitalize_ascii (string_of_change change)) f) (SM.bindings t) (** uid, gid, perm *) type perms = int * int * int type item_value = | File of string | Dir | Link of string | Special of (int * int) type item = perms * item_value let cached_digest = let item_cache = Hashtbl.create 749 in fun f size mtime -> try let csize, cmtime, digest = Hashtbl.find item_cache f in if csize = size || mtime = cmtime then Digest.to_hex digest else raise Not_found with Not_found -> let digest = Digest.file f in Hashtbl.replace item_cache f (size, mtime, digest); Digest.to_hex digest let quick_digest _f size mtime = Printf.sprintf "S%dT%s" size (string_of_float mtime) let get_digest ?(precise=OpamCoreConfig.(!r.precise_tracking)) f size mtime = if precise then cached_digest f size mtime else quick_digest f size mtime let item_of_filename ?precise f : item = let stats = Unix.lstat f in Unix.(stats.st_uid, stats.st_gid, stats.st_perm), match stats.Unix.st_kind with | Unix.S_REG -> File (get_digest ?precise f stats.Unix.st_size stats.Unix.st_mtime) | Unix.S_DIR -> Dir | Unix.S_LNK -> Link (Unix.readlink f) | Unix.S_CHR | Unix.S_BLK | Unix.S_FIFO | Unix.S_SOCK -> Special Unix.(stats.st_dev, stats.st_rdev) let item_digest = function | _perms, File d -> "F:" ^ d | _perms, Dir -> "D" | _perms, Link l -> "L:" ^ l | _perms, Special (a,b) -> Printf.sprintf "S:%d:%d" a b let is_precise_digest d = not (OpamStd.String.starts_with ~prefix:"F:S" d) let track dir ?(except=OpamFilename.Base.Set.empty) job_f = let module SM = OpamStd.String.Map in let rec make_index acc prefix dir = let files = try Sys.readdir (Filename.concat prefix dir) with Sys_error _ as e -> log "Error at dir %s: %a" (Filename.concat prefix dir) (slog Printexc.to_string) e; [||] in Array.fold_left (fun acc f -> let rel = Filename.concat dir f in if OpamFilename.Base.(Set.mem (of_string rel) except) then acc else let f = Filename.concat prefix rel in try let item = item_of_filename f in let acc = SM.add rel item acc in match item with | _, Dir -> make_index acc prefix rel | _ -> acc with Unix.Unix_error _ as e -> log "Error at %s: %a" f (slog Printexc.to_string) e; acc) acc files in let str_dir = OpamFilename.Dir.to_string dir in let scan_timer = OpamConsole.timer () in let before = make_index SM.empty str_dir "" in log ~level:2 "before install: %a elements scanned in %.3fs" (slog @@ string_of_int @* SM.cardinal) before (scan_timer ()); job_f () @@| fun result -> let scan_timer = OpamConsole.timer () in let after = make_index SM.empty str_dir "" in let diff = SM.merge (fun _ before after -> match before, after with | None, None -> assert false | Some _, None -> Some Removed | None, Some item -> Some (Added (item_digest item)) | Some (perma, a), Some ((permb, b) as item) -> if a = b then if perma = permb then None else Some (Perm_changed (item_digest item)) else match a, b with | File _, File _ | Link _, Link _ | Dir, Dir | Special _, Special _ -> Some (Contents_changed (item_digest item)) | _ -> Some (Kind_changed (item_digest item))) before after in log "after install: %a elements, %a added, scanned in %.3fs" (slog @@ string_of_int @* SM.cardinal) after (slog @@ string_of_int @* SM.cardinal @* SM.filter (fun _ -> function Added _ -> true | _ -> false)) diff (scan_timer ()); result, diff let check_digest file digest = let precise = is_precise_digest digest in let it = item_of_filename ~precise file in try if item_digest it = digest then `Unchanged else `Changed with Unix.Unix_error _ -> `Removed let check prefix changes = let str_pfx = OpamFilename.Dir.to_string prefix in SM.fold (fun fname op acc -> let f = Filename.concat str_pfx fname in match op with | Added dg | Kind_changed dg | Contents_changed dg -> (OpamFilename.of_string f, check_digest f dg) :: acc | Perm_changed _ | Removed -> acc) changes [] |> List.rev let revert ?title ?(verbose=OpamConsole.verbose()) ?(force=false) ?(dryrun=false) prefix changes = let title = match title with | None -> "" | Some t -> t ^ ": " in let rmdir d = if not dryrun then OpamFilename.rmdir d in let rmfile f = if not dryrun then OpamFilename.remove f in let changes = (* Reverse the list so that dirnames come after the files they contain *) List.rev (OpamStd.String.Map.bindings changes) in let already, modified, nonempty, cannot = List.fold_left (fun (already,modified,nonempty,cannot as acc) (fname,op) -> let f = Filename.concat (OpamFilename.Dir.to_string prefix) fname in match op with | Added dg | Kind_changed dg -> let cur_item_ct, cur_dg = try let precise = is_precise_digest dg in let item = item_of_filename ~precise f in Some (snd item), Some (item_digest item) with Unix.Unix_error _ -> None, None in if cur_dg = None then (fname::already, modified, nonempty, cannot) else if cur_dg <> Some dg && not force then (already, fname::modified, nonempty, cannot) else if cur_item_ct = Some Dir then let d = OpamFilename.Dir.of_string f in if OpamFilename.dir_is_empty d then (rmdir d; acc) else let nonempty = if List.exists (OpamStd.String.starts_with ~prefix:fname) nonempty then nonempty else fname::nonempty in (already, modified, nonempty, cannot) else let f = OpamFilename.of_string f in rmfile f; acc | Contents_changed dg -> if check_digest f dg = `Changed then (already, modified, nonempty, (op,fname)::cannot) else acc (* File has changed, assume the removal script reverted it *) | (Removed | Perm_changed _) -> (already, modified, nonempty, (op,fname)::cannot)) ([], [], [], []) changes in if already <> [] then log ~level:2 "%sfiles %s were already removed" title (String.concat ", " (List.rev already)); if modified <> [] && verbose then OpamConsole.warning "%snot removing files that changed since:\n%s" title (OpamStd.Format.itemize (fun s -> s) (List.rev modified)); if nonempty <> [] && verbose then OpamConsole.note "%snot removing non-empty directories:\n%s" title (OpamStd.Format.itemize (fun s -> s) (List.rev nonempty)); if cannot <> [] && verbose then OpamConsole.warning "%scannot revert:\n%s" title (OpamStd.Format.itemize (fun (op,f) -> string_of_change op ^" of "^ f) (List.rev cannot)) opam-2.0.5/src/core/opamHash.ml0000644000175000017500000000707413511367404015277 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat type kind = [ `MD5 | `SHA256 | `SHA512 ] let default_kind = `MD5 type t = kind * string let kind = fst let contents = snd let log msg = OpamConsole.log "HASH" msg let pfx_sep_char = '=' let pfx_sep_str = String.make 1 pfx_sep_char let string_of_kind = function | `MD5 -> "md5" | `SHA256 -> "sha256" | `SHA512 -> "sha512" let kind_of_string s = match String.lowercase_ascii s with | "md5" -> `MD5 | "sha256" -> `SHA256 | "sha512" -> `SHA512 | _ -> invalid_arg "OpamHash.kind_of_string" let is_hex_str len s = String.length s = len && try String.iter (function | '0'..'9' | 'A'..'F' | 'a'..'f' -> () | _ -> raise Exit) s; true with Exit -> false let len = function | `MD5 -> 32 | `SHA256 -> 64 | `SHA512 -> 128 let valid kind = is_hex_str (len kind) let make kind s = if valid kind s then kind, String.lowercase_ascii s else invalid_arg ("OpamHash.make_"^string_of_kind kind) let md5 = make `MD5 let sha256 = make `SHA256 let sha512 = make `SHA512 let of_string_opt s = try let kind, s = match OpamStd.String.cut_at s pfx_sep_char with | None -> `MD5, s | Some (skind, s) -> kind_of_string skind, s in if valid kind s then Some (kind, String.lowercase_ascii s) else None with Invalid_argument _ -> None let of_string s = match of_string_opt s with | Some h -> h | None -> invalid_arg "OpamHash.of_string" let to_string (kind,s) = String.concat pfx_sep_str [string_of_kind kind; s] let to_json s = `String (to_string s) let to_path (kind,s) = [string_of_kind kind; String.sub s 0 2; s] let compute ?(kind=default_kind) file = match kind with | `MD5 -> md5 (Digest.to_hex (Digest.file file)) | (`SHA256 | `SHA512) as kind -> let sha = if not OpamCoreConfig.(!r.use_openssl) then OpamSHA.hash kind file else try match OpamSystem.read_command_output ["openssl"; string_of_kind kind; file] with | [l] -> let len = len kind in String.sub l (String.length l - len) len | _ -> log "openssl error, use internal sha library"; OpamSHA.hash kind file with OpamSystem.Command_not_found _ | OpamSystem.Process_error _ -> log "openssl not found, use internal sha library"; OpamSHA.hash kind file in make kind sha let compute_from_string ?(kind=default_kind) str = match kind with | `MD5 -> md5 (Digest.to_hex (Digest.string str)) | (`SHA256 | `SHA512) as kind -> make kind (OpamSHA.hash_bytes kind (Bytes.of_string str)) let check_file f (kind, _ as h) = compute ~kind f = h let mismatch f (kind, _ as h) = let hf = compute ~kind f in if hf = h then None else Some hf module O = struct type _t = t type t = _t let to_string = to_string let to_json = to_json let compare = compare end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) opam-2.0.5/src/core/opamVersionCompare.mli0000644000175000017500000000416113511367404017513 0ustar nicoonicoo(******************************************************************************) (* This file is part of the Dose library http://www.irill.org/software/dose *) (* *) (* Copyright (C) 2009-2011 Pietro Abate *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (* Work developed with the support of the Mancoosi Project *) (* http://www.mancoosi.org *) (* *) (******************************************************************************) (** Version comparison function used throughout. From the Dose suite. *) (** Functions for manipulating and comparing Debian version strings. Compliant with Debian policy version 3.9.2. and Debian developers reference version 3.4.6 *) (** {2 Comparing debian version strings} *) (** The following functions compare any two strings, that is these functions do not check whether the arguments are really legal debian versions. If the arguments are debian version strings, then the result is as required by debian policy. Note that two strings may be equivalent, that is denote the same debian version, even when they differ in syntax, as for instance "0:1.2.00" and "1.02-0". *) (** @return [true] iff the two strings define the same version. Hence, the result may be true even when the two string differ syntactically. *) val equal : string -> string -> bool (** [compare x y] returns 0 if x is eqivalent to y, -1 if x is smaller than y, and 1 if x is greater than y. This is consistent with [Pervasives.compare]. *) val compare : string -> string -> int opam-2.0.5/src/core/opamSHA.mli0000644000175000017500000000230113511367404015164 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Pure OCaml implementation of SHA256/512 hashing functions. The hash is returned as an hex string. *) val sha256_file: string -> string val sha512_file: string -> string val hash_file: [< `SHA256 | `SHA512 ] -> string -> string val sha256_bytes: Bytes.t -> string val sha512_bytes: Bytes.t -> string val hash_bytes: [< `SHA256 | `SHA512 ] -> Bytes.t -> string (** For compat, use the above *) val sha256: string -> string val sha512: string -> string val hash: [< `SHA256 | `SHA512 ] -> string -> string opam-2.0.5/src/core/opamVersion.mli0000644000175000017500000000272413511367404016207 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** (generated) Current OPAM version *) include OpamStd.ABSTRACT (** The current OPAM version *) val current: t (** Extracts the major version *) val major: t -> t (** Major+minor version, strips the patch version *) val nopatch: t -> t (** The current OPAM version, truncated (only MAJOR.MINOR) *) val current_nopatch: t (** The 'git' version of OPAM *) val git: unit -> t option (** Side-effect to set the git version later in the build *) val set_git: string -> unit (** The full version (current + git) *) val full: unit -> t (** Magic string, always of length 8 *) val magic: unit -> string (** Display the version message *) val message: unit -> unit (** Version comparison *) val compare: t -> t -> int opam-2.0.5/src/core/opamFilename.mli0000644000175000017500000002272113511367404016301 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Higher level file and directory name manipulation AND file operations, wrappers on OpamSystem using the filename type *) (** Basenames *) module Base: sig include OpamStd.ABSTRACT (** Check whether a basename has a given suffix *) val check_suffix: t -> string -> bool (** Add a file extension *) val add_extension: t -> string -> t end (** Directory names *) module Dir: OpamStd.ABSTRACT (** Return the current working directory *) val cwd: unit -> Dir.t (** Remove a directory *) val rmdir: Dir.t -> unit (** Cleans the contents of a directory, but keeps the directory in place. *) val cleandir: Dir.t -> unit (** Removes an empty directory, as well as any empty leading path components *) val rmdir_cleanup: Dir.t -> unit (** Create a directory *) val mkdir: Dir.t -> unit (** List the sub-directory recursively *) val rec_dirs: Dir.t -> Dir.t list val dir_is_empty: Dir.t -> bool (** List the sub-directory (do not recurse) *) val dirs: Dir.t -> Dir.t list (** Evaluate a function in a given directory *) val in_dir: Dir.t -> (unit -> 'a) -> 'a (** Turns an assoc list into an array suitable to be provided as environment *) val env_of_list: (string * string) list -> string array (** Execute a list of commands in a given directory *) val exec: Dir.t -> ?env:(string * string) list -> ?name:string -> ?metadata:(string * string) list -> ?keep_going:bool -> string list list -> unit (** Move a directory *) val move_dir: src:Dir.t -> dst:Dir.t -> unit (** Copy directory [src] to [dst], that is, recursively copy the contents of [src] into [dst], overwriting any existing files. *) val copy_dir: src:Dir.t -> dst:Dir.t -> unit (** Link a directory *) val link_dir: target:Dir.t -> link:Dir.t -> unit (** Does the directory exist? *) val exists_dir: Dir.t -> bool (** Returns the argument as option, if the directory exists *) val opt_dir: Dir.t -> Dir.t option (** Return the parent directory *) val dirname_dir: Dir.t -> Dir.t (** Return the deeper directory name *) val basename_dir: Dir.t -> Base.t (** Turn a full path into a list of directory names *) val to_list_dir: Dir.t -> Dir.t list (** Creation from a raw string, without resolving symlinks etc. *) val raw_dir: string -> Dir.t (** Execute a function in a temp directory *) val with_tmp_dir: (Dir.t -> 'a) -> 'a (** Provide an automatically cleaned up temp directory to a job *) val with_tmp_dir_job: (Dir.t -> 'a OpamProcess.job) -> 'a OpamProcess.job (** Create a new Dir.t and resolve symlinks *) val concat_and_resolve: Dir.t -> string -> Dir.t include OpamStd.ABSTRACT (** Generic filename *) type generic_file = | D of Dir.t | F of t (** Create a filename from a Dir.t and a basename *) val create: Dir.t -> Base.t -> t (** Create a file from a basename and the current working directory as dirname *) val of_basename: Base.t -> t (** Creation from a raw string, without resolving symlinks, etc. *) val raw: string -> t (** Prettify a filename: - replace /path/to/opam/foo by /foo - replace /path/to/home/foo by ~/foo *) val prettify: t -> string (** Prettify a dirname. *) val prettify_dir: Dir.t -> string (** Return the directory name *) val dirname: t -> Dir.t (** Return the base name *) val basename: t -> Base.t (** Retrieves the contents from the hard disk. *) val read: t -> string (** Open a channel from a given file. *) val open_in: t -> in_channel val open_out: t -> out_channel (** Removes everything in [filename] if existed. *) val remove: t -> unit (** Removes everything in [filename] if existed, then write [contents] instead. *) val write: t -> string -> unit (** Returns true if the file exists and is a regular file or a symlink to one *) val exists: t -> bool (** Returns the argument as option if it exists and is either a regular file or a symlink to one *) val opt_file: t -> t option (** Check whether a file has a given suffix *) val check_suffix: t -> string -> bool (** Adds a dot and the given file extension *) val add_extension: t -> string -> t (** Remove the file extension *) val chop_extension: t -> t (** List all the filenames, recursively *) val rec_files: Dir.t -> t list (** List all the filename. Do not recurse. *) val files: Dir.t -> t list (** Apply a function on the contents of a file *) val with_contents: (string -> 'a) -> t -> 'a (** Copy a file in a directory. If [root] is set, copy also the sub-directories. For instance, [copy_in ~root:"/foo" "/foo/bar/gni" "/toto"] creates ["/toto/bar/gni"]. *) val copy_in: ?root:Dir.t -> t -> Dir.t -> unit (** Move a file *) val move: src:t -> dst:t -> unit (** Read a symlinked file *) val readlink: t -> t (** Is a symlink? *) val is_symlink: t -> bool val is_symlink_dir: Dir.t -> bool (** Is an executable? *) val is_exec: t -> bool (** Copy a file *) val copy: src:t -> dst:t -> unit (** Installs a file to a destination. Optionnally set if the destination should be set executable *) val install: ?exec:bool -> src:t -> dst:t -> unit -> unit (** Symlink a file. If symlink is not possible on the system, use copy instead. With [relative], creates a relative link through the closest common ancestor directory if possible. Otherwise, the symlink is absolute. *) val link: ?relative:bool -> target:t -> link:t -> unit (** Returns true if the given file is an archive (zip or tar) *) val is_archive: t -> bool (** Extract an archive in a given directory (it rewrites the root to match [Dir.t] dir if needed) *) val extract: t -> Dir.t -> unit (** Same as [extract], as an OpamProcess.job *) val extract_job: t -> Dir.t -> exn option OpamProcess.job (** Extract an archive in a given directory *) val extract_in: t -> Dir.t -> unit val extract_in_job: t -> Dir.t -> exn option OpamProcess.job (** Extract a generic file *) val extract_generic_file: generic_file -> Dir.t -> unit (** Check whether a filename starts by a given Dir.t *) val starts_with: Dir.t -> t -> bool (** Check whether a filename ends with a given suffix *) val ends_with: string -> t -> bool (** [dir starts_with pfx dir] Check whether [dir] starts with [pfx] *) val dir_starts_with: Dir.t -> Dir.t -> bool (** Check whether a dirname ends with a given suffix *) val dir_ends_with: string -> Dir.t -> bool (** Remove a prefix from a file name *) val remove_prefix: Dir.t -> t -> string val remove_prefix_dir: Dir.t -> Dir.t -> string (** Remove a suffix from a filename *) val remove_suffix: Base.t -> t -> string (** Apply a patch in a directory. If [preprocess] is set to false, there is no CRLF translation. Returns [None] on success, the process error otherwise *) val patch: ?preprocess:bool -> t -> Dir.t -> exn option OpamProcess.job (** Create an empty file *) val touch: t -> unit (** Change file permissions *) val chmod: t -> int -> unit (** Returns the closest parent of a directory (including itself) for which the predicate holds, if any *) val find_in_parents: (Dir.t -> bool) -> Dir.t -> Dir.t option (** {2 Locking} *) (** See [OpamSystem.flock]. Prefer the higher level [with_flock] functions when possible *) val flock: [< OpamSystem.lock_flag ] -> ?dontblock:bool -> t -> OpamSystem.lock (** Calls [f] while holding a lock file. Ensures the lock is properly released on [f] exit. Raises [OpamSystem.Locked] if [dontblock] is set and the lock can't be acquired. [f] is passed the file_descr of the lock. *) val with_flock: [< OpamSystem.lock_flag ] -> ?dontblock:bool -> t -> (Unix.file_descr -> 'a) -> 'a (** Calls [f] with the file lock upgraded to at least [flag], then restores the previous lock level. Upgrade to [`Lock_write] should never be used in blocking mode as it would deadlock. Raises [OpamSystem.Locked] (but keeps the lock as is) if [dontblock] is set and the lock can't be upgraded. *) val with_flock_upgrade: [< OpamSystem.actual_lock_flag ] -> ?dontblock:bool -> OpamSystem.lock -> (Unix.file_descr -> 'a) -> 'a (** Runs first function with a write lock on the given file, then releases it to a read lock and runs the second function. *) val with_flock_write_then_read: ?dontblock:bool -> t -> (Unix.file_descr -> 'a) -> ('a -> 'b) -> 'b module Op: sig (** Create a new directory *) val (/): Dir.t -> string -> Dir.t (** Create a new filename *) val (//): Dir.t -> string -> t end (** Simple structure to hanle file attributes *) module Attribute: sig include OpamStd.ABSTRACT val to_string_list: t -> string list val of_string_list: string list -> t (** Get remote filename *) val base: t -> Base.t (** MD5 digest of the remote file *) val md5: t -> OpamHash.t (** File permission *) val perm: t -> int option (** Constructor*) val create: Base.t -> OpamHash.t -> int option -> t end (** Convert a filename to an attribute, relatively to a root *) val to_attribute: Dir.t -> t -> Attribute.t opam-2.0.5/src/core/opamUrl.mli0000644000175000017500000000575213511367404015330 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** URL parsing and printing, with support for our different backends *) type version_control = [ `git | `darcs | `hg ] type backend = [ `http | `rsync | version_control ] val string_of_backend: backend -> string (** Tolerates lots of backward compatibility names; @raise Failure on unknown protocol *) val backend_of_string: string -> [> backend] type t = { transport: string; (** the part just before '://' *) path: string; (** the part after '://' *) hash: string option; (** the optional branch/ref specification, at the end after a '#' *) backend: backend; (** the backend that opam should use to handle this url *) } (** Same as [of_string], but allows enforcing the expected backend, and may otherwise guess version control from the suffix by default (for e.g. https://foo/bar.git). (this should be disabled when parsing from files). Note that [handle_suffix] also handles user-name in ssh addresses (e.g. "ssh://git@github.com/...") *) val parse: ?backend:backend -> ?handle_suffix:bool -> string -> t include OpamStd.ABSTRACT with type t := t (** Dummy filler url *) val empty: t (** Returns the url string without the VC part (i.e. "git+foo://bar" returns "foo://bar") *) val base_url: t -> string (** The last part of the url path, e.g. ["http://foo/bar/this"] or ["http://that.here/"] *) val basename: t -> string (** Returns the url with all path components but the first one (the hostname) dropped, e.g. ["http://some.host/some/path"] becomes ["http://some.host"] *) val root: t -> t val has_trailing_slash: t -> bool (** Check if the URL matches an existing local directory, and return it *) val local_dir: t -> OpamFilename.Dir.t option (** Check if the URL matches an existing local file, and return it *) val local_file: t -> OpamFilename.t option (** If the given url-string has no 'transport://' specification and corresponds to an existing local path, check for version-control clues at that path *) val guess_version_control: string -> [> version_control ] option module Op: sig (** Appends at the end of an URL path with '/' separator. Gets back to the root if the second argument starts with '/' *) val ( / ) : t -> string -> t end opam-2.0.5/src/core/opamParallel.ml0000644000175000017500000002734513511367404016153 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamStd.Op open OpamProcess.Job.Op let log fmt = OpamConsole.log "PARALLEL" fmt let slog = OpamConsole.slog exception Aborted module type VERTEX = sig include OpamStd.OrderedType include Graph.Sig.COMPARABLE with type t := t end module type G = sig include Graph.Sig.I module Vertex: VERTEX with type t = V.t module Topological: sig val fold: (V.t -> 'a -> 'a) -> t -> 'a -> 'a end val has_cycle: t -> bool val scc_list: t -> V.t list list end module type SIG = sig module G : G val iter: jobs:int -> command:(pred:(G.V.t * 'a) list -> G.V.t -> 'a OpamProcess.job) -> ?dry_run:bool -> ?mutually_exclusive:(G.V.t list list) -> G.t -> unit val map: jobs:int -> command:(pred:(G.V.t * 'a) list -> G.V.t -> 'a OpamProcess.job) -> ?dry_run:bool -> ?mutually_exclusive:(G.V.t list list) -> G.t -> (G.V.t * 'a) list exception Errors of G.V.t list * (G.V.t * exn) list * G.V.t list exception Cyclic of G.V.t list list end module Make (G : G) = struct module G = G module V = G.Vertex module M = OpamStd.Map.Make (V) module S = OpamStd.Set.Make (V) let map_keys m = M.fold (fun k _ s -> S.add k s) m S.empty exception Errors of G.V.t list * (G.V.t * exn) list * G.V.t list exception Cyclic of V.t list list open S.Op (* Returns a map (node -> return value) *) let aux_map ~jobs ~command ?(dry_run=false) ?(mutually_exclusive=[]) g = log "Iterate over %a task(s) with %d process(es)" (slog @@ G.nb_vertex @> string_of_int) g jobs; let mutually_exclusive = List.map S.of_list mutually_exclusive in if G.has_cycle g then ( let sccs = G.scc_list g in let sccs = List.filter (function _::_::_ -> true | _ -> false) sccs in raise (Cyclic sccs) ); let njobs = G.nb_vertex g in let print_status (finished: int) (running: (OpamProcess.t * 'a * string option) M.t) = let texts = OpamStd.List.filter_map (fun (_,_,t) -> t) (M.values running) in let rec limit_width acc rem_cols = function | [] -> List.rev acc | t::ts -> let len = OpamStd.Format.visual_length t in if ts = [] && len < rem_cols then List.rev (t::acc) else if len > rem_cols - 5 then List.rev (Printf.sprintf "%s+%2d" (String.make (rem_cols - 4) ' ') (List.length ts + 1) :: acc) else limit_width (t::acc) (rem_cols - len - 1) ts in let title = Printf.sprintf "Processing %2d/%d:" (finished + M.cardinal running) njobs in let texts = if OpamConsole.disp_status_line () then limit_width [] (OpamStd.Sys.terminal_columns ()) (title::texts) else if OpamConsole.verbose () then title::texts else [] in if texts <> [] then OpamConsole.status_line "%s" (String.concat " " texts) in (* nslots is the number of free slots *) let rec loop (nslots: int) (* number of free slots *) (results: 'b M.t) (running: (OpamProcess.t * 'a * string option) M.t) (ready: S.t) = let mutual_exclusion_set n = List.fold_left (fun acc s -> if S.mem n s then acc ++ s else acc) S.empty mutually_exclusive in let run_seq_command nslots ready n = function | Done r -> log "Job %a finished" (slog (string_of_int @* V.hash)) n; let results = M.add n r results in let running = M.remove n running in if not (M.is_empty running) then print_status (M.cardinal results) running; let new_ready = S.filter (fun n -> List.for_all (fun n -> M.mem n results) (G.pred g n) && not (M.mem n results) && S.is_empty (mutual_exclusion_set n %% map_keys running)) (S.of_list (G.succ g n) ++ mutual_exclusion_set n) in loop (nslots + 1) results running (ready ++ new_ready) | Run (cmd, cont) -> log "Next task in job %a: %a" (slog (string_of_int @* V.hash)) n (slog OpamProcess.string_of_command) cmd; let p = if dry_run then OpamProcess.dry_run_background cmd else OpamProcess.run_background cmd in let running = M.add n (p, cont, OpamProcess.text_of_command cmd) running in print_status (M.cardinal results) running; loop nslots results running ready in let fail node error = log "Exception while computing job %a: %a" (slog (string_of_int @* V.hash)) node (slog V.to_string) node; if error = Sys.Break then OpamConsole.error "User interruption"; let running = M.remove node running in (* Cleanup *) let errors,pend = if dry_run then [node,error],[] else M.fold (fun n (p,cont,_text) (errors,pend) -> try match OpamProcess.dontwait p with | None -> (* process still running *) OpamProcess.interrupt p; (n,Aborted) :: errors, p::pend | Some result -> match cont result with | Done _ -> errors, pend | Run _ -> (n,Aborted) :: errors, pend with | Unix.Unix_error _ -> errors, pend | e -> (n,e)::errors, pend) running ([node,error],[]) in (try List.iter (fun _ -> ignore (OpamProcess.wait_one pend)) pend with e -> log "%a in sub-process cleanup" (slog Printexc.to_string) e); (* Generate the remaining nodes in topological order *) let remaining = G.Topological.fold (fun n remaining -> if M.mem n results || List.mem_assoc n errors then remaining else n::remaining) g [] in raise (Errors (M.keys results, List.rev errors, List.rev remaining)) in if M.is_empty running && S.is_empty ready then results else if nslots > 0 && not (S.is_empty ready) then (* Start a new process *) let n = S.choose ready in log "Starting job %a (worker %d/%d): %a" (slog (string_of_int @* V.hash)) n (jobs - nslots + 1) jobs (slog V.to_string) n; let pred = G.pred g n in let pred = List.map (fun n -> n, M.find n results) pred in let cmd = try command ~pred n with e -> fail n e in let ready = S.remove n ready -- mutual_exclusion_set n in run_seq_command (nslots - 1) ready n cmd else (* Wait for a process to end *) let processes = M.fold (fun n (p,x,_) acc -> (p,(n,x)) :: acc) running [] in let process,result = if dry_run then OpamProcess.dry_wait_one (List.map fst processes) else try match processes with | [p,_] -> p, OpamProcess.wait p | _ -> OpamProcess.wait_one (List.map fst processes) with e -> fail (fst (snd (List.hd processes))) e in let n,cont = List.assoc process processes in log "Collected task for job %a (ret:%d)" (slog (string_of_int @* V.hash)) n result.OpamProcess.r_code; let next = try cont result with e -> OpamProcess.cleanup result; fail n e in OpamProcess.cleanup result; run_seq_command nslots ready n next in let roots = G.fold_vertex (fun n roots -> if G.in_degree g n = 0 then S.add n roots else roots) g S.empty in let r = loop jobs M.empty M.empty roots in OpamConsole.clear_status (); r let iter ~jobs ~command ?dry_run ?mutually_exclusive g = ignore (aux_map ~jobs ~command ?dry_run ?mutually_exclusive g) let map ~jobs ~command ?dry_run ?mutually_exclusive g = M.bindings (aux_map ~jobs ~command ?dry_run ?mutually_exclusive g) (* Only print the originally raised exception, which should come first. Ignore Aborted exceptions due to other commands termination, and simultaneous exceptions in other command's continuations (unlikely as that would require both commands to have terminated simultaneously) *) let error_printer = function | Errors (_, (_,exc)::_, _) -> Some (Printexc.to_string exc) | _ -> None let () = Printexc.register_printer error_printer end module type GRAPH = sig include Graph.Sig.I include Graph.Oper.S with type g = t module Topological : sig val fold : (V.t -> 'a -> 'a) -> t -> 'a -> 'a val iter : (V.t -> unit) -> t -> unit end module Parallel : SIG with type G.t = t and type G.V.t = vertex module Dot : sig val output_graph : out_channel -> t -> unit end val transitive_closure: ?reflexive:bool -> t -> unit end module MakeGraph (X: VERTEX) = struct module Vertex = X module PG = Graph.Imperative.Digraph.ConcreteBidirectional (Vertex) module Topological = Graph.Topological.Make (PG) module Traverse = Graph.Traverse.Dfs(PG) module Components = Graph.Components.Make(PG) module Parallel = Make (struct include PG module Vertex = Vertex module Topological = Topological include Traverse include Components end) module Dot = Graph.Graphviz.Dot (struct let edge_attributes _ = [] let default_edge_attributes _ = [] let get_subgraph _ = None let vertex_attributes _ = [] let vertex_name v = Printf.sprintf "\"%s\"" (Vertex.to_string v) let default_vertex_attributes _ = [] let graph_attributes _ = [] include PG end) include PG include Graph.Oper.I (PG) let transitive_closure ?reflexive g = ignore (add_transitive_closure ?reflexive g) end (* Simple polymorphic implem on lists when we don't need full graphs. We piggy-back on the advanced implem using an array and an int-graph *) module IntGraph = MakeGraph(struct type t = int let compare x y = x - y let hash x = x let equal x y = x = y let to_string = string_of_int let to_json x = `Float (float_of_int x) end) let flat_graph_of_array a = let g = IntGraph.create () in Array.iteri (fun i _ -> IntGraph.add_vertex g i) a; g exception Errors = IntGraph.Parallel.Errors let iter ~jobs ~command ?dry_run l = let a = Array.of_list l in let g = flat_graph_of_array a in let command ~pred:_ i = command a.(i) in ignore (IntGraph.Parallel.iter ~jobs ~command ?dry_run g) let map ~jobs ~command ?dry_run l = let a = Array.of_list l in let g = flat_graph_of_array a in let command ~pred:_ i = command a.(i) in let r = IntGraph.Parallel.aux_map ~jobs ~command ?dry_run g in let rec mklist acc n = if n < 0 then acc else mklist (IntGraph.Parallel.M.find n r :: acc) (n-1) in mklist [] (Array.length a - 1) let reduce ~jobs ~command ~merge ~nil ?dry_run l = let a = Array.of_list l in let g = flat_graph_of_array a in let command ~pred:_ i = command a.(i) in let r = IntGraph.Parallel.aux_map ~jobs ~command ?dry_run g in IntGraph.Parallel.M.fold (fun _ -> merge) r nil opam-2.0.5/src/core/opamConsole.mli0000644000175000017500000001163013511367404016160 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Console output, ANSI color, logging and user querying *) (** Global configuration parameters (read from OpamGlobalConfig, and the environment when necessary) *) val debug: unit -> bool val verbose: unit -> bool val color: unit -> bool val utf8: unit -> bool val utf8_extended: unit -> bool val disp_status_line: unit -> bool (** General text formatting *) (** Settable attributes for ANSI terminal output. Nesting is generally not handled. *) type text_style = [ `black | `blue | `bold | `crossed | `cyan | `green | `magenta | `red | `underline | `white | `yellow ] (** Helper coloring functions. Returns the string unchanged if color is disabled *) val colorise : text_style -> string -> string val colorise' : text_style list -> string -> string val acolor : text_style -> unit -> string -> string val acolor_w : int -> text_style -> out_channel -> string -> unit module Symbols : sig val rightwards_arrow : OpamCompat.Uchar.t val box_drawings_light_down_and_right : OpamCompat.Uchar.t val box_drawings_light_horizontal : OpamCompat.Uchar.t val box_drawings_light_vertical : OpamCompat.Uchar.t val box_drawings_light_up_and_right : OpamCompat.Uchar.t val box_drawings_light_right : OpamCompat.Uchar.t val circled_division_slash : OpamCompat.Uchar.t val asterisk_operator : OpamCompat.Uchar.t val north_east_arrow : OpamCompat.Uchar.t val south_east_arrow : OpamCompat.Uchar.t val clockwise_open_circle_arrow : OpamCompat.Uchar.t val greek_small_letter_lambda : OpamCompat.Uchar.t val latin_capital_letter_o_with_stroke : OpamCompat.Uchar.t val six_pointed_black_star : OpamCompat.Uchar.t val upwards_arrow : OpamCompat.Uchar.t val downwards_arrow : OpamCompat.Uchar.t val up_down_arrow : OpamCompat.Uchar.t end val utf8_symbol: OpamCompat.Uchar.t -> ?alternates:OpamCompat.Uchar.t list -> string -> string (** Logging *) (** Timers, only active when debug is on. Returns the time between the application to each argument, in seconds *) val timer : unit -> unit -> float (** [log section ~level fmt args]. Used for debug messages, default level is 1 *) val log : string -> ?level:int -> ('a, out_channel, unit) format -> 'a (** Helper to pass stringifiers to log (use [log "%a" (slog to_string) x] rather than [log "%s" (to_string x)] to avoid costly unneeded stringifications *) val slog : ('a -> string) -> out_channel -> 'a -> unit val error : ('a, unit, string, unit) format4 -> 'a val warning : ('a, unit, string, unit) format4 -> 'a val note : ('a, unit, string, unit) format4 -> 'a (** Message without prefix, reformat or newline, to stderr (useful to continue error messages without repeating "[ERROR]") *) val errmsg : ('a, unit, string, unit) format4 -> 'a val error_and_exit : OpamStd.Sys.exit_reason -> ('a, unit, string, 'b) format4 -> 'a val msg : ('a, unit, string, unit) format4 -> 'a val formatted_msg : ?indent:int -> ('a, unit, string, unit) format4 -> 'a val header_msg : ('a, unit, string, unit) format4 -> 'a val header_error : ('a, unit, string, ('b, unit, string, unit) format4 -> 'b) format4 -> 'a (** Erase the current line on stdout (doesn't flush stdout) *) val carriage_delete: unit -> unit (** Display a dynamic status line to stdout, that will be erased on next call. The message should not be wider than screen nor contain newlines. Use {!clear_status} when the status line should be erased. *) val status_line : ('a, unit, string, unit) format4 -> 'a (** Erase the status line and restore the cursor to the start of the line *) val clear_status : unit -> unit (** Ask the user to press Y/y/N/n to continue (returns a boolean). Defaults to true (yes) if unspecified *) val confirm: ?default:bool -> ('a, unit, string, bool) format4 -> 'a (** Read some input from the user (returns a string option) *) val read: ('a, unit, string, string option) format4 -> 'a (** Prints a table; generally called on tables passed through [align_table]. The default [cut] is to wrap on stdout, stderr, keep as-is otherwise. [`Wrap sep] prepends [sep] on wrapped lines *) val print_table: ?cut:[`Wrap of string | `Truncate | `None] -> out_channel -> sep:string -> string list list -> unit opam-2.0.5/src/core/opamSystem.ml0000644000175000017500000011770513511367404015703 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat exception Process_error of OpamProcess.result exception Internal_error of string exception Command_not_found of string exception File_not_found of string let log ?level fmt = OpamConsole.log "SYSTEM" ?level fmt let slog = OpamConsole.slog let internal_error fmt = Printf.ksprintf (fun str -> log "error: %s" str; raise (Internal_error str) ) fmt let process_error r = if r.OpamProcess.r_signal = Some Sys.sigint then raise Sys.Break else raise (Process_error r) let raise_on_process_error r = if OpamProcess.is_failure r then raise (Process_error r) let command_not_found cmd = raise (Command_not_found cmd) module Sys2 = struct (* same as [Sys.is_directory] except for symlinks, which returns always [false]. *) let is_directory file = try Unix.( (lstat file).st_kind = S_DIR ) with Unix.Unix_error _ as e -> raise (Sys_error (Printexc.to_string e)) end let file_or_symlink_exists f = try ignore (Unix.lstat f); true with Unix.Unix_error (Unix.ENOENT, _, _) -> false let (/) = Filename.concat let temp_basename prefix = Printf.sprintf "%s-%d-%06x" prefix (OpamStubs.getpid ()) (Random.int 0xFFFFFF) let rec mk_temp_dir ?(prefix="opam") () = let s = Filename.get_temp_dir_name () / temp_basename prefix in if Sys.file_exists s then mk_temp_dir () else s let safe_mkdir dir = try log "mkdir %s" dir; Unix.mkdir dir 0o755 with Unix.Unix_error(Unix.EEXIST,_,_) -> () let mkdir dir = let rec aux dir = if not (Sys.file_exists dir) then begin aux (Filename.dirname dir); safe_mkdir dir; end in aux dir let rm_command = if Sys.win32 then "cmd /d /v:off /c rd /s /q" else "rm -rf" let remove_dir dir = log "rmdir %s" dir; if Sys.file_exists dir then ( let err = Sys.command (Printf.sprintf "%s %s" rm_command dir) in if err <> 0 then internal_error "Cannot remove %s (error %d)." dir err ) let temp_files = Hashtbl.create 1024 let logs_cleaner = let to_clean = ref OpamStd.String.Set.empty in OpamStd.Sys.at_exit (fun () -> OpamStd.String.Set.iter (fun f -> try Unix.unlink f; (* Only log the item if unlink succeeded *) log "logs_cleaner: rm: %s" f with Unix.Unix_error _ -> ()) !to_clean; if OpamCoreConfig.(!r.log_dir = default.log_dir) then try Unix.rmdir OpamCoreConfig.(default.log_dir) with Unix.Unix_error _ -> ()); fun tmp_dir -> if OpamCoreConfig.(!r.keep_log_dir) then to_clean := OpamStd.String.Set.remove tmp_dir !to_clean else to_clean := OpamStd.String.Set.add tmp_dir !to_clean let rec temp_file ?(auto_clean=true) ?dir prefix = let temp_dir = match dir with | None -> OpamCoreConfig.(!r.log_dir) | Some d -> d in mkdir temp_dir; let file = temp_dir / temp_basename prefix in if Hashtbl.mem temp_files file then temp_file ~auto_clean ?dir prefix else ( Hashtbl.add temp_files file true; if auto_clean then logs_cleaner file; file ) let remove_file file = if try ignore (Unix.lstat file); true with Unix.Unix_error _ -> false then ( try log "rm %s" file; Unix.unlink file with Unix.Unix_error _ as e -> internal_error "Cannot remove %s (%s)." file (Printexc.to_string e) ) let string_of_channel ic = let n = 32768 in let s = Bytes.create n in let b = Buffer.create 1024 in let rec iter ic b s = let nread = try input ic s 0 n with End_of_file -> 0 in if nread > 0 then ( Buffer.add_subbytes b s 0 nread; iter ic b s ) in iter ic b s; Buffer.contents b let read file = let ic = try open_in_bin file with Sys_error _ -> raise (File_not_found file) in Unix.lockf (Unix.descr_of_in_channel ic) Unix.F_RLOCK 0; let s = string_of_channel ic in close_in ic; s let write file contents = mkdir (Filename.dirname file); let oc = try open_out_bin file with Sys_error _ -> raise (File_not_found file) in Unix.lockf (Unix.descr_of_out_channel oc) Unix.F_LOCK 0; output_string oc contents; close_out oc let chdir dir = try Unix.chdir dir with Unix.Unix_error _ -> raise (File_not_found dir) let in_dir dir fn = let reset_cwd = let cwd = try Some (Sys.getcwd ()) with Sys_error _ -> None in fun () -> match cwd with | None -> () | Some cwd -> try chdir cwd with File_not_found _ -> () in chdir dir; try let r = fn () in reset_cwd (); r with e -> OpamStd.Exn.finalise e reset_cwd let list kind dir = try in_dir dir (fun () -> let d = Sys.readdir (Sys.getcwd ()) in let d = Array.to_list d in let l = List.filter kind d in List.map (Filename.concat dir) (List.sort compare l) ) with File_not_found _ -> [] let ls dir = list (fun _ -> true) dir let files_with_links = list (fun f -> try not (Sys.is_directory f) with Sys_error _ -> false) let files_all_not_dir = list (fun f -> try not (Sys2.is_directory f) with Sys_error _ -> false) let directories_strict = list (fun f -> try Sys2.is_directory f with Sys_error _ -> false) let directories_with_links = list (fun f -> try Sys.is_directory f with Sys_error _ -> false) let rec_files dir = let rec aux accu dir = let d = directories_with_links dir in let f = files_with_links dir in List.fold_left aux (f @ accu) d in aux [] dir let files dir = files_with_links dir let rec_dirs dir = let rec aux accu dir = let d = directories_with_links dir in List.fold_left aux (d @ accu) d in aux [] dir let dirs dir = directories_with_links dir let dir_is_empty dir = try in_dir dir (fun () -> Sys.readdir (Sys.getcwd ()) = [||]) with File_not_found _ -> false let with_tmp_dir fn = let dir = mk_temp_dir () in try mkdir dir; let e = fn dir in remove_dir dir; e with e -> OpamStd.Exn.finalise e @@ fun () -> remove_dir dir let with_tmp_dir_job fjob = let dir = mk_temp_dir () in mkdir dir; OpamProcess.Job.finally (fun () -> remove_dir dir) (fun () -> fjob dir) let remove file = if (try Sys2.is_directory file with Sys_error _ -> false) then remove_dir file else remove_file file (* Sets path to s and returns the old path *) let getchdir s = let p = try Sys.getcwd () with Sys_error _ -> let p = OpamCoreConfig.(!r.log_dir) in mkdir p; p in chdir s; p let normalize s = try getchdir (getchdir s) with File_not_found _ -> s let real_path p = (* if Filename.is_relative p then *) match (try Some (Sys.is_directory p) with Sys_error _ -> None) with | None -> let rec resolve dir = if Sys.file_exists dir then normalize dir else let parent = Filename.dirname dir in if dir = parent then dir else Filename.concat (resolve parent) (Filename.basename dir) in let p = if Filename.is_relative p then Filename.concat (Sys.getcwd ()) p else p in resolve p | Some true -> normalize p | Some false -> let dir = normalize (Filename.dirname p) in match Filename.basename p with | "." -> dir | base -> dir / base (* else p *) type command = string list let default_env = Unix.environment () let env_var env var = let len = Array.length env in let f = if Sys.win32 then String.uppercase_ascii else fun x -> x in let prefix = f var^"=" in let pfxlen = String.length prefix in let rec aux i = if i >= len then "" else let s = env.(i) in if OpamStd.String.starts_with ~prefix (f s) then String.sub s pfxlen (String.length s - pfxlen) else aux (i+1) in aux 0 let forward_to_back = if Sys.win32 then String.map (function '/' -> '\\' | c -> c) else fun x -> x let back_to_forward = if Sys.win32 then String.map (function '\\' -> '/' | c -> c) else fun x -> x (* OCaml 4.05.0 no longer follows the updated PATH to resolve commands. This makes unqualified commands absolute as a workaround. *) let resolve_command = let is_external_cmd name = let name = forward_to_back name in OpamStd.String.contains_char name Filename.dir_sep.[0] in let check_perms = if Sys.win32 then fun f -> try (Unix.stat f).Unix.st_kind = Unix.S_REG with e -> OpamStd.Exn.fatal e; false else fun f -> try let open Unix in let uid = getuid() and groups = Array.to_list(getgroups()) in let {st_uid; st_gid; st_perm; _} = stat f in let mask = 0o001 lor (if uid = st_uid then 0o100 else 0) lor (if List.mem st_gid groups then 0o010 else 0) in (st_perm land mask) <> 0 with e -> OpamStd.Exn.fatal e; false in let resolve ?dir env name = if not (Filename.is_relative name) then (* absolute path *) if check_perms name then Some name else None else if is_external_cmd name then (* relative *) let cmd = match dir with | None -> name | Some d -> Filename.concat d name in if check_perms cmd then Some cmd else None else (* bare command, lookup in PATH *) if Sys.win32 then let path = OpamStd.Sys.split_path_variable (env_var env "PATH") in let name = if Filename.check_suffix name ".exe" then name else name ^ ".exe" in OpamStd.(List.find_opt (fun path -> check_perms (Filename.concat path name)) path |> Option.map (fun path -> Filename.concat path name)) else let cmd, args = "/bin/sh", ["-c"; Printf.sprintf "command -v %s" name] in let r = OpamProcess.run (OpamProcess.command ~env ?dir ~name:(temp_file ("command-"^(Filename.basename name))) ~verbose:false cmd args) in if OpamProcess.check_success_and_cleanup r then match r.OpamProcess.r_stdout with | cmdname::_ when cmdname = name || check_perms cmdname -> (* "command -v echo" returns just echo, hence the first when check *) Some cmdname | _ -> None else None in fun ?(env=default_env) ?dir name -> resolve env ?dir name let runs = ref [] let print_stats () = match !runs with | [] -> () | l -> OpamConsole.msg "%d external processes called:\n%s" (List.length l) (OpamStd.Format.itemize ~bullet:" " (String.concat " ") l) let log_file ?dir name = temp_file ?dir (OpamStd.Option.default "log" name) let make_command ?verbose ?(env=default_env) ?name ?text ?metadata ?allow_stdin ?stdout ?dir ?(resolve_path=true) cmd args = let name = log_file name in let verbose = OpamStd.Option.default OpamCoreConfig.(!r.verbose_level >= 2) verbose in (* Check that the command doesn't contain whitespaces *) if None <> try Some (String.index cmd ' ') with Not_found -> None then OpamConsole.warning "Command %S contains space characters" cmd; let full_cmd = if resolve_path then resolve_command ~env ?dir cmd else Some cmd in match full_cmd with | Some cmd -> OpamProcess.command ~env ~name ?text ~verbose ?metadata ?allow_stdin ?stdout ?dir cmd args | None -> command_not_found cmd let run_process ?verbose ?(env=default_env) ~name ?metadata ?stdout ?allow_stdin command = let chrono = OpamConsole.timer () in runs := command :: !runs; match command with | [] -> invalid_arg "run_process" | cmd :: args -> if OpamStd.String.contains_char cmd ' ' then OpamConsole.warning "Command %S contains space characters" cmd; match resolve_command ~env cmd with | Some full_cmd -> let verbose = match verbose with | None -> OpamCoreConfig.(!r.verbose_level) >= 2 | Some b -> b in let r = OpamProcess.run (OpamProcess.command ~env ~name ~verbose ?metadata ?allow_stdin ?stdout full_cmd args) in let str = String.concat " " (cmd :: args) in log "[%a] (in %.3fs) %s" (OpamConsole.slog Filename.basename) name (chrono ()) str; r | None -> command_not_found cmd let command ?verbose ?env ?name ?metadata ?allow_stdin cmd = let name = log_file name in let r = run_process ?verbose ?env ~name ?metadata ?allow_stdin cmd in OpamProcess.cleanup r; raise_on_process_error r let commands ?verbose ?env ?name ?metadata ?(keep_going=false) commands = let name = log_file name in let run = run_process ?verbose ?env ~name ?metadata in let command r0 c = match r0, keep_going with | (`Error _ | `Exception _), false -> r0 | _ -> let r1 = try let r = run c in if OpamProcess.is_success r then `Successful r else `Error r with Command_not_found _ as e -> `Exception e in match r0 with `Start | `Successful _ -> r1 | _ -> r0 in match List.fold_left command `Start commands with | `Start -> () | `Successful r -> OpamProcess.cleanup r | `Error e -> process_error e | `Exception e -> raise e let read_command_output ?verbose ?env ?metadata ?allow_stdin cmd = let name = log_file None in let r = run_process ?verbose ?env ~name ?metadata ?allow_stdin ~stdout:(name^".out") cmd in OpamProcess.cleanup r; raise_on_process_error r; r.OpamProcess.r_stdout let verbose_for_base_commands () = OpamCoreConfig.(!r.verbose_level) >= 3 let copy_file src dst = if (try Sys.is_directory src with Sys_error _ -> raise (File_not_found src)) then internal_error "Cannot copy %s: it is a directory." src; if (try Sys.is_directory dst with Sys_error _ -> false) then internal_error "Cannot copy to %s: it is a directory." dst; if file_or_symlink_exists dst then remove_file dst; mkdir (Filename.dirname dst); command ~verbose:(verbose_for_base_commands ()) ["cp"; src; dst ] let copy_dir src dst = if Sys.file_exists dst then if Sys.is_directory dst then match ls src with | [] -> () | srcfiles -> command ~verbose:(verbose_for_base_commands ()) ([ "cp"; "-PRp" ] @ srcfiles @ [ dst ]) else internal_error "Can not copy dir %s to %s, which is not a directory" src dst else (mkdir (Filename.dirname dst); command ~verbose:(verbose_for_base_commands ()) [ "cp"; "-PRp"; src; dst ]) let mv src dst = if file_or_symlink_exists dst then remove_file dst; mkdir (Filename.dirname dst); command ~verbose:(verbose_for_base_commands ()) ["mv"; src; dst ] let is_exec file = let stat = Unix.stat file in stat.Unix.st_kind = Unix.S_REG && stat.Unix.st_perm land 0o111 <> 0 let file_is_empty f = Unix.((stat f).st_size = 0) let install ?exec src dst = if Sys.is_directory src then internal_error "Cannot install %s: it is a directory." src; if (try Sys.is_directory dst with Sys_error _ -> false) then internal_error "Cannot install to %s: it is a directory." dst; mkdir (Filename.dirname dst); let exec = match exec with | Some e -> e | None -> is_exec src in command ("install" :: "-m" :: (if exec then "0755" else "0644") :: [ src; dst ]) let cpu_count () = try let ans = let open OpamStd in match Sys.os () with | Sys.Win32 -> [Env.get "NUMBER_OF_PROCESSORS"] | Sys.FreeBSD -> read_command_output ~verbose:(verbose_for_base_commands ()) ["sysctl"; "-n"; "hw.ncpu"] | _ -> read_command_output ~verbose:(verbose_for_base_commands ()) ["getconf"; "_NPROCESSORS_ONLN"] in int_of_string (List.hd ans) with Not_found | Process_error _ | Failure _ -> 1 open OpamProcess.Job.Op module Tar = struct type extract = | Bzip2 | Gzip | Lzma | Xz let extract_command = function | Bzip2 -> "bzip2" | Gzip -> "gzip" | Lzma -> "lzma" | Xz -> "xz" let extract_option = function | Bzip2 -> 'j' | Gzip -> 'z' | Lzma -> 'Y' | Xz -> 'J' let extensions = [ [ "tar.gz" ; "tgz" ], Gzip ; [ "tar.bz2" ; "tbz" ], Bzip2 ; [ "tar.xz" ; "txz" ], Xz ; [ "tar.lzma" ; "tlz" ], Lzma ] let guess_type f = try let ic = open_in f in let c1 = input_char ic in let c2 = input_char ic in close_in ic; match c1, c2 with | '\031', '\139' -> Some Gzip | 'B' , 'Z' -> Some Bzip2 | '\xfd', '\x37' -> Some Xz | '\x5d', '\x00' -> Some Lzma | _ -> None with Sys_error _ -> None let match_ext file ext = List.exists (Filename.check_suffix file) ext let get_type file = let ext = List.fold_left (fun acc (ext, t) -> match acc with | Some t -> Some t | None -> if match_ext file ext then Some t else None) None extensions in match ext with | Some t -> Some t | None -> match guess_type file with | Some t -> Some t | _ -> None let is_archive file = get_type file <> None let check_extract file = OpamStd.Option.Op.( get_type file >>= fun typ -> let cmd = extract_command typ in let res = resolve_command cmd <> None in if not res then Some (Printf.sprintf "Tar needs %s to extract the archive" cmd) else None) let extract_command file = OpamStd.Option.Op.( get_type file >>| fun typ -> let tar_cmd = match OpamStd.Sys.os () with | OpamStd.Sys.OpenBSD -> "gtar" | _ -> "tar" in let command c dir = make_command tar_cmd [ Printf.sprintf "xf%c" c ; file; "-C" ; dir ] in command (extract_option typ)) end module Zip = struct let is_archive f = try let ic = open_in f in let c1 = input_char ic in let c2 = input_char ic in let c3 = input_char ic in let c4 = input_char ic in close_in ic; match c1, c2, c3, c4 with | '\x50', '\x4b', '\x03', '\x04' -> true | _ -> false with Sys_error _ | End_of_file -> false let extract_command file = Some (fun dir -> make_command "unzip" [ file; "-d"; dir ]) end let is_archive file = Tar.is_archive file || Zip.is_archive file let extract_command file = if Zip.is_archive file then Zip.extract_command file else Tar.extract_command file let extract_job ~dir file = if not (Sys.file_exists file) then Done (Some (File_not_found file)) else with_tmp_dir_job @@ fun tmp_dir -> match extract_command file with | None -> Done (Some (Failure ("Unknown archive type: "^file))) | Some cmd -> cmd tmp_dir @@> fun r -> if not (OpamProcess.is_success r) then if Zip.is_archive file then Done (Some (Process_error r)) else match Tar.check_extract file with | None -> Done (Some (Process_error r)) | Some s -> Done (Some (Failure s)) else if try not (Sys.is_directory dir) with Sys_error _ -> false then internal_error "Extracting the archive would overwrite %s." dir else let flist = OpamStd.Op.( files_all_not_dir tmp_dir |> List.filter (not @* OpamStd.String.contains ~sub:"pax_global_header")) in match flist with | [] -> begin match directories_strict tmp_dir with | [x] -> (try mkdir (Filename.dirname dir); copy_dir x dir; Done None with e -> OpamStd.Exn.fatal e; Done (Some e)) | _ -> internal_error "The archive %S contains multiple root directories." file end | _ -> mkdir (Filename.dirname dir); try copy_dir tmp_dir dir; Done None with e -> OpamStd.Exn.fatal e; Done (Some e) let extract ~dir file = match OpamProcess.Job.run (extract_job ~dir file) with | Some e -> raise e | None -> () let extract_in_job ~dir file = OpamProcess.Job.catch (fun e -> Done (Some e)) @@ fun () -> mkdir dir; match extract_command file with | None -> internal_error "%s is not a valid tar or zip archive." file | Some cmd -> cmd dir @@> fun r -> if not (OpamProcess.is_success r) then if Zip.is_archive file then Done (Some (Process_error r)) else match Tar.check_extract file with | None -> Done (Some (Failure (Printf.sprintf "Failed to extract archive %s: %s" file (OpamProcess.result_summary r)))) | Some s -> Done (Some (Failure s)) else Done None let extract_in ~dir file = match OpamProcess.Job.run (extract_in_job ~dir file) with | Some e -> raise e | None -> () let link src dst = mkdir (Filename.dirname dst); if file_or_symlink_exists dst then remove_file dst; try log "ln -s %s %s" src dst; Unix.symlink src dst with Unix.Unix_error (Unix.EXDEV, _, _) -> (* Fall back to copy if symlinks are not supported *) let src = if Filename.is_relative src then Filename.dirname dst / src else src in if Sys.is_directory src then copy_dir src dst else copy_file src dst type actual_lock_flag = [ `Lock_read | `Lock_write ] type lock_flag = [ `Lock_none | actual_lock_flag ] type lock = { mutable fd: Unix.file_descr option; file: string; mutable kind: lock_flag; } exception Locked let unix_lock_op ~dontblock = function | `Lock_read -> if dontblock then Unix.F_TRLOCK else Unix.F_RLOCK | `Lock_write -> if OpamCoreConfig.(!r.safe_mode) then OpamConsole.error_and_exit `Locked "Write lock attempt in safe mode" else if dontblock then Unix.F_TLOCK else Unix.F_LOCK let string_of_lock_kind = function | `Lock_none -> "none" | `Lock_read -> "read" | `Lock_write -> "write" let locks = Hashtbl.create 16 let release_all_locks () = Hashtbl.iter (fun fd _ -> Unix.close fd) locks; Hashtbl.clear locks let rec flock_update : 'a. ([< lock_flag ] as 'a) -> ?dontblock:bool -> lock -> unit = fun flag ?(dontblock=OpamCoreConfig.(!r.safe_mode)) lock -> log "LOCK %s (%a => %a)" ~level:2 lock.file (slog string_of_lock_kind) (lock.kind) (slog string_of_lock_kind) flag; if lock.kind = (flag :> lock_flag) then () else match flag, lock with | `Lock_none, { fd = Some fd; kind = (`Lock_read | `Lock_write); _ } -> Hashtbl.remove locks fd; Unix.close fd; (* implies Unix.lockf fd Unix.F_ULOCK 0 *) lock.kind <- (flag :> lock_flag); lock.fd <- None | (`Lock_read | `Lock_write), { fd = None; kind = `Lock_none; file } -> let new_lock = flock flag ~dontblock file in lock.kind <- (flag :> lock_flag); lock.fd <- new_lock.fd | `Lock_write, { fd = Some fd; file; kind = `Lock_read } -> Unix.close fd; (* fd needs read-write reopen *) let new_lock = flock flag ~dontblock file in lock.kind <- (flag :> lock_flag); lock.fd <- new_lock.fd | (`Lock_read | `Lock_write) as flag, { fd = Some fd; file; kind } -> (* Write locks are not recursive on Windows, so only call lockf if necessary *) if kind <> flag then (try (* Locks can't be promoted (or demoted) on Windows - see PR#7264 *) if Sys.win32 && kind <> `Lock_none then Unix.(lockf fd F_ULOCK 0); Unix.lockf fd (unix_lock_op ~dontblock:true flag) 0 with Unix.Unix_error (Unix.EAGAIN,_,_) -> if dontblock then OpamConsole.error_and_exit `Locked "Another process has locked %s and non blocking mode enabled" file; OpamConsole.formatted_msg "Another process has locked %s, waiting (%s to abort)... " file (if Sys.win32 then "CTRL+C" else "C-c"); let rec lock_w_ignore_sig () = try Unix.lockf fd (unix_lock_op ~dontblock:false flag) 0; with Sys.Break as e -> (OpamConsole.msg "\n"; raise e) | Unix.Unix_error (Unix.EINTR,_,_) -> lock_w_ignore_sig () in lock_w_ignore_sig (); OpamConsole.msg "lock acquired.\n"); lock.kind <- (flag :> lock_flag) | _ -> assert false and flock: 'a. ([< lock_flag ] as 'a) -> ?dontblock:bool -> string -> lock = fun flag ?dontblock file -> match flag with | `Lock_none -> { fd = None; file; kind = `Lock_none } | `Lock_write when OpamCoreConfig.(!r.safe_mode) -> OpamConsole.error_and_exit `Locked "Write lock attempt in safe mode"; | flag -> mkdir (Filename.dirname file); let rdflag = if (flag :> lock_flag) = `Lock_write then Unix.O_RDWR else Unix.O_RDONLY in let fd = Unix.openfile file Unix.([O_CREAT; O_CLOEXEC; rdflag]) 0o666 in Hashtbl.add locks fd (); let lock = { fd = Some fd; file; kind = `Lock_none } in flock_update flag ?dontblock lock; lock let funlock lock = flock_update `Lock_none lock let get_lock_flag lock = lock.kind let get_lock_fd lock = match lock.fd with Some fd -> fd | None -> raise Not_found let lock_max flag1 flag2 = match flag1, flag2 with | `Lock_write, _ | _, `Lock_write -> `Lock_write | `Lock_read, _ | _, `Lock_read -> `Lock_read | `Lock_none, `Lock_none -> `Lock_none let lock_none = { fd = None; file = ""; kind = `Lock_none; } let lock_isatleast flag lock = lock_max flag lock.kind = lock.kind let get_eol_encoding file = let ch = try open_in_bin file with Sys_error _ -> raise (File_not_found file) in let has_cr line = let length = String.length line in length > 0 && line.[length - 1] = '\r' in let last_char ch = seek_in ch (in_channel_length ch - 1); input_char ch in let rec read_lines cr line = let has_cr = has_cr line in match input_line ch with | line -> if has_cr = cr then read_lines cr line else begin close_in ch; None end | exception End_of_file -> let result = if cr = has_cr then Some cr else if cr && last_char ch <> '\n' then Some true else None in close_in ch; result in match input_line ch with | line_one -> let has_cr = has_cr line_one in begin match input_line ch with | line_two -> read_lines has_cr line_two | exception End_of_file -> let result = if last_char ch = '\n' then Some has_cr else None in close_in ch; result end | exception End_of_file -> close_in ch; None let translate_patch ~dir orig corrected = (* It's unnecessarily complicated to infer whether the entire file is CRLF encoded and also the status of individual files, so accept scanning the file three times instead of two. *) let log ?level fmt = OpamConsole.log "PATCH" ?level fmt in let strip_cr = get_eol_encoding orig = Some true in let ch = try open_in_bin orig with Sys_error _ -> raise (File_not_found orig) in (* CRLF detection with patching can be more complicated than that used here, especially in the presence of files with mixed LF/CRLF endings. The processing done here aims to allow patching to succeed on files which are wholly encoded CRLF or LF against patches which may have been translated to be the opposite. The resulting patch will *always* have LF line endings for the patch metadata (headers, chunk locations, etc.) but uses either CRLF or LF depending on the target file. Endings in the patch are always preserved for new files. The benefit of always using LF endings for the metadata is that patch's "Stripping trailing CRs from patch" behaviour won't be triggered. There are various patch formats, though only the Unified and Context formats allow multiple files to be patched. I tired of trying to get sufficient documented detail of Context diffs to be able to parse them without resorting to reverse-engineering code. It is unusual to see them these days, so for now opam just emits a warning if a Context diff file is encountered and does no processing to it. There are various semantic aspects of Unified diffs which are not handled (at least at present) by this function which are documented in the code with the marker "Weakness". *) let process_chunk_header result line = match OpamStd.String.split line ' ' with | "@@"::a::b::"@@"::_ -> (* Weakness: for a new file [a] should always be -0,0 (not checked) *) let l_a = String.length a in let l_b = String.length b in if l_a > 1 && l_b > 1 && a.[0] = '-' && b.[0] = '+' then try let f (_, v) = int_of_string v in let neg = OpamStd.String.cut_at (String.sub a 1 (l_a - 1)) ',' |> OpamStd.Option.map_default f 1 in let pos = OpamStd.String.cut_at (String.sub b 1 (l_b - 1)) ',' |> OpamStd.Option.map_default f 1 in result neg pos with e -> OpamStd.Exn.fatal e; (* TODO Should display some kind of re-sync warning *) `Header else (* TODO Should display some kind of re-sync warning *) `Header | _ -> (* TODO Should display some kind of warning that there were no chunks *) `Header in let process_state_transition next_state state transforms = match (state, next_state) with | (`Processing _, `Processing _) -> transforms | (`Processing (_, target, crlf, patch_crlf, chunks, _), _) -> let compute_transform patch_crlf = (* Emit the patch *) let transform = match (crlf, patch_crlf) with | (None, _) | (_, None) -> log ~level:3 "CRLF adaptation skipped for %s" target; None | (Some crlf, Some patch_crlf) -> if crlf = patch_crlf then begin log ~level:3 "No CRLF adaptation necessary for %s" target; None end else if crlf then begin log ~level:3 "Adding \\r to patch chunks for %s" target; Some true end else begin log ~level:3 "Stripping \\r to patch chunks for %s" target; Some false end in let record_transform transform = let augment_record (first_line, last_line) = (first_line, last_line, transform) in List.rev_append (List.rev_map augment_record chunks) transforms in OpamStd.Option.map_default record_transform transforms transform in OpamStd.Option.map_default compute_transform transforms patch_crlf | _ -> transforms in let rec fold_lines state n transforms = match input_line ch with | line -> let line = if strip_cr then String.sub line 0 (String.length line - 1) else line in let length = String.length line in let next_state = match state with | `Header -> begin match (if length > 4 then String.sub line 0 4 else "") with | "--- " -> (* Start of a unified diff header. *) let file = let file = String.sub line 4 (length - 4) in let open OpamStd in Option.map_default fst file (String.cut_at file '\t') in (* Weakness: new files are also marked with a time-stamp at the start of the epoch, however it's localised, making it a bit tricky to identify! New files are also identified by their absence on disk, so this weakness isn't particularly critical. *) if file = "/dev/null" then `NewHeader else let target = OpamStd.String.cut_at (back_to_forward file) '/' |> OpamStd.Option.map_default snd file |> Filename.concat dir in if Sys.file_exists target then let crlf = get_eol_encoding target in `Patching (file, crlf) else `NewHeader | "*** " -> OpamConsole.warning "File %s uses context diffs which are \ less portable; consider using unified \ diffs" orig; `SkipFile | _ -> (* Headers will contain other lines, which are ignored (e.g. the diff command which generated the diff, or Git commit messages) *) `Header end | `NewHeader -> if (if length > 4 then String.sub line 0 4 else "") = "+++ " then `New else (* TODO Should display some kind of re-sync warning *) `Header | `New -> process_chunk_header (fun neg pos -> `NewChunk (neg, pos)) line | `NewChunk (neg, pos) -> (* Weakness: new files should only have + lines *) let neg = if line = "" || line.[0] = ' ' || line.[0] = '-' then neg - 1 else neg in let pos = if line = "" || line.[0] = ' ' || line.[0] = '+' then pos - 1 else pos in if neg = 0 && pos = 0 then `New else (* Weakness: there should only be one chunk for a new file *) `NewChunk (neg, pos) | `Patching (orig, crlf) -> if (if length > 4 then String.sub line 0 4 else "") = "+++ " then let file = let file = String.sub line 4 (length - 4) in let open OpamStd in Option.map_default fst file (String.cut_at file '\t') in `Processing (orig, file, crlf, None, [], `Head) else `Header | `Processing (orig, target, crlf, patch_crlf, chunks, `Head) -> if line = "\\ No newline at end of file" then (* If the no eol-at-eof indicator is found, never add \r to final chunk line *) let chunks = match chunks with | (a, b)::chunks -> (a, b - 1)::chunks | _ -> chunks in `Processing (orig, target, crlf, patch_crlf, chunks, `Head) else process_chunk_header (fun neg pos -> `Processing (orig, target, crlf, patch_crlf, chunks, `Chunk (succ n, neg, pos))) line | `Processing (orig, target, crlf, patch_crlf, chunks, `Chunk (first_line, neg, pos)) -> let neg = if line = "" || line.[0] = ' ' || line.[0] = '-' then neg - 1 else neg in let pos = if line = "" || line.[0] = ' ' || line.[0] = '+' then pos - 1 else pos in let patch_crlf = let has_cr = (length > 0 && line.[length - 1] = '\r') in match patch_crlf with | None -> Some (Some has_cr) | Some (Some think_cr) when think_cr <> has_cr -> log ~level:2 "Patch adaptation disabled for %s: \ mixed endings or binary file" target; Some None | _ -> patch_crlf in if neg = 0 && pos = 0 then let chunks = (first_line, n)::chunks in `Processing (orig, target, crlf, patch_crlf, chunks, `Head) else `Processing (orig, target, crlf, patch_crlf, chunks, `Chunk (first_line, neg, pos)) | `SkipFile -> `SkipFile in if next_state = `SkipFile then [] else process_state_transition next_state state transforms |> fold_lines next_state (succ n) | exception End_of_file -> process_state_transition `Header state transforms |> List.rev in let transforms = fold_lines `Header 1 [] in if transforms = [] then copy_file orig corrected else begin seek_in ch 0; let ch_out = try open_out_bin corrected with Sys_error _ -> close_in ch; raise (File_not_found corrected) in let (normal, add_cr, strip_cr) = let strip n s = String.sub s 0 (String.length s - n) in let id x = x in if strip_cr then (strip 1, id, strip 2) else (id, (fun s -> s ^ "\r"), strip 1) in if OpamConsole.debug () then let log_transform (first_line, last_line, add_cr) = let indicator = if add_cr then '+' else '-' in log ~level:3 "Transform %d-%d %c\\r" first_line last_line indicator in List.iter log_transform transforms; let rec fold_lines n transforms = match input_line ch with | line -> let (f, transforms) = match transforms with | (first_line, last_line, add_cr_to_chunks)::next_transforms -> let transforms = if n = last_line then next_transforms else transforms in let f = if n >= first_line then if add_cr_to_chunks then add_cr else strip_cr else normal in (f, transforms) | [] -> (normal, []) in output_string ch_out (f line); output_char ch_out '\n'; fold_lines (succ n) transforms | exception End_of_file -> close_out ch_out in fold_lines 1 transforms end; close_in ch let patch ?(preprocess=true) ~dir p = if not (Sys.file_exists p) then (OpamConsole.error "Patch file %S not found." p; raise Not_found); let p' = if preprocess then let p' = temp_file ~auto_clean:false "processed-patch" in translate_patch ~dir p p'; p' else p in let patch_cmd = match OpamStd.Sys.os () with | OpamStd.Sys.OpenBSD | OpamStd.Sys.FreeBSD -> "gpatch" | _ -> "patch" in make_command ~name:"patch" ~dir patch_cmd ["-p1"; "-i"; p'] @@> fun r -> if not (OpamConsole.debug ()) then Sys.remove p'; if OpamProcess.is_success r then Done None else Done (Some (Process_error r)) let register_printer () = Printexc.register_printer (function | Process_error r -> Some (OpamProcess.result_summary r) | Internal_error m -> Some m | Command_not_found c -> Some (Printf.sprintf "%S: command not found." c) | Sys.Break -> Some "User interruption" | Unix.Unix_error (e, fn, msg) -> let msg = if msg = "" then "" else " on " ^ msg in let error = Printf.sprintf "%s: %S failed%s: %s" Sys.argv.(0) fn msg (Unix.error_message e) in Some error | _ -> None ) let init () = register_printer (); Sys.catch_break true; try Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> ())) with Invalid_argument _ -> () opam-2.0.5/src/core/opamStubs.ml.dummy0000644000175000017500000000325013511367404016636 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 MetaStack Solutions Ltd. *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include OpamStubsTypes let that's_a_no_no _ = failwith "Windows only. This function isn't implemented." let getCurrentProcessID = that's_a_no_no let getpid = Unix.getpid let getStdHandle = that's_a_no_no let getConsoleScreenBufferInfo = that's_a_no_no let setConsoleTextAttribute _ = that's_a_no_no let fillConsoleOutputCharacter _ _ _ = that's_a_no_no let getConsoleMode = that's_a_no_no let setConsoleMode _ = that's_a_no_no let getWindowsVersion = that's_a_no_no let isWoW64 () = false let waitpids _ = that's_a_no_no let writeRegistry _ _ _ = that's_a_no_no let getConsoleOutputCP = that's_a_no_no let getCurrentConsoleFontEx _ = that's_a_no_no let create_glyph_checker = that's_a_no_no let delete_glyph_checker = that's_a_no_no let has_glyph _ = that's_a_no_no let isWoW64Process = that's_a_no_no let process_putenv _ = that's_a_no_no let shGetFolderPath _ = that's_a_no_no let sendMessageTimeout _ _ _ _ _ = that's_a_no_no let getParentProcessID = that's_a_no_no let getConsoleAlias _ = that's_a_no_no opam-2.0.5/src/core/opamCompat.mli0000644000175000017500000000407313511367404016004 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module String #if OCAML_VERSION >= (4, 3, 0) = String #else : sig include module type of struct include String end val lowercase_ascii : string -> string val uppercase_ascii : string -> string val capitalize_ascii : string -> string end #endif module Char #if OCAML_VERSION >= (4, 3, 0) = Char #else : sig include module type of struct include Char end val lowercase_ascii: char -> char end #endif module Printexc #if OCAML_VERSION >= (4, 5, 0) = Printexc #else : sig include module type of struct include Printexc end val raise_with_backtrace: exn -> raw_backtrace -> 'a end #endif module Unix #if OCAML_VERSION >= (4, 6, 0) = Unix #else : sig include module type of struct include Unix end val map_file : Unix.file_descr -> ?pos:int64 -> ('a, 'b) Bigarray.kind -> 'c Bigarray.layout -> bool -> int array -> ('a, 'b, 'c) Bigarray.Genarray.t end #endif module Uchar #if OCAML_VERSION >= (4, 3, 0) = Uchar #else : sig type t val of_int : int -> t external to_int : t -> int = "%identity" end #endif module Buffer #if OCAML_VERSION >= (4, 6, 0) = Buffer #else : sig include module type of struct include Buffer end val add_utf_8_uchar : t -> Uchar.t -> unit end #endif module Filename #if OCAML_VERSION >= (4, 4, 0) = Filename #else : sig include module type of struct include Filename end val extension : string -> string end #endif opam-2.0.5/src/core/opamJson.mli0000644000175000017500000000204313511367404015465 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Json encoder; only needed for some debug options {b Warning.} Assumes given strings are UTF-8 encoded this is not checked by the module. *) type t = [ `Null | `Bool of bool | `Float of float| `String of string | `A of t list | `O of (string * t) list ] val to_string : t -> string val append: string -> t -> unit val flush: out_channel -> unit opam-2.0.5/src/core/opamStd.mli0000644000175000017500000004343113511367404015314 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Generic stdlib functions (String, List, Option, Sys submodules...) *) (** {2 Signatures and functors} *) (** Sets with extended interface and infix operators *) module type SET = sig include Set.S val map: (elt -> elt) -> t -> t val is_singleton: t -> bool (** Returns one element, assuming the set is a singleton. Raises [Not_found] on an empty set, [Failure] on a non-singleton. *) val choose_one : t -> elt val of_list: elt list -> t val to_string: t -> string val to_json: t -> OpamJson.t val find: (elt -> bool) -> t -> elt val find_opt: (elt -> bool) -> t -> elt option (** Raises Failure in case the element is already present *) val safe_add: elt -> t -> t module Op : sig val (++): t -> t -> t (** Infix set union *) val (--): t -> t -> t (** Infix set difference *) val (%%): t -> t -> t (** Infix set intersection *) end end (** Maps with extended interface *) module type MAP = sig include Map.S val to_string: ('a -> string) -> 'a t -> string val to_json: ('a -> OpamJson.t) -> 'a t -> OpamJson.t val keys: 'a t -> key list val values: 'a t -> 'a list val find_opt: key -> 'a t -> 'a option (** A key will be in the union of [m1] and [m2] if it is appears either [m1] or [m2], with the corresponding value. If a key appears in both [m1] and [m2], then the resulting value is built using the function given as argument. *) val union: ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t val is_singleton: 'a t -> bool val of_list: (key * 'a) list -> 'a t (** Raises Failure in case the element is already present *) val safe_add: key -> 'a -> 'a t -> 'a t (** [update k f zero map] updates the binding of [k] in [map] using function [f], applied to the current value bound to [k] or [zero] if none *) val update: key -> ('a -> 'a) -> 'a -> 'a t -> 'a t end (** A signature for handling abstract keys and collections thereof *) module type ABSTRACT = sig type t val of_string: string -> t val to_string: t -> string val to_json: t -> OpamJson.t module Set: SET with type elt = t module Map: MAP with type key = t end (** A basic implementation of ABSTRACT using strings *) module AbstractString : ABSTRACT with type t = string (** {3 Generators for set and map modules with printers} *) module type OrderedType = sig include Set.OrderedType val to_string: t -> string val to_json: t -> OpamJson.t end module Set: sig module Make (S: OrderedType): SET with type elt = S.t end module Map: sig module Make (S: OrderedType): MAP with type key = S.t end (** {2 Integer collections} *) (** Map of ints *) module IntMap: MAP with type key = int (** Set of ints *) module IntSet: SET with type elt = int (** {2 Utility modules extending the standard library on base types} *) module Option: sig val map: ('a -> 'b) -> 'a option -> 'b option val iter: ('a -> unit) -> 'a option -> unit val default: 'a -> 'a option -> 'a val default_map: 'a option -> 'a option -> 'a option val replace : ('a -> 'b option) -> 'a option -> 'b option val map_default: ('a -> 'b) -> 'b -> 'a option -> 'b val compare: ('a -> 'a -> int) -> 'a option -> 'a option -> int val to_string: ?none:string -> ('a -> string) -> 'a option -> string val some: 'a -> 'a option val none: 'a -> 'b option (** [of_Not_found f x] calls [f x], catches [Not_found] and returns [None] *) val of_Not_found: ('a -> 'b) -> 'a -> 'b option module Op: sig val (>>=): 'a option -> ('a -> 'b option) -> 'b option val (>>|): 'a option -> ('a -> 'b) -> 'b option val (>>+): 'a option -> (unit -> 'a option) -> 'a option val (+!): 'a option -> 'a -> 'a val (++): 'a option -> 'a option -> 'a option end end module List : sig val cons: 'a -> 'a list -> 'a list (** Convert list items to string and concat. [sconcat_map sep f x] is equivalent to String.concat sep (List.map f x) but tail-rec. *) val concat_map: ?left:string -> ?right:string -> ?nil:string -> ?last_sep:string -> string -> ('a -> string) -> 'a list -> string (** Like [List.find], but returning option instead of raising *) val find_opt: ('a -> bool) -> 'a list -> 'a option val to_string: ('a -> string) -> 'a list -> string (** Removes consecutive duplicates in a list *) val remove_duplicates: 'a list -> 'a list (** Sorts the list, removing duplicates *) val sort_nodup: ('a -> 'a -> int) -> 'a list -> 'a list (** Filter and map *) val filter_map: ('a -> 'b option) -> 'a list -> 'b list (** Retrieves [Some] values from a list *) val filter_some: 'a option list -> 'a list (** Returns the first non-[None] value returned by the passed function on the elements of the passed list. @raise Not_found if all of them yield [None] *) val find_map: ('a -> 'b option) -> 'a list -> 'b (** Insert a value in an ordered list *) val insert: ('a -> 'a -> int) -> 'a -> 'a list -> 'a list (** Inserts a value at the given index (starting from 0) in the list (start or end if index < 0 or > length respectively). Not tail-recursive *) val insert_at: int -> 'a -> 'a list -> 'a list (** Like [List.assoc], but as an option, and also returns the list with the binding removed, e.g. equivalent to [(List.assoc_opt x l, List.remove_assoc x l)] (but tail-recursive and more efficient) *) val pick_assoc: 'a -> ('a * 'b) list -> 'b option * ('a * 'b) list (** [update_assoc key value list] updates the first value bound to [key] in the associative list [list], or appends [(key, value)] if the key is not bound. *) val update_assoc: 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list end module String : sig (** {3 Collections} *) module Map: MAP with type key = string module Set: SET with type elt = string (** Set of string sets *) module SetSet: SET with type elt = Set.t (** Map of string sets *) module SetMap: MAP with type key = Set.t (** {3 Checks} *) val starts_with: prefix:string -> string -> bool val ends_with: suffix:string -> string -> bool val contains_char: string -> char -> bool val contains: sub:string -> string -> bool val exact_match: Re.re -> string -> bool (** {3 Manipulation} *) val map: (char -> char) -> string -> string val strip: string -> string val strip_right: string -> string val sub_at: int -> string -> string val remove_prefix: prefix:string -> string -> string val remove_suffix: suffix:string -> string -> string (** {4 Transformations} *) (** Cut a string at the first occurrence of the given char *) val cut_at: string -> char -> (string * string) option (** Same as [cut_at], but starts from the right *) val rcut_at: string -> char -> (string * string) option (** Split a string at occurrences of a given characters. Empty strings are skipped. *) val split: string -> char -> string list (** The same as [split], but keep empty strings (leading, trailing or between contiguous delimiters) *) val split_delim: string -> char -> string list val fold_left: ('a -> char -> 'a) -> 'a -> string -> 'a end module Format : sig (** {4 Querying information} *) (** Returns the length of the string in terminal chars, ignoring ANSI color sequences from OpamConsole.colorise *) val visual_length: string -> int (** {4 Text formatting functions} *) (** Truncates the string to not visually get over [width] columns *) val cut_at_visual: string -> int -> string (** left indenting. [~visual] can be used to indent eg. ANSI colored strings and should correspond to the visible characters of s *) val indent_left: string -> ?visual:string -> int -> string val indent_right: string -> ?visual:string -> int -> string (** Pads fields in a table with spaces for alignment. *) val align_table: string list list -> string list list (** Cut long lines in string according to the terminal width *) val reformat: ?start_column:int -> ?indent:int -> ?width:int -> string -> string (** Convert a list of items to string as a dashed list (already reformats supposes no additional left margin: don't use within OpamConsole.error or similar) *) val itemize: ?bullet:string -> ('a -> string) -> 'a list -> string (** Display a pretty list: ["x";"y";"z"] -> "x, y and z". "and" can be changed by specifying [last] *) val pretty_list: ?last:string -> string list -> string end module Exn : sig (** To use when catching default exceptions: ensures we don't catch fatal errors like C-c. try-with should _always_ (by decreasing order of preference): - either catch specific exceptions - or re-raise the same exception (preferably with [Exn.finalise]) - or call this function on the caught exception *) val fatal: exn -> unit (** Register a backtrace for when you need to process a finalizer (that internally uses exceptions) and then re-raise the same exception. To be printed by pretty_backtrace. *) val register_backtrace: exn -> unit (** Return a pretty-printed backtrace *) val pretty_backtrace: exn -> string (** Runs the given finaliser, then reraises the given exception, while preserving backtraces (when the OCaml version permits, e.g. >= 4.05.0) *) val finalise: exn -> (unit -> unit) -> 'a (** Execute the given continuation, then run the finaliser before returning the result. If an exception is raised, call [finalise] with the given finaliser. *) val finally: (unit -> unit) -> (unit -> 'a) -> 'a end (** {2 Manipulation and query of environment variables} *) module Env : sig (** Remove from a c-separated list of string the ones with the given prefix *) val reset_value: prefix:string -> char -> string -> string list (** split a c-separated list of string in two according to the first occurrences of the string with the given [prefix]. The list of elements occurring before is returned in reverse order. If there are other elements with the same [prefix] they are kept in the second list. *) val cut_value: prefix:string -> char -> string -> string list * string list val get: string -> string val getopt: string -> string option val list: unit -> (string * string) list (** Utility function for shell single-quoted strings. In most shells, backslash escapes are not allowed and a single quote needs to be replaced by [quote double-quote quote double-quote quote] (close the single-quoted literal, put the single quote in a double-quoted literal, and reopen a single-quoted literal). fish is the exception and should set [using_backslashes] to escape both quotes and backslashes using backslashes *) val escape_single_quotes: ?using_backslashes:bool -> string -> string end (** {2 System query and exit handling} *) module Sys : sig (** {3 Querying} *) (** true if stdout is bound to a terminal *) val tty_out : bool (** true if stdin is bound to a terminal *) val tty_in : bool (** Queried lazily, but may change on SIGWINCH *) val terminal_columns : unit -> int (** The user's home directory. Queried lazily *) val home: unit -> string (** The /etc directory *) val etc: unit -> string type os = Darwin | Linux | FreeBSD | OpenBSD | NetBSD | DragonFly | Cygwin | Win32 | Unix | Other of string (** Queried lazily *) val os: unit -> os (** The output of the command "uname", with the given argument. Memoised. *) val uname: string -> string option (** Append .exe (only if missing) to executable filenames on Windows *) val executable_name : string -> string (** The different families of shells we know about *) type shell = SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish (** Guess the shell compat-mode *) val guess_shell_compat: unit -> shell (** Guess the location of .profile *) val guess_dot_profile: shell -> string (** The separator character used in the PATH variable (varies depending on OS) *) val path_sep: char (** Splits a PATH-like variable separated with [path_sep]. More involved than it seems, because there may be quoting on Windows. By default, it returns the path cleaned (remove trailing, leading, contiguous delimiters). Optional argument [clean] permits to keep those empty strings. *) val split_path_variable: ?clean:bool -> string -> string list (** {3 Exit handling} *) (** Like Pervasives.at_exit but with the possibility to call manually (eg. before exec()) *) val at_exit: (unit -> unit) -> unit (** Calls the functions registered in at_exit. Unneeded if exiting normally *) val exec_at_exit: unit -> unit (** Indicates intention to exit the program with given exit code *) exception Exit of int (** Indicates intention to exec() the given command (parameters as per [Unix.execvpe]), after proper finalisations. It's the responsibility of the main function to catch this, call [exec_at_exit], and [Unix.execvpe]. *) exception Exec of string * string array * string array (** Raises [Exit i] *) (* val exit: int -> 'a *) type exit_reason = [ `Success | `False | `Bad_arguments | `Not_found | `Aborted | `Locked | `No_solution | `File_error | `Package_operation_error | `Sync_error | `Configuration_error | `Solver_failure | `Internal_error | `User_interrupt ] val exit_codes : (exit_reason * int) list val get_exit_code : exit_reason -> int (** Raises [Exit], with the code associated to the exit reason *) val exit_because: exit_reason -> 'a (**/**) type warning_printer = {mutable warning : 'a . ('a, unit, string, unit) format4 -> 'a} val set_warning_printer : warning_printer -> unit end (** {2 Windows-specific functions} *) module Win32 : sig (** Win32 Registry Hives and Values *) module RegistryHive : sig val to_string : OpamStubs.registry_root -> string val of_string : string -> OpamStubs.registry_root end val set_parent_pid : int32 -> unit (** Change which the pid written to by {!parent_putenv}. This function cannot be called after [parent_putenv]. *) val parent_putenv : string -> string -> bool (** Update an environment variable in the parent (i.e. shell) process's environment. *) val persistHomeDirectory : string -> unit (** [persistHomeDirectory value] sets the HOME environment variable in this and the parent process and also persists the setting to the user's registry and broadcasts the change to other processes. *) end (** {2 General use infix function combinators} *) module Op: sig (** Function application (with lower priority) (predefined in OCaml 4.01+) *) val (@@): ('a -> 'b) -> 'a -> 'b (** Pipe operator -- reverse application (predefined in OCaml 4.01+) *) val (|>): 'a -> ('a -> 'b) -> 'b (** Function composition : (f @* g) x =~ f (g x) *) val (@*): ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c (** Reverse function composition : (f @> g) x =~ g (f x) *) val (@>): ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c end (** {2 Helper functions to initialise configuration from the environment} *) module Config : sig type env_var = string val env_bool: env_var -> bool option val env_int: env_var -> int option (* Like [env_int], but accept boolean values for 0 and 1 *) val env_level: env_var -> int option val env_string: env_var -> string option val env_float: env_var -> float option val env_when: env_var -> [ `Always | `Never | `Auto ] option val env_when_ext: env_var -> [ `Extended | `Always | `Never | `Auto ] option val resolve_when: auto:(bool Lazy.t) -> [ `Always | `Never | `Auto ] -> bool (** Sets the OpamCoreConfig options, reading the environment to get default values when unspecified *) val init: ?noop:_ -> (unit -> unit) OpamCoreConfig.options_fun (** Like [init], but returns the given value. For optional argument stacking *) val initk: 'a -> 'a OpamCoreConfig.options_fun module type Sig = sig (** Read-only record type containing the lib's configuration options *) type t (** Type of functions with optional arguments for setting each of [t]'s fields, similarly named, and returning ['a] *) type 'a options_fun (** The default values of the options to use at startup *) val default: t (** Use to update any option in a [t], using the optional arguments of [options_fun]. E.g. [set opts ?option1:1 ?option4:"x" ()] *) val set: t -> (unit -> t) options_fun (** Same as [set], but passes the result to a continuation, allowing argument stacking *) val setk: (t -> 'a) -> t -> 'a options_fun (** The global reference containing the currently set library options. Access using [OpamXxxConfig.(!r.field)]. *) val r: t ref (** Updates the currently set options in [r] according to the optional arguments *) val update: ?noop:_ -> (unit -> unit) options_fun (** Sets the options, reading the environment to get default values when unspecified *) val init: ?noop:_ -> (unit -> unit) options_fun (** Sets the options like [init], but returns the given value (for arguments stacking) *) val initk: 'a -> 'a options_fun end end opam-2.0.5/src/core/opamConsole.ml0000644000175000017500000006363013511367404016016 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat (* Global configuration *) let debug () = OpamCoreConfig.(!r.debug_level) > 0 let verbose () = OpamCoreConfig.(!r.verbose_level) > 0 let dumb_term = lazy ( try OpamStd.Env.get "TERM" = "dumb" with Not_found -> not Sys.win32 ) let color = let auto = lazy ( OpamStd.Sys.tty_out && not (Lazy.force dumb_term) ) in fun () -> match OpamCoreConfig.(!r.color) with | `Always -> true | `Never -> false | `Auto -> Lazy.force auto let disp_status_line () = match OpamCoreConfig.(!r.disp_status_line) with | `Always -> true | `Never -> false | `Auto -> OpamStd.Sys.tty_out && (color () || not (Lazy.force dumb_term)) let utf8, utf8_extended = let auto = lazy ( if Sys.win32 then let attempt handle = let (info : OpamStubs.console_font_infoex) = let hConsoleOutput = OpamStubs.getStdHandle handle in OpamStubs.getCurrentConsoleFontEx hConsoleOutput false in (* * The Windows Console will be able to output Unicode as long as a * TrueType font has been selected (Consolas or Lucida Console are * installed by default) and the output code page has been set to * CP_UTF8 (65001) * TMPF_TRUETYPE = 0x4 (wingdi.h) *) info.fontFamily land 0x4 <> 0 && OpamStubs.getConsoleOutputCP () = 65001 in try attempt OpamStubs.STD_OUTPUT_HANDLE with Not_found -> try attempt OpamStubs.STD_INPUT_HANDLE with Not_found -> false else let checkv v = try Some (OpamStd.String.ends_with ~suffix:"UTF-8" (OpamStd.Env.get v)) with Not_found -> None in OpamStd.Option.Op.(checkv "LC_ALL" ++ checkv "LANG" +! false) ) in (fun () -> match OpamCoreConfig.(!r.utf8) with | `Always | `Extended -> true | `Never -> false | `Auto -> Lazy.force auto), (fun () -> match OpamCoreConfig.(!r.utf8) with | `Extended -> not Sys.win32 | `Always | `Never -> false | `Auto -> Lazy.force auto && OpamStd.Sys.(os () = Darwin)) module Symbols = struct let rightwards_arrow = Uchar.of_int 0x2192 let box_drawings_light_down_and_right = Uchar.of_int 0x250c let box_drawings_light_horizontal = Uchar.of_int 0x2500 let box_drawings_light_vertical = Uchar.of_int 0x2502 let box_drawings_light_up_and_right = Uchar.of_int 0x2514 let box_drawings_light_right = Uchar.of_int 0x2576 let circled_division_slash = Uchar.of_int 0x2298 let asterisk_operator = Uchar.of_int 0x2217 let north_east_arrow = Uchar.of_int 0x2197 let south_east_arrow = Uchar.of_int 0x2198 let clockwise_open_circle_arrow = Uchar.of_int 0x21bb let greek_small_letter_lambda = Uchar.of_int 0x03bb let latin_capital_letter_o_with_stroke = Uchar.of_int 0x00d8 let six_pointed_black_star = Uchar.of_int 0x2736 let upwards_arrow = Uchar.of_int 0x2191 let downwards_arrow = Uchar.of_int 0x2193 let up_down_arrow = Uchar.of_int 0x2195 end type win32_glyph_checker = { font: string; checker: OpamStubs.handle * OpamStubs.handle; glyphs: (Uchar.t, bool) Hashtbl.t; } let win32_glyph_checker = ref None let () = if Sys.win32 then let release_checker checker () = match checker with | {contents = Some {checker; _}} -> OpamStubs.delete_glyph_checker checker | _ -> () in at_exit (release_checker win32_glyph_checker) let utf8_symbol main ?(alternates=[]) s = if utf8 () then try let scalar = if Sys.win32 then let current_font = let open OpamStubs in try let stdout = getStdHandle OpamStubs.STD_OUTPUT_HANDLE in (getCurrentConsoleFontEx stdout false).faceName with Not_found -> let stderr = getStdHandle OpamStubs.STD_ERROR_HANDLE in (getCurrentConsoleFontEx stderr false).faceName in let checker = let new_checker = lazy {font = current_font; checker = OpamStubs.create_glyph_checker current_font; glyphs = Hashtbl.create 16} in match win32_glyph_checker with | {contents = Some {font; checker; _}} when font <> current_font -> OpamStubs.delete_glyph_checker checker; let checker = Lazy.force new_checker in win32_glyph_checker := Some checker; checker | {contents = None} -> let checker = Lazy.force new_checker in win32_glyph_checker := Some checker; checker | {contents = Some checker} -> checker in let check_glyph scalar = try Hashtbl.find checker.glyphs scalar with Not_found -> let has_glyph = OpamStubs.has_glyph checker.checker scalar in Hashtbl.add checker.glyphs scalar has_glyph; has_glyph in List.find check_glyph (main::alternates) else main in let b = Buffer.create 4 in Buffer.add_utf_8_uchar b scalar; Buffer.contents b with Failure _ | Not_found -> s else s let timer () = if debug () then let t = Unix.gettimeofday () in fun () -> Unix.gettimeofday () -. t else fun () -> 0. let global_start_time = Unix.gettimeofday () type text_style = [ `bold | `underline | `crossed | `black | `red | `green | `yellow | `blue | `magenta | `cyan | `white ] let style_code (c: text_style) = match c with | `bold -> "01" | `underline -> "04" | `crossed -> "09" | `black -> "30" | `red -> "31" | `green -> "32" | `yellow -> "33" | `blue -> "1;34" (* most terminals make blue unreadable unless bold *) | `magenta -> "35" | `cyan -> "36" | `white -> "37" (* not nestable *) let colorise style s = if not (color ()) then s else Printf.sprintf "\027[%sm%s\027[0m" (style_code style) s let colorise' styles s = if not (color ()) then s else Printf.sprintf "\027[%sm%s\027[0m" (String.concat ";" (List.map style_code styles)) s let acolor_with_width width c () s = let str = colorise c s in str ^ match width with | None -> "" | Some w -> if String.length str >= w then "" else String.make (w-String.length str) ' ' let acolor c () = colorise c let acolor_w width c oc s = output_string oc (acolor_with_width (Some width) c () s) type win32_color_mode = Shim | VT100 type _ shim_return = | Handle : (OpamStubs.handle * win32_color_mode) shim_return | Mode : win32_color_mode shim_return | Peek : (win32_color_mode -> bool) shim_return let enable_win32_vt100 ch = let hConsoleOutput = OpamStubs.getStdHandle ch in try let mode = OpamStubs.getConsoleMode hConsoleOutput in (* ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x4 *) let vt100_on = 0x4 in if mode land vt100_on <> 0 then (hConsoleOutput, VT100) else if OpamStubs.setConsoleMode hConsoleOutput (mode lor vt100_on) then begin let restore_console () = let mode = OpamStubs.getConsoleMode hConsoleOutput land (lnot vt100_on) in OpamStubs.setConsoleMode hConsoleOutput mode |> ignore in at_exit restore_console; (hConsoleOutput, VT100) end else (hConsoleOutput, Shim) with Not_found -> (hConsoleOutput, VT100) let stdout_state = lazy (enable_win32_vt100 OpamStubs.STD_OUTPUT_HANDLE) let stderr_state = lazy (enable_win32_vt100 OpamStubs.STD_ERROR_HANDLE) let get_win32_console_shim : type s . [ `stdout | `stderr ] -> s shim_return -> s = fun ch -> let ch = if ch = `stdout then stdout_state else stderr_state in function | Handle -> Lazy.force ch | Mode -> Lazy.force ch |> snd | Peek -> fun mode -> if Lazy.is_val ch then snd (Lazy.force ch) = mode else false (* * Layout of attributes (wincon.h) * * Bit 0 - Blue --\ * Bit 1 - Green } Foreground * Bit 2 - Red / * Bit 3 - Bold -/ * Bit 4 - Blue --\ * Bit 5 - Green } Background * Bit 6 - Red / * Bit 7 - Bold -/ * Bit 8 - Leading Byte * Bit 9 - Trailing Byte * Bit a - Top horizontal * Bit b - Left vertical * Bit c - Right vertical * Bit d - unused * Bit e - Reverse video * Bit f - Underscore *) let is_windows_10 = lazy (let (v, _, _, _) = OpamStubs.getWindowsVersion () in v >= 10) let win32_print_message ch msg = let ocaml_ch = match ch with | `stdout -> stdout | `stderr -> stderr in if get_win32_console_shim ch Peek VT100 then Printf.fprintf ocaml_ch "%s%!" msg else let (hConsoleOutput, mode) = get_win32_console_shim ch Handle in if mode = VT100 then begin output_string ocaml_ch msg; flush ocaml_ch end else let {OpamStubs.attributes; _} = OpamStubs.getConsoleScreenBufferInfo hConsoleOutput in let background = (attributes land 0b1110000) lsr 4 in let length = String.length msg in let execute_code = let color = ref (attributes land 0b1111) in let blend ?(inheritbold = true) bits = let bits = if inheritbold then (!color land 0b1000) lor (bits land 0b111) else bits in let result = (attributes land (lnot 0b1111)) lor (bits land 0b1000) lor ((bits land 0b111) lxor background) in color := (result land 0b1111); result in fun code -> let l = String.length code in assert (l > 0 && code.[0] = '['); let attributes = OpamStd.String.split (String.sub code 1 (l - 1)) ';' in let attributes = if attributes = [] then [""] else attributes in let f attributes attribute = match attribute with | "1" | "01" -> blend ~inheritbold:false (!color lor 0b1000) | "4" | "04" -> if Lazy.force is_windows_10 then attributes lor 0b1000000000000000 else (* Don't have underline, so change the background *) (attributes land (lnot 0b11111111)) lor 0b01110000 | "30" -> blend 0b000 | "31" -> blend 0b100 | "32" -> blend 0b010 | "33" -> blend 0b110 | "34" -> blend ~inheritbold:false 0b001 | "35" -> blend 0b101 | "36" -> blend 0b011 | "37" -> blend 0b111 | "0" | "" -> blend ~inheritbold:false 0b0111 | _ -> assert false in let attrs = (List.fold_left f (blend !color) attributes) in OpamStubs.setConsoleTextAttribute hConsoleOutput attrs in let rec f index start in_code = if index < length then let c = msg.[index] in if c = '\027' then begin assert (not in_code); let fragment = String.sub msg start (index - start) in let index = succ index in if fragment <> "" then Printf.fprintf ocaml_ch "%s%!" fragment; f index index true end else if in_code && c = 'm' then let fragment = String.sub msg start (index - start) in let index = succ index in execute_code fragment; f index index false else f (succ index) start in_code else let fragment = String.sub msg start (index - start) in if fragment <> "" then if in_code then execute_code fragment else Printf.fprintf ocaml_ch "%s%!" fragment else flush ocaml_ch in flush ocaml_ch; f 0 0 false let carriage_delete_unix _ = print_string "\r\027[K" let carriage_delete_windows () = let (hConsoleOutput, mode) = get_win32_console_shim `stdout Handle in match mode with | Shim -> let {OpamStubs.size = (w, _); cursorPosition = (_, row); _} = OpamStubs.getConsoleScreenBufferInfo hConsoleOutput in Printf.printf "\r%!"; OpamStubs.fillConsoleOutputCharacter hConsoleOutput '\000' w (0, row) |> ignore | VT100 -> carriage_delete_unix () let carriage_delete = if Sys.win32 then let carriage_delete = lazy ( match get_win32_console_shim `stdout Mode with | Shim -> carriage_delete_windows | VT100 -> carriage_delete_unix) in fun () -> Lazy.force carriage_delete () else carriage_delete_unix let displaying_status = ref false let clear_status_unix () = if !displaying_status then begin flush stdout; displaying_status := false end let clear_status = if Sys.win32 then let clear_status = lazy ( match get_win32_console_shim `stdout Mode with | Shim -> fun () -> carriage_delete_windows (); displaying_status := false | VT100 -> clear_status_unix) in fun () -> Lazy.force clear_status () else clear_status_unix let print_message = if Sys.win32 then fun ch fmt -> flush (if ch = `stdout then stderr else stdout); clear_status (); (* win32_print_message *always* flushes *) Printf.ksprintf (win32_print_message ch) fmt else fun ch fmt -> let output_string = let output_string ch s = output_string ch s; flush ch in match ch with | `stdout -> flush stderr; output_string stdout | `stderr -> flush stdout; output_string stderr in Printf.ksprintf output_string fmt let timestamp () = let time = Unix.gettimeofday () -. global_start_time in let tm = Unix.gmtime time in let msec = time -. (floor time) in Printf.ksprintf (colorise `blue) "%.2d:%.2d.%.3d" (tm.Unix.tm_hour * 60 + tm.Unix.tm_min) tm.Unix.tm_sec (int_of_float (1000.0 *. msec)) let log section ?(level=1) fmt = if level <= OpamCoreConfig.(!r.debug_level) then let () = clear_status () in if Sys.win32 then begin (* * In order not to break [slog], split the output into two. A side-effect * of this is that logging lines may not use colour. *) win32_print_message `stderr (Printf.sprintf "%s %a " (timestamp ()) (acolor_with_width (Some 30) `yellow) section); Printf.fprintf stderr (fmt ^^ "\n%!") end else Printf.fprintf stderr ("%s %a " ^^ fmt ^^ "\n%!") (timestamp ()) (acolor_w 30 `yellow) section else Printf.ifprintf stderr fmt (* Helper to pass stringifiers to log (use [log "%a" (slog to_string) x] rather than [log "%s" (to_string x)] to avoid costly unneeded stringifications *) let slog to_string channel x = output_string channel (to_string x) let error fmt = Printf.ksprintf (fun str -> print_message `stderr "%a %s\n" (acolor `red) "[ERROR]" (OpamStd.Format.reformat ~start_column:8 ~indent:8 str) ) fmt let warning fmt = Printf.ksprintf (fun str -> print_message `stderr "%a %s\n" (acolor `yellow) "[WARNING]" (OpamStd.Format.reformat ~start_column:10 ~indent:10 str) ) fmt let note fmt = Printf.ksprintf (fun str -> print_message `stderr "%a %s\n" (acolor `blue) "[NOTE]" (OpamStd.Format.reformat ~start_column:7 ~indent:7 str) ) fmt let errmsg fmt = print_message `stderr fmt let error_and_exit reason fmt = Printf.ksprintf (fun str -> error "%s" str; OpamStd.Sys.exit_because reason ) fmt let msg fmt = print_message `stdout fmt let formatted_msg ?indent fmt = Printf.ksprintf (fun s -> print_message `stdout "%s" (OpamStd.Format.reformat ?indent s)) fmt let last_status = ref "" let write_status_unix fmt = let print_string s = print_string s; flush stdout; carriage_delete_unix (); displaying_status := true in Printf.ksprintf print_string ("\r\027[K" ^^ fmt) let write_status_windows fmt = let print_string s = carriage_delete (); win32_print_message `stdout s; displaying_status := true in Printf.ksprintf print_string fmt let win32_print_functions = lazy ( match get_win32_console_shim `stdout Mode with | Shim -> (true, (fun s -> win32_print_message `stdout (s ^ "\n"))) | VT100 -> (false, print_endline)) let status_line fmt = let batch = debug () || not (disp_status_line ()) in let (use_shim, print_msg) = if Sys.win32 then Lazy.force win32_print_functions else (false, print_endline) in if batch then Printf.ksprintf (fun s -> if s <> !last_status then (last_status := s; print_msg s)) fmt else if use_shim then write_status_windows fmt else write_status_unix fmt let header_width () = min 80 (OpamStd.Sys.terminal_columns ()) let header_msg fmt = let utf8camel = "\xF0\x9F\x90\xAB " in (* UTF-8 *) let padding = "<><><><><><><><><><><><><><><><><><><><>\ <><><><><><><><><><><><><><><><><><><><><>" in Printf.ksprintf (fun str -> let wpad = header_width () - String.length str - 2 in let wpadl = 4 in let wpadr = wpad - wpadl - if utf8_extended () then 4 else 0 in print_message `stdout "\n%s %s %s%s\n" (colorise `cyan (String.sub padding 0 wpadl)) (colorise `bold str) (if wpadr > 0 then let padding = String.sub padding (String.length padding - wpadr) wpadr in colorise `cyan padding else "") (if wpadr >= 0 && utf8_extended () then " " ^ (colorise `yellow utf8camel) else ""); ) fmt let header_error fmt = let padding = "#=======================================\ ========================================#" in Printf.ksprintf (fun head fmt -> Printf.ksprintf (fun contents -> let wpad = header_width () - String.length head - 8 in let wpadl = 4 in let wpadr = wpad - wpadl in print_message `stderr "\n%s %s %s %s\n%s\n" (colorise `red (String.sub padding 0 wpadl)) (colorise `bold "ERROR") (colorise `bold head) (if wpadr > 0 then let padding = String.sub padding (String.length padding - wpadr) wpadr in colorise `red padding else "") contents ) fmt ) fmt let confirm ?(default=true) fmt = Printf.ksprintf (fun s -> try if OpamCoreConfig.(!r.safe_mode) then false else let prompt () = formatted_msg "%s [%s] " s (if default then "Y/n" else "y/N") in if OpamCoreConfig.(!r.answer) = Some true then (prompt (); msg "y\n"; true) else if OpamCoreConfig.(!r.answer) = Some false || OpamStd.Sys.(not tty_in) then (prompt (); msg "n\n"; false) else if OpamStd.Sys.(not tty_out || os () = Win32 || os () = Cygwin) then let rec loop () = prompt (); match String.lowercase_ascii (read_line ()) with | "y" | "yes" -> true | "n" | "no" -> false | "" -> default | _ -> loop () in loop () else let open Unix in prompt (); let buf = Bytes.create 1 in let rec loop () = let ans = try if read stdin buf 0 1 = 0 then raise End_of_file else Some (Char.lowercase_ascii (Bytes.get buf 0)) with | Unix.Unix_error (Unix.EINTR,_,_) -> None | Unix.Unix_error _ -> raise End_of_file in match ans with | Some 'y' -> print_endline (Bytes.to_string buf); true | Some 'n' -> print_endline (Bytes.to_string buf); false | Some '\n' -> print_endline (if default then "y" else "n"); default | _ -> loop () in let attr = tcgetattr stdin in let reset () = tcsetattr stdin TCSAFLUSH attr; tcflush stdin TCIFLUSH; in try tcsetattr stdin TCSAFLUSH {attr with c_icanon = false; c_echo = false}; tcflush stdin TCIFLUSH; let r = loop () in reset (); r with e -> reset (); raise e with | Unix.Unix_error _ | End_of_file -> msg "%s\n" (if default then "y" else "n"); default | Sys.Break as e -> msg "\n"; raise e ) fmt let read fmt = Printf.ksprintf (fun s -> formatted_msg "%s " s; if OpamCoreConfig.(!r.answer = None && not !r.safe_mode) then ( try match read_line () with | "" -> None | s -> Some s with | End_of_file -> msg "\n"; None | Sys.Break as e -> msg "\n"; raise e ) else None ) fmt let print_table ?cut oc ~sep table = let open OpamStd.Format in let cut = match cut with | None -> if oc = stdout || oc = stderr then `Wrap "" else `None | Some c -> c in let output_string s = if oc = stdout then msg "%s\n" s else if oc = stderr then errmsg "%s\n" s else begin output_string oc s; output_char oc '\n' end in let replace_newlines by = Re.(replace_string (compile (char '\n')) ~by) in let cleanup_trailing sl = let rec clean acc = function | s::r -> let s' = OpamStd.String.strip_right s in if s' = "" then clean acc r else List.rev_append r (s'::acc) | [] -> acc in clean [] (List.rev sl) in let print_line l = match cut with | `None -> let s = List.map (replace_newlines "\\n") l |> String.concat sep in output_string s; | `Truncate -> let s = List.map (replace_newlines " ") l |> String.concat sep in output_string (cut_at_visual s (OpamStd.Sys.terminal_columns ())); | `Wrap wrap_sep -> let width = OpamStd.Sys.terminal_columns () in let base_indent = 10 in let sep_len = visual_length sep in let wrap_sep_len = visual_length wrap_sep in let max_sep_len = max sep_len wrap_sep_len in let indent_string = String.make (max 0 (base_indent - wrap_sep_len)) ' ' ^ wrap_sep in let margin = visual_length indent_string in let min_reformat_width = 30 in let rec split_at_overflows start_col acc cur = let append = function | [] -> acc | last::r -> List.rev (OpamStd.String.strip_right last :: r) :: acc in function | [] -> List.rev (append cur) | cell::rest -> let multiline = String.contains cell '\n' in let cell_lines = OpamStd.String.split cell '\n' in let cell_width = List.fold_left max 0 (List.map visual_length cell_lines) in let text_width = List.fold_left max 0 (List.map (fun s -> visual_length (OpamStd.String.strip_right s)) cell_lines) in let end_col = start_col + sep_len + cell_width in let indent ~sep n cell = let spc = if sep then String.make (max 0 (if sep then n - wrap_sep_len else n)) ' ' ^ wrap_sep else String.make n ' ' in OpamStd.List.concat_map ("\n"^spc) OpamStd.String.strip_right (OpamStd.String.split cell '\n') in if start_col + sep_len + text_width <= width then if multiline then let cell = indent ~sep:true start_col (OpamStd.String.strip_right cell) in split_at_overflows margin (append (cell::cur)) [] rest else split_at_overflows end_col acc (cell::cur) rest else if rest = [] && acc = [] && not multiline && width - start_col - max_sep_len >= min_reformat_width then let cell = OpamStd.String.strip_right cell |> fun cell -> reformat ~width:(width - start_col - max_sep_len) cell |> indent ~sep:true start_col in split_at_overflows margin acc (cell::cur) [] else if multiline || margin + cell_width >= width then let cell = OpamStd.String.strip_right cell |> fun cell -> reformat ~width:(width - margin) cell |> fun cell -> OpamStd.String.split cell '\n' |> OpamStd.List.concat_map ("\n" ^ indent_string) OpamStd.String.strip_right in split_at_overflows margin ([cell]::append cur) [] rest else split_at_overflows (margin + cell_width) (append cur) [cell] rest in let splits = split_at_overflows 0 [] [] l in let str = OpamStd.List.concat_map ("\n" ^ String.make base_indent ' ') (String.concat sep) splits in output_string str; in List.iter (fun l -> print_line (cleanup_trailing l)) table (* This allows OpamStd.Config.env to display warning messages *) let () = OpamStd.Sys.(set_warning_printer {warning}) opam-2.0.5/src/core/opamCompat.ml0000644000175000017500000000520513511367404015631 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module String = #if OCAML_VERSION >= (4, 3, 0) String #else struct include String let lowercase_ascii = lowercase let uppercase_ascii = uppercase let capitalize_ascii = capitalize end #endif module Char = #if OCAML_VERSION >= (4, 3, 0) Char #else struct include Char let lowercase_ascii = lowercase end #endif module Printexc = #if OCAML_VERSION >= (4, 5, 0) Printexc #else struct include Printexc let raise_with_backtrace e _bt = raise e end #endif module Unix = #if OCAML_VERSION >= (4, 6, 0) Unix #else struct include Unix let map_file = Bigarray.Genarray.map_file end #endif module Uchar = #if OCAML_VERSION >= (4, 3, 0) Uchar #else struct type t = int let of_int i = i external to_int : t -> int = "%identity" end #endif module Buffer = #if OCAML_VERSION >= (4, 6, 0) Buffer #else struct include Buffer let add_utf_8_uchar b u = match Uchar.to_int u with | u when u < 0 -> assert false | u when u <= 0x007F -> add_char b (Char.unsafe_chr u) | u when u <= 0x07FF -> add_char b (Char.unsafe_chr (0xC0 lor (u lsr 6))); add_char b (Char.unsafe_chr (0x80 lor (u land 0x3F))) | u when u <= 0xFFFF -> add_char b (Char.unsafe_chr (0xE0 lor (u lsr 12))); add_char b (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F))); add_char b (Char.unsafe_chr (0x80 lor (u land 0x3F))) | u when u <= 0x10FFFF -> add_char b (Char.unsafe_chr (0xF0 lor (u lsr 18))); add_char b (Char.unsafe_chr (0x80 lor ((u lsr 12) land 0x3F))); add_char b (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F))); add_char b (Char.unsafe_chr (0x80 lor (u land 0x3F))) | _ -> assert false end #endif module Filename = #if OCAML_VERSION >= (4, 4, 0) Filename #else struct include Filename let extension fn = match Filename.chop_extension fn with | base -> let l = String.length base in String.sub fn l (String.length fn - l) | exception Invalid_argument _ -> "" end #endif opam-2.0.5/src/core/opamProcess.mli0000644000175000017500000002025213511367404016174 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Process and job handling, with logs, termination status, etc. *) (** The type of shell commands *) type command (** Builds a shell command for later execution. @param env environment for the command @param verbose force verbosity @param name title, used to name log files, etc. @param metadata additional info to log @param dir CWD for the command @param allow_stdin whether to forward stdin @param stdout redirect stdout to the given file instead of the logs @param text Short text that may be displayed in the status-line @param command The command itself @param args Command-line arguments *) val command: ?env:string array -> ?verbose:bool -> ?name:string -> ?metadata:(string*string) list -> ?dir:string -> ?allow_stdin:bool -> ?stdout:string -> ?text:string -> string -> string list -> command val string_of_command: command -> string val text_of_command: command -> string option val is_verbose_command: command -> bool (** Returns a label suitable for printing the summary of running commands. First string is the topic (e.g. package), second the action (e.g. command name). Optional command arguments may be used for details (e.g. make action). *) val make_command_text: ?color:OpamConsole.text_style -> string -> ?args:string list -> string -> string (** The type for processes *) type t = { p_name : string; (** Command name *) p_args : string list; (** Command args *) p_pid : int; (** Process PID *) p_cwd : string; (** Process initial working directory *) p_time : float; (** Process start time *) p_stdout : string option; (** stdout dump file *) p_stderr : string option; (** stderr dump file *) p_env : string option; (** dump environment variables *) p_info : string option; (** dump process info *) p_metadata: (string * string) list; (** Metadata associated to the process *) p_verbose: bool; (** whether output of the process should be displayed *) p_tmp_files: string list; (** temporary files that should be cleaned up upon completion *) } (** Process results *) type result = { r_code : int; (** Process exit code, or 256 on error *) r_signal : int option; (** Signal received if the processed was killed *) r_duration : float; (** Process duration *) r_info : (string * string) list; (** Process info *) r_stdout : string list; (** Content of stdout dump file *) r_stderr : string list; (** Content of stderr dump file *) r_cleanup : string list; (** List of files to clean-up *) } (** [run command] synchronously call the command [command.cmd] with arguments [command.args]. It waits until the process is finished. The files [name.info], [name.env], [name.out] and [name.err], with [name = command.cmd_name] are created, and contain the process main description, the environment variables, the standard output and the standard error. Don't forget to call [cleanup result] afterwards *) val run : command -> result (** Same as [run], but doesn't wait. Use wait_one to wait and collect results; Don't forget to call [cleanup result] afterwards *) val run_background: command -> t (** Similar to [run_background], except that no process is created, and a dummy process (suitable for dry_wait_one) is returned. *) val dry_run_background: command -> t (** [wait p] waits for the processus [p] to end and returns its results. Be careful to handle Sys.Break *) val wait: t -> result (** Like [wait], but returns None immediately if the process hasn't ended *) val dontwait: t -> result option (** Wait for the first of the listed processes to terminate, and return its termination status *) val wait_one: t list -> t * result (** Similar to [wait_one] for simulations, to be used with [dry_run_background] *) val dry_wait_one: t list -> t * result (** Send SIGINT to a process (or SIGKILL on Windows) *) val interrupt: t -> unit (** Is the process result a success? *) val is_success : result -> bool (** Is the process result a failure? *) val is_failure : result -> bool (** Should be called after process termination, to cleanup temporary files. Leaves artefacts in case OpamGlobals.debug is on and on failure, unless force has been set. *) val cleanup : ?force:bool -> result -> unit (** Like [is_success], with an added cleanup side-effect (as [cleanup ~force:true]). Use this when not returning 0 is not an error case: since the default behaviour is to cleanup only when the command returned 0, which is not what is expected in that case. *) val check_success_and_cleanup : result -> bool (** {2 Misc} *) (** Reads a text file and returns a list of lines *) val read_lines: string -> string list (** Detailed report on process outcome *) val string_of_result: ?color:OpamConsole.text_style -> result -> string (** Short report on process outcome *) val result_summary: result -> string (** Higher-level interface to allow parallelism *) module Job: sig (** Open type and add combinators. Meant to be opened *) module Op: sig type 'a job = | Done of 'a | Run of command * (result -> 'a job) (** Stage a shell command with its continuation, eg: {[ command "ls" ["-a"] @@> fun result -> if OpamProcess.is_success result then Done result.r_stdout else failwith "ls" ]} *) val (@@>): command -> (result -> 'a job) -> 'a job (** [job1 @@+ fun r -> job2] appends the computation of tasks in [job2] after [job1] *) val (@@+): 'a job -> ('a -> 'b job) -> 'b job (** [job @@| f] maps [f] on the results of [job]. Equivalent to [job @@+ fun r -> Done (f r)] *) val (@@|): 'a job -> ('a -> 'b) -> 'b job end (** Sequential run of a job *) val run: 'a Op.job -> 'a (** Same as [run] but doesn't actually run any shell command, and feed a dummy result to the cont. *) val dry_run: 'a Op.job -> 'a (** Catch exceptions raised within a job *) val catch: (exn -> 'a Op.job) -> (unit -> 'a Op.job) -> 'a Op.job (** Ignore all non-fatal exceptions raised by job and return default *) val ignore_errors: default:'a -> ?message:string -> (unit -> 'a Op.job) -> 'a Op.job (** Register an exception-safe finaliser in a job. [finally job fin] is equivalent to [catch job (fun e -> fin (); raise e) @@+ fun r -> fin (); Done r] *) val finally: (unit -> unit) -> (unit -> 'a Op.job) -> 'a Op.job (** Converts a list of commands into a job that returns None on success, or the first failed command and its result. Unless [keep_going] is true, stops on first error. *) val of_list: ?keep_going:bool -> command list -> (command * result) option Op.job (** As [of_list], but takes a list of functions that return the commands. The functions will only be evaluated when the command needs to be run. *) val of_fun_list: ?keep_going:bool -> (unit -> command) list -> (command * result) option Op.job (** Returns the job made of the the given homogeneous jobs run sequentially *) val seq: ('a -> 'a Op.job) list -> 'a -> 'a Op.job (** Sequentially maps jobs on a list *) val seq_map: ('a -> 'b Op.job) -> 'a list -> 'b list Op.job (** Sets and overrides text of the underlying commands *) val with_text: string -> 'a Op.job -> 'a Op.job end type 'a job = 'a Job.Op.job opam-2.0.5/src/core/opamParallel.mli0000644000175000017500000000707713511367404016324 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Parallel execution of jobs following a directed graph *) module type VERTEX = sig include OpamStd.OrderedType include Graph.Sig.COMPARABLE with type t := t end module type G = sig include Graph.Sig.I module Vertex: VERTEX with type t = V.t module Topological: sig val fold: (V.t -> 'a -> 'a) -> t -> 'a -> 'a end val has_cycle: t -> bool val scc_list: t -> V.t list list end (** When one job fails due to an exception, other running jobs are interrupted and reported with this sub-exception in the Errors list *) exception Aborted (** Simply parallel execution of tasks *) (** In the simple iter, map and reduce cases, ints are the indexes of the jobs in the list *) exception Errors of int list * (int * exn) list * int list val iter: jobs:int -> command:('a -> unit OpamProcess.job) -> ?dry_run:bool -> 'a list -> unit val map: jobs:int -> command:('a -> 'b OpamProcess.job) -> ?dry_run:bool -> 'a list -> 'b list val reduce: jobs:int -> command:('a -> 'b OpamProcess.job) -> merge:('b -> 'b -> 'b) -> nil:'b -> ?dry_run:bool -> 'a list -> 'b (** More complex parallelism with dependency graphs *) module type SIG = sig module G : G (** Runs the job [command ~pred v] for every node [v] in a graph, in topological order, using [jobs] concurrent processes. [pred] is the associative list of job results on direct predecessors of [v]. *) val iter: jobs:int -> command:(pred:(G.V.t * 'a) list -> G.V.t -> 'a OpamProcess.job) -> ?dry_run:bool -> ?mutually_exclusive:(G.V.t list list) -> G.t -> unit (** Same as [iter], but returns the results of all jobs as a [vertex,result] associative list *) val map: jobs:int -> command:(pred:(G.V.t * 'a) list -> G.V.t -> 'a OpamProcess.job) -> ?dry_run:bool -> ?mutually_exclusive:(G.V.t list list) -> G.t -> (G.V.t * 'a) list (** Raised when the [command] functions raised exceptions. Parameters are (successfully traversed nodes, exception nodes and corresponding exceptions, remaining nodes that weren't traversed) *) exception Errors of G.V.t list * (G.V.t * exn) list * G.V.t list (** Raised when the graph to traverse has cycles. Returns the cycles found. *) exception Cyclic of G.V.t list list end module Make (G : G) : SIG with module G = G and type G.V.t = G.V.t module type GRAPH = sig include Graph.Sig.I include Graph.Oper.S with type g = t module Topological : sig val fold : (V.t -> 'a -> 'a) -> t -> 'a -> 'a val iter : (V.t -> unit) -> t -> unit end module Parallel : SIG with type G.t = t and type G.V.t = vertex module Dot : sig val output_graph : out_channel -> t -> unit end val transitive_closure: ?reflexive:bool -> t -> unit end module MakeGraph (V: VERTEX) : GRAPH with type V.t = V.t opam-2.0.5/src/core/opamCoreConfig.mli0000644000175000017500000000560113511367404016575 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration options for the core lib (record, global reference and setter) *) type t = private { debug_level : int; (** Controls debug messages, 0 to disable *) verbose_level : int; (** Controls printing of external commands and output, 0 to disable, more means print more low-level commands *) color : [ `Always | `Never | `Auto ]; (** Console ANSI color control *) utf8 : [ `Extended | `Always | `Never | `Auto ]; (** Controls usage of UTF8 in OPAM-generated messages. Extended adds camel emojis *) disp_status_line: [ `Always | `Never | `Auto ]; (** Controls on-line display of parallel commands being run, using ANSI escapes *) answer : bool option; (** Affects interactive questions in OpamConsole: auto-answer with the given bool if Some *) safe_mode : bool; (** Fail on writes or delays, don't ask questions (for quick queries, e.g. for shell completion) *) log_dir : string; (** Where to store log and temporary files (output from commands...) *) keep_log_dir : bool; (** Whether to cleanup temporary and log files on exit *) errlog_length : int; (** The number of log lines displayed on process error. 0 for all *) merged_output : bool; (** If set, stderr of commands is merged into their stdout *) use_openssl : bool; (** If false, will use built-in hash functions without checking for an openssl executable first *) precise_tracking : bool; (** If set, will take full md5 of all files when checking diffs (to track installations), rather than rely on just file size and mtime *) } type 'a options_fun = ?debug_level:int -> ?verbose_level:int -> ?color:[ `Always | `Never | `Auto ] -> ?utf8:[ `Extended | `Always | `Never | `Auto ] -> ?disp_status_line:[ `Always | `Never | `Auto ] -> ?answer:bool option -> ?safe_mode:bool -> ?log_dir:string -> ?keep_log_dir:bool -> ?errlog_length:int -> ?merged_output:bool -> ?use_openssl:bool -> ?precise_tracking:bool -> 'a val default : t val set : t -> (unit -> t) options_fun val setk : (t -> 'a) -> t -> 'a options_fun val r : t ref val update : ?noop:_ -> (unit -> unit) options_fun (** [true] if OPAM was compiled in developer mode *) val developer : bool opam-2.0.5/src/core/opamJson.ml0000644000175000017500000000572613511367404015327 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type t = [ `Null | `Bool of bool | `Float of float| `String of string | `A of t list | `O of (string * t) list ] let addc b c = Buffer.add_char b c let adds b s = Buffer.add_string b s let adds_esc b s = let len = String.length s in let max_idx = len - 1 in let flush b start i = if start < len then Buffer.add_substring b s start (i - start); in let rec loop start i = match i > max_idx with | true -> flush b start i | false -> let next = i + 1 in match String.get s i with | '"' -> flush b start i; adds b "\\\""; loop next next | '\\' -> flush b start i; adds b "\\\\"; loop next next | '\x00' .. '\x1F' | '\x7F' (* US-ASCII control chars *) as c -> flush b start i; adds b (Printf.sprintf "\\u%04X" (Char.code c)); loop next next | _ -> loop start next in loop 0 0 let enc_json_string b s = addc b '"'; adds_esc b s; addc b '"' let enc_vsep b = addc b ',' let enc_lexeme b = function | `Null -> adds b "null" | `Bool true -> adds b "true" | `Bool false -> adds b "false" | `Float f -> Printf.bprintf b "%.16g" f | `String s -> enc_json_string b s | `Name n -> enc_json_string b n; addc b ':' | `As -> addc b '[' | `Ae -> addc b ']' | `Os -> addc b '{' | `Oe -> addc b '}' let enc_json b (json:t) = let enc = enc_lexeme in let enc_sep seq enc_seq k b = match seq with | [] -> enc_seq seq k b | seq -> enc_vsep b; enc_seq seq k b in let rec value v k b = match v with | `A vs -> arr vs k b | `O ms -> obj ms k b | `Null | `Bool _ | `Float _ | `String _ as v -> enc b v; k b and arr vs k b = enc b `As; arr_vs vs k b and arr_vs vs k b = match vs with | v :: vs' -> value v (enc_sep vs' arr_vs k) b | [] -> enc b `Ae; k b and obj ms k b = enc b `Os; obj_ms ms k b and obj_ms ms k b = match ms with | (n, v) :: ms -> enc b (`Name n); value v (enc_sep ms obj_ms k) b | [] -> enc b `Oe; k b in value json (fun _ -> ()) b let to_string (json:t) = let b = Buffer.create 1024 in enc_json b json; Buffer.contents b let json_buffer = ref [] let append key json = json_buffer := (key,json) :: !json_buffer let flush oc = let b = Buffer.create 1024 in let json = (`O (List.rev !json_buffer)) in let json = enc_json b json; Buffer.contents b in output_string oc json; flush oc opam-2.0.5/src/core/opamStubsTypes.ml0000644000175000017500000000573413511367404016542 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2018 MetaStack Solutions Ltd. *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Types for C stubs modules. *) (** CONSOLE_SCREEN_BUFFER_INFO struct (see https://docs.microsoft.com/en-us/windows/console/console-screen-buffer-info-str) *) type console_screen_buffer_info = { size: int * int; (** Width and height of the screen buffer *) cursorPosition: int * int; (** Current position of the console cursor (caret) *) attributes: int; (** Screen attributes; see https://docs.microsoft.com/en-us/windows/console/console-screen-buffers#_win32_character_attributes *) window: int * int * int * int; (** Coordinates of the upper-left and lower-right corners of the display window within the screen buffer *) maximumWindowSize: int * int; (** Maximum displayable size of the console for this screen buffer *) } (** CONSOLE_FONT_INFOEX struct (see https://docs.microsoft.com/en-us/windows/console/console-font-infoex) *) type console_font_infoex = { font: int; (** Index in the system's console font table *) fontSize: int * int; (** Size, in logical units, of the font *) fontFamily: int; (** Font pitch and family (low 8 bits only). See tmPitchAndFamily in https://msdn.microsoft.com/library/windows/desktop/dd145132 *) fontWeight: int; (** Font weight. Normal = 400; Bold = 700 *) faceName: string; (** Name of the typeface *) } (** Win32 API handles *) type handle (** Standard handle constants (see https://docs.microsoft.com/en-us/windows/console/getstdhandle) *) type stdhandle = STD_INPUT_HANDLE | STD_OUTPUT_HANDLE | STD_ERROR_HANDLE (** Win32 Root Registry Hives (see https://msdn.microsoft.com/en-us/library/windows/desktop/ms724836.aspx) *) type registry_root = | HKEY_CLASSES_ROOT | HKEY_CURRENT_CONFIG | HKEY_CURRENT_USER | HKEY_LOCAL_MACHINE | HKEY_USERS (** Win32 Registry Value Types (see https://msdn.microsoft.com/en-us/library/windows/desktop/ms724884.aspx *) type _ registry_value = | REG_SZ : string registry_value (** SHGetFolderPath flags *) type shGFP_type = | SHGFP_TYPE_CURRENT (** Retrieve the current path *) | SHGFP_TYPE_DEFAULT (** Retrieve the default path *) (** Windows Messages (at least, one of them!) *) type ('a, 'b, 'c) winmessage = | WM_SETTINGCHANGE : (int, string, int) winmessage (** See https://msdn.microsoft.com/en-us/library/windows/desktop/ms725497.aspx *) opam-2.0.5/src/solver/0000755000175000017500000000000013511367404013557 5ustar nicoonicooopam-2.0.5/src/solver/opamCudfSolver.ml0000644000175000017500000002167313511367404017053 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes include OpamCudfSolverSig let default_compat_criteria = { crit_default = "-removed,-notuptodate,-changed"; crit_upgrade = "-removed,-notuptodate,-changed"; crit_fixup = "-changed,-notuptodate"; crit_best_effort_prefix = None; } module type ExternalArg = sig val name: string val is_present: bool Lazy.t val command_name: string val command_args: OpamTypes.arg list val default_criteria: criteria_def end let call_external_solver command ~criteria ?timeout (_, universe,_ as cudf) = let solver_in = OpamFilename.of_string (OpamSystem.temp_file "solver-in") in let solver_out = OpamFilename.of_string (OpamSystem.temp_file "solver-out") in try let _ = let oc = OpamFilename.open_out solver_in in Cudf_printer.pp_cudf oc cudf; close_out oc in let () = let cmd = OpamFilter.single_command (fun v -> if not (OpamVariable.Full.is_global v) then None else match OpamVariable.to_string (OpamVariable.Full.variable v) with | "input" -> Some (S (OpamFilename.to_string solver_in)) | "output" -> Some (S (OpamFilename.to_string solver_out)) | "criteria" -> Some (S criteria) | "timeout" -> Some (S (string_of_float (OpamStd.Option.default 0. timeout))) | _ -> None) command in OpamSystem.command ~verbose:(OpamCoreConfig.(!r.debug_level >= 2)) cmd in OpamFilename.remove solver_in; if not (OpamFilename.exists solver_out) then raise (Common.CudfSolver.Error "no output") else if (let ic = OpamFilename.open_in solver_out in try let i = input_line ic in close_in ic; i = "FAIL" with End_of_file -> close_in ic; false) then raise Common.CudfSolver.Unsat else let r = Cudf_parser.load_solution_from_file (OpamFilename.to_string solver_out) universe in OpamFilename.remove solver_out; r with e -> OpamStd.Exn.finalise e @@ fun () -> OpamFilename.remove solver_in; OpamFilename.remove solver_out module External (E: ExternalArg) : S = struct let name = E.name let ext = ref None let is_present () = Lazy.force E.is_present let command_name = Some E.command_name let default_criteria = E.default_criteria let call = call_external_solver ((CString E.command_name, None) :: E.command_args) end module Aspcud_def = struct let name = "aspcud" let command_name = "aspcud" let is_present = lazy ( match OpamSystem.resolve_command command_name with | None -> false | Some cmd -> try match OpamSystem.read_command_output ~verbose:false ~allow_stdin:false [cmd; "-v"] with | [] -> false | s::_ -> match OpamStd.String.split s ' ' with | "aspcud"::_::v::_ when OpamVersionCompare.compare v "1.9" >= 0 -> OpamConsole.log "SOLVER" "Solver is aspcud >= 1.9: using latest version criteria"; true | _ -> false with OpamSystem.Process_error _ -> false ) let command_args = [ CIdent "input", None; CIdent "output", None; CIdent "criteria", None ] let default_criteria = { crit_default = "-count(removed),\ -sum(request,version-lag),\ -count(down),\ -sum(solution,version-lag),\ -count(changed)"; crit_upgrade = "-count(down),\ -count(removed),\ -sum(solution,version-lag),\ -count(new)"; crit_fixup = "-count(changed),\ -notuptodate(solution),-sum(solution,version-lag)"; crit_best_effort_prefix = Some "+sum(solution,opam-query),"; } end module Aspcud = External(Aspcud_def) module Aspcud_old_def = struct let name = "aspcud-old" let command_name = Aspcud_def.command_name let is_present = lazy (OpamSystem.resolve_command command_name <> None) let command_args = Aspcud_def.command_args let default_criteria = default_compat_criteria end module Aspcud_old = External(Aspcud_old_def) module Mccs_def = struct let name = "mccs" let command_name = "mccs" let is_present = lazy (OpamSystem.resolve_command command_name <> None) let command_args = [ CString "-i", None; CIdent "input", None; CString "-o", None; CIdent "output", None; CString "-lexagregate[%{criteria}%]", None; ] let default_criteria = { crit_default = "-removed,\ -count[version-lag:,true],\ -changed,\ -count[version-lag:,false],\ -new"; crit_upgrade = "-removed,\ -count[version-lag:,false],\ -new"; crit_fixup = "-changed,-count[version-lag:,false]"; crit_best_effort_prefix = Some "+count[opam-query:,false],"; } end module Mccs = External(Mccs_def) module Packup_def = struct let name = "packup" let command_name = "packup" let is_present = lazy (OpamSystem.resolve_command command_name <> None) let command_args = [ CIdent "input", None; CIdent "output", None; CString "-u", None; CIdent "criteria", None; ] let default_criteria = default_compat_criteria end module Packup = External(Packup_def) let make_custom_solver name args criteria = (module (External (struct let command_name = name let name = name ^ "-custom" let is_present = lazy true let command_args = args let default_criteria = criteria end)) : S) let default_solver_selection = OpamBuiltinMccs.all_backends @ [ (module Aspcud: S); (module Mccs: S); (module Aspcud_old: S); (module Packup: S); ] let extract_solver_param name = if OpamStd.String.ends_with ~suffix:")" name then match OpamStd.String.cut_at name '(' with | Some (xname, ext2) -> xname, Some (OpamStd.String.remove_suffix ~suffix:")" ext2) | None -> name, None else name, None let custom_solver cmd = match cmd with | [ CIdent name, _ ] | [ CString name, _ ] -> (try let xname, ext = extract_solver_param name in List.find (fun (module S: S) -> let n, _ = extract_solver_param S.name in (n = xname || n = Filename.basename xname || S.command_name = Some name) && (if ext <> None then S.ext := ext; S.is_present ())) default_solver_selection with Not_found -> OpamConsole.error_and_exit `Configuration_error "No installed solver matching the selected '%s' found" name) | ((CIdent name | CString name), _) :: args -> let criteria = try let corresponding_module = List.find (fun (module S: S) -> S.command_name = Some (Filename.basename name) && S.is_present ()) default_solver_selection in let module S = (val corresponding_module) in S.default_criteria with Not_found -> default_compat_criteria in make_custom_solver name args criteria | _ -> OpamConsole.error_and_exit `Configuration_error "Invalid custom solver command specified." let solver_of_string s = let args = OpamStd.String.split s ' ' in (custom_solver (List.map (fun a -> OpamTypes.CString a, None) args)) let has_builtin_solver () = List.exists (fun (module S: S) -> S.command_name = None && S.is_present ()) default_solver_selection let get_solver ?internal l = try List.find (fun (module S: S) -> (internal = None || internal = Some (S.command_name = None)) && S.is_present ()) l with Not_found -> OpamConsole.error_and_exit `Configuration_error "No available solver found. Make sure your solver configuration is \ correct. %s" (if has_builtin_solver () then "You can enforce use of the built-in solver with \ `--use-internal-solver'." else "This opam has been compiled without a built-in solver, so you need \ to install and configure an external one. See \ http://opam.ocaml.org/doc/Install.html#ExternalSolvers for details.") let get_name (module S: S) = let name, ext0 = extract_solver_param S.name in match !S.ext, ext0 with | Some e, _ | None, Some e -> Printf.sprintf "%s(%s)" name e | None, None -> name opam-2.0.5/src/solver/opamCudfSolverSig.ml0000644000175000017500000000231313511367404017504 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type criteria_def = { crit_default: string; crit_upgrade: string; crit_fixup: string; crit_best_effort_prefix: string option; } exception Timeout module type S = sig val name: string (** extra configurable solver parameters *) val ext: string option ref val is_present: unit -> bool val command_name: string option (** None means the solver is built-in *) val default_criteria: criteria_def val call: criteria:string -> ?timeout:float -> Cudf.cudf -> Cudf.preamble option * Cudf.universe end opam-2.0.5/src/solver/opamBuiltinMccs.ml.dummy0000644000175000017500000000215613511367404020340 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCudfSolverSig module S = struct let name = "builtin-dummy-solver" let is_present () = false let ext = ref None let command_name = None let default_criteria = { crit_default = ""; crit_upgrade = ""; crit_fixup = ""; crit_best_effort_prefix = None; } let call ~criteria:_ ?timeout:_ _cudf = failwith "This opam was compiled without a solver built in" end let all_backends = [ (module S: S) ] opam-2.0.5/src/solver/opamActionGraph.ml0000644000175000017500000002363413511367404017175 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2014 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes module type ACTION = sig type package module Pkg : GenericPackage with type t = package include OpamParallel.VERTEX with type t = package action val to_string: [< t ] -> string val to_aligned_strings: ?append:(package -> string) -> [< t ] list -> string list list module Set: OpamStd.SET with type elt = package action module Map: OpamStd.MAP with type key = package action end let name_of_action = function | `Remove _ -> "remove" | `Install _ -> "install" | `Change (`Up,_,_) -> "upgrade" | `Change (`Down,_,_) -> "downgrade" | `Reinstall _ -> "recompile" | `Build _ -> "build" let symbol_of_action = let open OpamConsole in function | `Remove _ -> utf8_symbol Symbols.circled_division_slash ~alternates:[Symbols.greek_small_letter_lambda] "X" | `Install _ -> utf8_symbol Symbols.asterisk_operator ~alternates:[Symbols.six_pointed_black_star] "*" | `Change (`Up,_,_) -> utf8_symbol Symbols.north_east_arrow ~alternates:[Symbols.upwards_arrow] "U" | `Change (`Down,_,_) -> utf8_symbol Symbols.south_east_arrow ~alternates:[Symbols.downwards_arrow] "D" | `Reinstall _ -> utf8_symbol Symbols.clockwise_open_circle_arrow ~alternates:[Symbols.up_down_arrow] "R" | `Build _ -> utf8_symbol Symbols.greek_small_letter_lambda ~alternates:[Symbols.six_pointed_black_star] "B" let action_strings ?utf8 a = if utf8 = None && (OpamConsole.utf8 ()) || utf8 = Some true then symbol_of_action a else name_of_action a let action_color c = OpamConsole.colorise (match c with | `Install _ | `Change (`Up,_,_) -> `green | `Remove _ | `Change (`Down,_,_) -> `red | `Reinstall _ -> `yellow | `Build _ -> `cyan) module MakeAction (P: GenericPackage) : ACTION with type package = P.t = struct module Pkg = P type package = P.t type t = package action let compare t1 t2 = (* `Install > `Build > `Upgrade > `Reinstall > `Downgrade > `Remove *) match t1,t2 with | `Remove p, `Remove q | `Install p, `Install q | `Reinstall p, `Reinstall q | `Build p, `Build q -> P.compare p q | `Change (`Up,p0,p), `Change (`Up,q0,q) | `Change (`Down,p0,p), `Change (`Down,q0,q) -> let c = P.compare p q in if c <> 0 then c else P.compare p0 q0 | `Install _, _ | _, `Remove _ -> 1 | _, `Install _ | `Remove _, _ -> -1 | `Build _, _ | _, `Change (`Down,_,_) -> 1 | `Change (`Down,_,_), _ | _, `Build _ -> -1 | `Change (`Up,_,_), `Reinstall _ -> 1 | `Reinstall _, `Change(`Up,_,_) -> -1 let hash a = Hashtbl.hash (OpamTypesBase.map_action P.hash a) let equal t1 t2 = compare t1 t2 = 0 let to_string a = match a with | `Remove p | `Install p | `Reinstall p | `Build p -> Printf.sprintf "%s %s" (action_strings a) (P.to_string p) | `Change (_,p0,p) -> Printf.sprintf "%s.%s %s %s" (P.name_to_string p0) (P.version_to_string p0) (action_strings a) (P.version_to_string p) let to_aligned_strings ?(append=(fun _ -> "")) l = List.map (fun a -> let a = (a :> package action) in (if OpamConsole.utf8 () then action_color a (symbol_of_action a) else "-") :: name_of_action a :: OpamConsole.colorise `bold (P.name_to_string (OpamTypesBase.action_contents a)) :: match a with | `Remove p | `Install p | `Reinstall p | `Build p -> (P.version_to_string p ^ append p) :: [] | `Change (_,p0,p) -> Printf.sprintf "%s to %s" (P.version_to_string p0 ^ append p0) (P.version_to_string p ^ append p) :: []) l let to_json = function | `Remove p -> `O ["remove", P.to_json p] | `Install p -> `O ["install", P.to_json p] | `Change (_, o, p) -> `O ["change", `A [P.to_json o;P.to_json p]] | `Reinstall p -> `O ["recompile", P.to_json p] | `Build p -> `O ["build", P.to_json p] module O = struct type t = package action let compare = compare let to_string = to_string let to_json = to_json end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) end module type SIG = sig type package include OpamParallel.GRAPH with type V.t = package OpamTypes.action val reduce: t -> t val explicit: ?noop_remove:(package -> bool) -> t -> t val fold_descendants: (V.t -> 'a -> 'a) -> 'a -> t -> V.t -> 'a end module Make (A: ACTION) : SIG with type package = A.package = struct type package = A.package include OpamParallel.MakeGraph(A) module Map = OpamStd.Map.Make (A.Pkg) module Set = OpamStd.Set.Make (A.Pkg) (* Turn concrete actions (only install, remove and build) to higher-level actions (install, remove, up/downgrade, recompile). Builds are removed when they directly precede an install, which should be the case when [explicit] is used. *) let reduce g = let g = copy g in let removals = fold_vertex (fun v acc -> match v with | `Remove p -> OpamStd.String.Map.add (A.Pkg.name_to_string p) p acc | _ -> acc) g OpamStd.String.Map.empty in iter_vertex (function | `Build p as build -> (match fold_succ (fun v _ -> if v = `Install p then Some v else None) g build None with | None -> () | Some inst -> iter_pred (fun pred -> add_edge g pred inst) g build; remove_vertex g build) | _ -> ()) g; let reduced = ref Map.empty in let g = map_vertex (function | `Install p as act -> (try let p0 = OpamStd.String.Map.find (A.Pkg.name_to_string p) removals in let act = match A.Pkg.compare p0 p with | 0 -> `Reinstall p | c -> `Change ((if c < 0 then `Up else `Down), p0, p) in reduced := Map.add p0 act !reduced; act with Not_found -> act) | act -> act) g in Map.iter (fun p act -> let rm_act = `Remove p in iter_pred (fun v -> add_edge g v act) g rm_act; remove_vertex g rm_act ) !reduced; g let compute_closed_predecessors noop_remove g = let closed_g = copy g in transitive_closure closed_g; let closed_packages = (* The set of package that do not have dependencies (in the action graph). *) fold_vertex (fun a acc -> match a with | `Build p -> let pred = (* We ignore predecessors that do not modify the prefix *) List.filter (function | `Remove nv -> not (noop_remove nv) | _ -> true) (pred closed_g a) in if pred = [] then Set.add p acc else acc | _ -> acc) g Set.empty in let dependent_base_packages = fold_vertex (fun a acc -> match a with | `Install p | `Reinstall p | `Change (_,_,p) -> let preds = List.filter (function | `Build p -> Set.mem p closed_packages | _ -> false) (pred closed_g a) in OpamStd.String.Map.add (A.Pkg.name_to_string p) preds acc | _ -> acc) g OpamStd.String.Map.empty in function p -> match OpamStd.String.Map.find_opt (A.Pkg.name_to_string p) dependent_base_packages with | None -> [] | Some pred -> pred let explicit ?(noop_remove = (fun _ -> false)) g0 = let g = copy g0 in let same_name p1 p2 = A.Pkg.(name_to_string p1 = name_to_string p2) in (* We insert a "build" action before any "install" action. Except, between the removal and installation of the same package (the removal might be postponed after a succesfull build. *) iter_vertex (fun a -> match a with | `Install p | `Reinstall p | `Change (_,_,p) -> let b = `Build p in iter_pred (function | `Remove p1 when same_name p p1 -> () | pred -> remove_edge g pred a; add_edge g pred b) g0 a; add_edge g b a | `Remove _ -> () | `Build _ -> assert false) g0; (* For delaying removal a little bit, for each action "remove A" we add a constraint "build B -> remove A" for transitive predecessors of "A" that do not have dependencies. For adding a little bit more delay, we ignore dependencies that do not modify the prefix (see [OpamAction.noop_remove]) *) let closed_predecessors = compute_closed_predecessors noop_remove g in iter_vertex (function | `Remove p as a -> List.iter (fun b -> add_edge g b a) (closed_predecessors p) | `Install _ | `Reinstall _ | `Change _ | `Build _ -> ()) g; g let fold_descendants f acc t v = let rec aux seen f acc t v = if A.Set.mem v seen then seen, acc else fold_succ (fun v (seen, acc) -> aux seen f acc t v) t v (A.Set.add v seen, f v acc) in snd (aux A.Set.empty f acc t v) end opam-2.0.5/src/solver/opamBuiltinMccs.mli0000644000175000017500000000135213511367404017354 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) val all_backends: (module OpamCudfSolverSig.S) list opam-2.0.5/src/solver/opamSolverConfig.ml0000644000175000017500000001513113511367404017367 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type t = { cudf_file: string option; solver: (module OpamCudfSolver.S) Lazy.t; best_effort: bool; (* The following are options because the default can only be known once the solver is known, so we set it only if no customisation was made *) solver_preferences_default: string option Lazy.t; solver_preferences_upgrade: string option Lazy.t; solver_preferences_fixup: string option Lazy.t; solver_preferences_best_effort_prefix: string option Lazy.t; solver_timeout: float option; } type 'a options_fun = ?cudf_file:string option -> ?solver:((module OpamCudfSolver.S) Lazy.t) -> ?best_effort:bool -> ?solver_preferences_default:string option Lazy.t -> ?solver_preferences_upgrade:string option Lazy.t -> ?solver_preferences_fixup:string option Lazy.t -> ?solver_preferences_best_effort_prefix:string option Lazy.t -> ?solver_timeout:float option -> 'a let default = let solver = lazy ( OpamCudfSolver.get_solver OpamCudfSolver.default_solver_selection ) in { cudf_file = None; solver; best_effort = false; solver_preferences_default = lazy None; solver_preferences_upgrade = lazy None; solver_preferences_fixup = lazy None; solver_preferences_best_effort_prefix = lazy None; solver_timeout = Some 60.; } let setk k t ?cudf_file ?solver ?best_effort ?solver_preferences_default ?solver_preferences_upgrade ?solver_preferences_fixup ?solver_preferences_best_effort_prefix ?solver_timeout = let (+) x opt = match opt with Some x -> x | None -> x in k { cudf_file = t.cudf_file + cudf_file; solver = t.solver + solver; best_effort = t.best_effort + best_effort; solver_preferences_default = t.solver_preferences_default + solver_preferences_default; solver_preferences_upgrade = t.solver_preferences_upgrade + solver_preferences_upgrade; solver_preferences_fixup = t.solver_preferences_fixup + solver_preferences_fixup; solver_preferences_best_effort_prefix = t.solver_preferences_best_effort_prefix + solver_preferences_best_effort_prefix; solver_timeout = t.solver_timeout + solver_timeout; } let set t = setk (fun x () -> x) t let r = ref default let update ?noop:_ = setk (fun cfg () -> r := cfg) !r let with_auto_criteria config = let criteria = lazy ( let module S = (val Lazy.force config.solver) in S.default_criteria ) in set config ~solver_preferences_default: (lazy (match config.solver_preferences_default with | lazy None -> Some (Lazy.force criteria).OpamCudfSolver.crit_default | lazy some -> some)) ~solver_preferences_upgrade: (lazy (match config.solver_preferences_upgrade with | lazy None -> Some (Lazy.force criteria).OpamCudfSolver.crit_upgrade | lazy some -> some)) ~solver_preferences_fixup: (lazy (match config.solver_preferences_fixup with | lazy None -> Some (Lazy.force criteria).OpamCudfSolver.crit_fixup | lazy some -> some)) ~solver_preferences_best_effort_prefix: (lazy (match config.solver_preferences_best_effort_prefix with | lazy None -> (Lazy.force criteria).OpamCudfSolver.crit_best_effort_prefix | lazy some -> some)) () let initk k = let open OpamStd.Config in let open OpamStd.Option.Op in let solver = let open OpamCudfSolver in match env_string "EXTERNALSOLVER" with | Some "" -> lazy (get_solver ~internal:true default_solver_selection) | Some s -> lazy (solver_of_string s) | None -> let internal = env_bool "USEINTERNALSOLVER" ++ env_bool "NOASPCUD" in lazy (get_solver ?internal default_solver_selection) in let best_effort = env_bool "BESTEFFORT" in let criteria = env_string "CRITERIA" >>| fun c -> lazy (Some c) in let upgrade_criteria = (env_string "UPGRADECRITERIA" >>| fun c -> lazy (Some c)) ++ criteria in let fixup_criteria = env_string "FIXUPCRITERIA" >>| fun c -> (lazy (Some c)) in let best_effort_prefix_criteria = env_string "BESTEFFORTPREFIXCRITERIA" >>| fun c -> (lazy (Some c)) in let solver_timeout = env_float "SOLVERTIMEOUT" >>| fun f -> if f <= 0. then None else Some f in setk (setk (fun c -> r := with_auto_criteria c; k)) !r ~cudf_file:(env_string "CUDFFILE") ~solver ?best_effort ?solver_preferences_default:criteria ?solver_preferences_upgrade:upgrade_criteria ?solver_preferences_fixup:fixup_criteria ?solver_preferences_best_effort_prefix:best_effort_prefix_criteria ?solver_timeout let init ?noop:_ = initk (fun () -> ()) let best_effort = let r = lazy ( !r.best_effort && let crit = match Lazy.force !r.solver_preferences_default with | Some c -> c | None -> failwith "Solver criteria uninitialised" in let pfx = Lazy.force !r.solver_preferences_best_effort_prefix in pfx <> None || OpamStd.String.contains ~sub:"opam-query" crit || (OpamConsole.warning "Your solver configuration does not support --best-effort, the option \ was ignored (you need to specify variable OPAMBESTEFFORTCRITERIA, or \ set your criteria to maximise the count for cudf attribute \ 'opam-query')"; false) ) in fun () -> Lazy.force r let criteria kind = let crit = match kind with | `Default -> !r.solver_preferences_default | `Upgrade -> !r.solver_preferences_upgrade | `Fixup -> !r.solver_preferences_fixup in let str = match Lazy.force crit with | Some c -> c | None -> failwith "Solver criteria uninitialised" in if !r.best_effort then match !r.solver_preferences_best_effort_prefix with | lazy (Some pfx) -> pfx ^ str | lazy None -> str else str let call_solver ~criteria cudf = let module S = (val Lazy.force (!r.solver)) in OpamConsole.log "SOLVER" "Calling solver %s with criteria %s" (OpamCudfSolver.get_name (module S)) criteria; S.call ~criteria ?timeout:(!r.solver_timeout) cudf opam-2.0.5/src/solver/dune0000644000175000017500000000074713511367404014445 0ustar nicoonicoo(library (name opam_solver) (public_name opam-solver) (synopsis "OCaml Package Manager solver interaction library") (libraries opam-format cudf dose3.algo (select opamBuiltinMccs.ml from (mccs -> opamBuiltinMccs.ml.real) ( -> opamBuiltinMccs.ml.dummy))) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (wrapped false)) opam-2.0.5/src/solver/opamCudf.mli0000644000175000017500000002076613511367404016033 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Solver interaction through Cudf, conversion of solver answer to an opam solution *) open OpamTypes (** Cudf sets *) module Set: OpamStd.SET with type elt = Cudf.package (** Cudf maps *) module Map: OpamStd.MAP with type key = Cudf.package (** Cudf graph *) module Graph: sig (** Graph of cudf packages *) include module type of Algo.Defaultgraphs.PackageGraph.G (** Build a graph from a CUDF universe. Warning: dependency edges are towards the dependency, which is the reverse of what happens in the action graph. *) val of_universe: Cudf.universe -> t (** Return the transitive closure of [g] *) val transitive_closure: t -> t (** Return the transitive closure of dependencies of [set], sorted in topological order. *) val close_and_linearize: t -> Set.t -> Cudf.package list (** Reverse the direction of all edges *) val mirror: t -> t end (** Computation of differences between universe. Returns the sets of packages to install and remove respectively. *) val diff: Cudf.universe -> Cudf.universe -> (Set.t * Set.t) (** Cudf action graph *) module ActionGraph: OpamActionGraph.SIG with type package = Cudf.package (** Abstract type that may be returned in case of conflicts *) type conflict (** Return the transitive closure of dependencies of [set], sorted in topological order *) val dependencies: Cudf.universe -> Cudf.package list -> Cudf.package list (** Return the transitive closure of dependencies of [set], sorted in topological order *) val reverse_dependencies: Cudf.universe -> Cudf.package list -> Cudf.package list (** Check if a request is satisfiable and return the reasons why not unless [explain] is set to [false] *) val check_request: ?explain:bool -> version_map:int OpamPackage.Map.t -> Cudf.universe -> Cudf_types.vpkg request -> (Cudf.universe, conflict) result (** Compute the final universe state using the external solver. *) val get_final_universe: version_map:int OpamPackage.Map.t -> Cudf.universe -> Cudf_types.vpkg request -> (Cudf.universe, conflict) result (** Compute the list of actions to match the difference between two universe. Remark: the result order is unspecified, ie. need to use [atomic_actions] to get a solution which respects the topological order induced by dependencies. *) val actions_of_diff: (Set.t * Set.t) -> Cudf.package atomic_action list exception Cyclic_actions of Cudf.package action list list (** Computes the actions to process from a solution, from the actions obtained by a simple universe diff. The 'simple' universe should not contain build dependencies and will be used for resolution ; [complete_universe] should include build-deps, it's used to get the dependency ordering of actions. Returns a graph of atomic actions, i.e. only removals and installs. Use [reduce_actions] to reduce it to a graph including reinstall and up/down-grade actions. May raise [Cyclic_actions]. *) val atomic_actions: simple_universe:Cudf.universe -> complete_universe:Cudf.universe -> [< Cudf.package highlevel_action ] list -> ActionGraph.t (** Heuristic to compute the likely cause of all actions in a graph from the set of packages passed in the original request. Assumes a reduced graph. Takes the set of requested package names, and the set of packages marked for reinstall. *) val compute_root_causes: ActionGraph.t -> OpamPackage.Name.Set.t -> OpamPackage.Set.t -> Cudf.package cause Map.t exception Solver_failure of string (** Resolve a CUDF request. The result is either a conflict holding an explanation of the error, or a resulting universe. [~extern] specifies whether the external solver should be used *) val resolve: extern:bool -> version_map:int OpamPackage.Map.t -> Cudf.universe -> Cudf_types.vpkg request -> (Cudf.universe, conflict) result (** Computes a list of actions to proceed from the result of [resolve]. Note however than the action list is not yet complete: the transitive closure of reinstallations is not yet completed, as it requires to fold over the dependency graph in considering the optional dependencies. The first argument specifies a function that will be applied to the starting universe before computation: useful to re-add orphan packages. *) val to_actions: (Cudf.universe -> Cudf.universe) -> Cudf.universe -> (Cudf.universe, conflict) result -> (Cudf.package atomic_action list, conflict) result (** [remove universe name constr] Remove all the packages called [name] satisfying the constraints [constr] in the universe [universe]. *) val remove: Cudf.universe -> Cudf_types.pkgname -> Cudf_types.constr -> Cudf.universe (** Uninstall all the package in the universe. *) val uninstall_all: Cudf.universe -> Cudf.universe (** Install a package in the universe. We don't care about any invariant here (eg. the resulting universe can have multiple versions of the same package installed). *) val install: Cudf.universe -> Cudf.package -> Cudf.universe (** Remove all the versions of a given package, but the one given as argument. *) val remove_all_uninstalled_versions_but: Cudf.universe -> string -> Cudf_types.constr -> Cudf.universe (** Cudf labels for package fields in the cudf format (use for the field Cudf.pkg_extra and with Cudf.lookup_package_property) *) (** the original OPAM package name (as string) *) val s_source: string (** the original OPAM package version (as string) *) val s_source_number: string (** a package to be reinstalled (a bool) *) val s_reinstall: string (** true if this package belongs to the roots ("installed manually") packages *) val s_installed_root: string (** true if the package is pinned to this version *) val s_pinned: string (** the number of versions of the package since this one, cubed *) val s_version_lag: string (** {2 Pretty-printing} *) (** Convert a package constraint to something readable. *) val string_of_vpkgs: Cudf_types.vpkg list -> string val make_conflicts: version_map:int package_map -> Cudf.universe -> Algo.Diagnostic.diagnosis -> ('a, conflict) result val cycle_conflict: version_map:int package_map -> Cudf.universe -> string list list -> ('a, conflict) result (** Convert a conflict to something readable by the user. The second argument should return a string explaining the unavailability, or the empty string, when called on an unavailable package (the reason can't be known this deep in the solver) *) val string_of_conflict: package_set -> (name * OpamFormula.version_formula -> string) -> conflict -> string (** Returns three lists of strings: - the final reasons why the request can't be satisfied - the dependency chains explaining it - the cycles in the actions to process (exclusive with the other two) *) val strings_of_conflict: package_set -> (name * OpamFormula.version_formula -> string) -> conflict -> string list * string list * string list val conflict_chains: package_set -> conflict -> (name * OpamFormula.version_formula) list list (** Dumps the given cudf universe to the given channel *) val dump_universe: out_channel -> Cudf.universe -> unit (** Pretty-print atoms *) val string_of_atom: Cudf_types.vpkg -> string (** Pretty-print requests *) val string_of_request: Cudf_types.vpkg request -> string (** Pretty-print the universe *) val string_of_universe: Cudf.universe -> string (** Pretty-print of packages *) val string_of_packages: Cudf.package list -> string (** Convert a cudf package back to an OPAM package *) val cudf2opam: Cudf.package -> package (** Returns the list of packages in a Cudf universe *) val packages: Cudf.universe -> Cudf.package list (** Converts an OPAM request to a Cudf request *) val to_cudf: Cudf.universe -> Cudf_types.vpkg request -> Cudf.preamble * Cudf.universe * Cudf.request opam-2.0.5/src/solver/opamBuiltinMccs.ml.real0000644000175000017500000000412213511367404020123 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCudfSolverSig let name solver_backend = "builtin-"^Mccs.get_solver_id ~solver:solver_backend () let default_criteria = { crit_default = "-removed,\ -count[version-lag,request],\ -count[version-lag,changed],\ -changed"; crit_upgrade = "-removed,\ -count[version-lag,solution],\ -new"; crit_fixup = "-changed,-count[version-lag:,false]"; crit_best_effort_prefix = Some "+count[opam-query:,false],"; } let call solver_backend ext ~criteria ?timeout cudf = let solver = match solver_backend, ext with | `LP _, Some ext -> `LP ext | _ -> solver_backend in match Mccs.resolve_cudf ~solver ~verbose:OpamCoreConfig.(!r.debug_level >= 2) ?timeout criteria cudf with | None -> raise Common.CudfSolver.Unsat | Some (preamble, univ) -> Some preamble, univ | exception Mccs.Timeout -> raise Timeout let of_backend backend : (module OpamCudfSolverSig.S) = (module struct let name = name backend let ext = ref None let is_present () = match backend, !ext with | `LP "", None -> false | `LP cmd, None | `LP _, Some cmd -> OpamSystem.resolve_command cmd <> None | _ -> true let command_name = None let default_criteria = default_criteria let call = call backend !ext end) let all_backends = List.map of_backend Mccs.supported_backends opam-2.0.5/src/solver/opamCudf.ml0000644000175000017500000011004513511367404015650 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase let log ?level fmt = OpamConsole.log ?level "CUDF" fmt let slog = OpamConsole.slog (* custom cudf field labels *) let s_source = "opam-name" let s_source_number = "opam-version" let s_reinstall = "reinstall" let s_installed_root = "installed-root" let s_pinned = "pinned" let s_version_lag = "version-lag" let cudf2opam cpkg = let sname = Cudf.lookup_package_property cpkg s_source in let name = OpamPackage.Name.of_string sname in let sver = Cudf.lookup_package_property cpkg s_source_number in let version = OpamPackage.Version.of_string sver in OpamPackage.create name version let cudfnv2opam ?version_map ?cudf_universe (name,v) = let nv = match cudf_universe with | None -> None | Some u -> try Some (cudf2opam (Cudf.lookup_package u (name,v))) with Not_found -> None in match nv with | Some nv -> nv | None -> let name = OpamPackage.Name.of_string (Common.CudfAdd.decode name) in match version_map with | Some vmap -> let nvset = OpamPackage.Map.filter (fun nv cv -> nv.name = name && cv = v) vmap in fst (OpamPackage.Map.choose nvset) | None -> raise Not_found let string_of_package p = let installed = if p.Cudf.installed then "installed" else "not-installed" in Printf.sprintf "%s.%d(%s)" p.Cudf.package p.Cudf.version installed let string_of_packages l = OpamStd.List.to_string string_of_package l let to_json p = `O [ ("name", `String p.Cudf.package); ("version", `String (string_of_int p.Cudf.version)); ("installed", `String (string_of_bool p.Cudf.installed)); ] (* Graph of cudf packages *) module Pkg = struct type t = Cudf.package include Common.CudfAdd let to_string = string_of_package let name_to_string t = t.Cudf.package let version_to_string t = string_of_int t.Cudf.version let to_json = to_json end module Action = OpamActionGraph.MakeAction(Pkg) module ActionGraph = OpamActionGraph.Make(Action) let string_of_action = Action.to_string let string_of_actions l = OpamStd.List.to_string (fun a -> " - " ^ string_of_action a) l exception Solver_failure of string exception Cyclic_actions of Action.t list list type conflict_case = | Conflict_dep of (unit -> Algo.Diagnostic.reason list) | Conflict_cycle of string list list type conflict = Cudf.universe * int package_map * conflict_case module Map = OpamStd.Map.Make(Pkg) module Set = OpamStd.Set.Make(Pkg) module Graph = struct module PG = struct include Algo.Defaultgraphs.PackageGraph.G let succ g v = try succ g v with e -> OpamStd.Exn.fatal e; [] end module PO = Algo.Defaultgraphs.GraphOper (PG) module Topo = Graph.Topological.Make (PG) let of_universe u = (* {[Algo.Defaultgraphs.PackageGraph.dependency_graph u]} -> doesn't handle conjunctive dependencies correctly (e.g. (a>3 & a<=4) is considered as (a>3 | a<=4) and results in extra edges). Here we handle the fact that a conjunction with the same pkgname is an intersection, while a conjunction between different names is an union *) let t = OpamConsole.timer () in let g = PG.create ~size:(Cudf.universe_size u) () in let iter_deps f deps = (* List.iter (fun d -> List.iter f (Common.CudfAdd.resolve_deps u d)) deps *) let strong_deps, weak_deps = (* strong deps are mandatory (constraint appearing in the top conjunction) weak deps correspond to optional occurrences of a package, as part of a disjunction: e.g. in (A>=4 & (B | A<5)), A>=4 is strong, and the other two are weak. In the end we want to retain B and A>=4. *) List.fold_left (fun (strong_deps, weak_deps) l -> let names = List.fold_left (fun acc (n, _) -> OpamStd.String.Map.add n Set.empty acc) OpamStd.String.Map.empty l in let set = List.fold_left (fun acc (n, cstr) -> List.fold_left (fun s x -> Set.add x s) acc (Cudf.lookup_packages ~filter:cstr u n)) Set.empty l in let by_name = Set.fold (fun p -> OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty) set names in if OpamStd.String.Map.is_singleton by_name then let name, versions = OpamStd.String.Map.choose by_name in OpamStd.String.Map.update name (Set.inter versions) versions strong_deps, OpamStd.String.Map.remove name weak_deps else strong_deps, OpamStd.String.Map.union Set.union weak_deps by_name) (OpamStd.String.Map.empty, OpamStd.String.Map.empty) deps in OpamStd.String.Map.iter (fun _ p -> Set.iter f p) strong_deps; OpamStd.String.Map.iter (fun name p -> if not (OpamStd.String.Map.mem name strong_deps) then Set.iter f p) weak_deps in Cudf.iter_packages (fun p -> PG.add_vertex g p; iter_deps (PG.add_edge g p) p.Cudf.depends) u; log ~level:3 "Graph generation: %.3f" (t ()); g let output g filename = let fd = open_out (filename ^ ".dot") in Algo.Defaultgraphs.PackageGraph.DotPrinter.output_graph fd g; close_out fd let transitive_closure g = PO.O.add_transitive_closure g let close_and_linearize g pkgs = let _, l = Topo.fold (fun pkg (closure, topo) -> if Set.mem pkg closure then closure, pkg :: topo else if List.exists (fun p -> Set.mem p closure) (PG.pred g pkg) then Set.add pkg closure, pkg :: topo else closure, topo) g (pkgs, []) in l let mirror = PO.O.mirror include PG end (** Special package used by Dose internally, should generally be filtered out *) let dose_dummy_request = Algo.Depsolver.dummy_request.Cudf.package let is_dose_request cpkg = cpkg.Cudf.package = dose_dummy_request let filter_dependencies f_direction universe packages = log ~level:3 "filter deps: build graph"; let graph = f_direction (Graph.of_universe universe) in let packages = Set.of_list packages in log ~level:3 "filter deps: close_and_linearize"; let r = Graph.close_and_linearize graph packages in log ~level:3 "filter deps: done"; r let dependencies = filter_dependencies (fun x -> x) (* similar to Algo.Depsolver.dependency_closure but with finer results on version sets *) let reverse_dependencies = filter_dependencies Graph.mirror (* similar to Algo.Depsolver.reverse_dependency_closure but more reliable *) let string_of_atom (p, c) = let const = function | None -> "" | Some (r,v) -> Printf.sprintf " (%s %d)" (OpamPrinter.relop r) v in Printf.sprintf "%s%s" p (const c) let string_of_vpkgs constr = let constr = List.sort (fun (a,_) (b,_) -> String.compare a b) constr in OpamFormula.string_of_conjunction string_of_atom constr let string_of_universe u = string_of_packages (List.sort Common.CudfAdd.compare (Cudf.get_packages u)) let vpkg2atom cudfnv2opam (name,cstr) = match cstr with | None -> OpamPackage.Name.of_string (Common.CudfAdd.decode name), None | Some (relop,v) -> let nv = cudfnv2opam (name,v) in nv.name, Some (relop, nv.version) (* Should be unneeded now that we pass a full version_map along [{ log "Could not find corresponding version in cudf universe: %a" (slog string_of_atom) (name,cstr); let candidates = Cudf.lookup_packages cudf_universe name in let solutions = Cudf.lookup_packages ~filter:cstr cudf_universe name in let module OVS = OpamPackage.Version.Set in let to_version_set l = OVS.of_list (List.map (fun p -> OpamPackage.version (cudf2opam p)) l) in let solutions = to_version_set solutions in let others = OVS.Op.(to_version_set candidates -- solutions) in OpamPackage.Name.of_string (Common.CudfAdd.decode name), match relop, OVS.is_empty solutions, OVS.is_empty others with | _, true, true -> None | `Leq, false, _ | `Lt, false, true -> Some (`Leq, OVS.max_elt solutions) | `Lt, _, false | `Leq, true, false -> Some (`Lt, OVS.min_elt others) | `Geq, false, _ | `Gt, false, true -> Some (`Geq, OVS.min_elt solutions) | `Gt, _, false | `Geq, true, false -> Some (`Gt, OVS.max_elt others) | `Eq, false, _ -> Some (`Eq, OVS.choose solutions) | `Eq, true, _ -> Some (`Eq, OpamPackage.Version.of_string "") | `Neq, false, true -> None | `Neq, _, false -> Some (`Neq, OVS.choose others) }] *) let vpkg2opam cudfnv2opam vpkg = match vpkg2atom cudfnv2opam vpkg with | p, None -> p, Empty | p, Some (relop,v) -> p, Atom (relop, v) let conflict_empty ~version_map univ = Conflicts (univ, version_map, Conflict_dep (fun () -> [])) let make_conflicts ~version_map univ = function | {Algo.Diagnostic.result = Algo.Diagnostic.Failure f; _} -> Conflicts (univ, version_map, Conflict_dep f) | {Algo.Diagnostic.result = Algo.Diagnostic.Success _; _} -> raise (Invalid_argument "make_conflicts") let cycle_conflict ~version_map univ cycle = Conflicts (univ, version_map, Conflict_cycle cycle) let arrow_concat sl = let arrow = Printf.sprintf " %s " (OpamConsole.utf8_symbol OpamConsole.Symbols.rightwards_arrow "->") in String.concat (OpamConsole.colorise `yellow arrow) sl let strings_of_reasons packages cudfnv2opam unav_reasons rs = let open Algo.Diagnostic in let is_base cpkg = cpkg.Cudf.keep = `Keep_version in let rec aux = function | [] -> [] | Conflict (i,j,jc)::rs -> if is_dose_request i || is_dose_request j then let a = if is_dose_request i then j else i in if is_dose_request a then aux rs else if is_base a then let str = Printf.sprintf "Package %s is part of the base for this compiler \ and can't be changed" (OpamPackage.name_to_string (cudf2opam a)) in str :: aux rs else let str = Printf.sprintf "Conflicting query for package %s" (OpamPackage.to_string (cudf2opam a)) in str :: aux rs else if i.Cudf.package = j.Cudf.package then if is_base i || is_base j then let str = Printf.sprintf "Package %s is part of the base for this compiler \ and can't be changed" (OpamPackage.name_to_string (cudf2opam i)) in str :: aux rs else let str = Printf.sprintf "No available version of %s satisfies the \ constraints" (OpamPackage.name_to_string (cudf2opam i)) in str :: aux rs else let nva = cudf2opam i in let versions, rs = List.fold_left (fun (versions, rs) -> function | Conflict (i1, _, jc1) when (cudf2opam i1).name = nva.name && jc1 = jc -> OpamPackage.Version.Set.add (cudf2opam i1).version versions, rs | r -> versions, r::rs) (OpamPackage.Version.Set.singleton nva.version, []) rs in let rs = List.rev rs in let formula = OpamFormula.formula_of_version_set (OpamPackage.versions_of_name packages nva.name) versions in let str = Printf.sprintf "%s is in conflict with %s" (OpamFormula.to_string (Atom (nva.name, formula))) (OpamFormula.to_string (OpamFormula.of_atom_formula (Atom (vpkg2atom cudfnv2opam jc)))) in str :: aux rs | Missing (p,missing) :: rs when is_dose_request p -> (* Requested pkg missing *) let atoms = List.map (fun vp -> try vpkg2atom cudfnv2opam vp with Not_found -> OpamPackage.Name.of_string (Common.CudfAdd.decode (fst vp)), None) missing in let names = OpamStd.List.sort_nodup compare (List.map fst atoms) in List.map (fun name -> let formula = OpamFormula.ors (List.map (function | n, Some atom when n = name -> Atom atom | _ -> Empty) atoms) in let all_versions = OpamPackage.versions_of_name packages name in let formula = OpamFormula.simplify_version_set all_versions formula in unav_reasons (name, formula)) names @ aux rs | Missing _ :: rs (* dependency missing, treated in strings_of_chains *) | Dependency _ :: rs -> aux rs in aux rs let make_chains packages cudfnv2opam depends = let open Algo.Diagnostic in let map_addlist k v map = try Map.add k (v @ Map.find k map) map with Not_found -> Map.add k v map in let roots,notroots,deps,vpkgs = List.fold_left (fun (roots,notroots,deps,vpkgs) -> function | Dependency (i, vpkgl, jl) when not (is_dose_request i) -> Set.add i roots, List.fold_left (fun notroots j -> Set.add j notroots) notroots jl, map_addlist i jl deps, map_addlist i vpkgl vpkgs | Missing (i, vpkgl) when not (is_dose_request i) -> let jl = List.map (fun (package,_) -> {Cudf.default_package with Cudf.package}) vpkgl in Set.add i roots, notroots, map_addlist i jl deps, map_addlist i vpkgl vpkgs | _ -> roots, notroots, deps, vpkgs) (Set.empty,Set.empty,Map.empty,Map.empty) depends in let roots = Set.diff roots notroots in if Set.is_empty roots then [] else let children cpkgs = Set.fold (fun c acc -> List.fold_left (fun m a -> Set.add a m) acc (try Map.find c deps with Not_found -> [])) cpkgs Set.empty in let rec aux constrs direct_deps = if Set.is_empty direct_deps then [[]] else let depnames = Set.fold (fun p set -> OpamStd.String.Set.add p.Cudf.package set) direct_deps OpamStd.String.Set.empty in OpamStd.String.Set.fold (fun name acc -> let name_deps = (* Gather all deps with the given name *) Set.filter (fun p -> p.Cudf.package = name) direct_deps in let name_constrs = List.map (List.filter (fun (n,_) -> n = name)) constrs in let to_opam_constr p = snd (vpkg2opam cudfnv2opam p) in let formula = OpamFormula.ors (List.map (fun conj -> OpamFormula.ands (List.map to_opam_constr conj)) name_constrs) in let opam_name = OpamPackage.Name.of_string (Common.CudfAdd.decode name) in let all_versions = OpamPackage.versions_of_name packages opam_name in let formula = OpamFormula.simplify_version_set all_versions formula in let formula = opam_name, formula in let children_constrs = List.map (fun p -> try Map.find p vpkgs with Not_found -> []) (Set.elements name_deps) in let chains = aux children_constrs (children name_deps) in List.fold_left (fun acc chain -> (formula :: chain) :: acc) acc chains ) depnames [] in let start_constrs = let set = Set.fold (fun p acc -> OpamStd.String.Set.add p.Cudf.package acc) roots OpamStd.String.Set.empty in List.map (fun name -> [name,None]) (OpamStd.String.Set.elements set) in aux start_constrs roots let strings_of_final_reasons packages cudfnv2opam unav_reasons reasons = let reasons = strings_of_reasons packages cudfnv2opam unav_reasons reasons in OpamStd.List.sort_nodup compare reasons let strings_of_chains packages cudfnv2opam unav_reasons reasons = let chains = make_chains packages cudfnv2opam reasons in let string_of_chain c = match List.rev c with | (name, vform) :: r -> let all_versions = OpamPackage.versions_of_name packages name in let formula = OpamFormula.simplify_version_set all_versions vform in arrow_concat (List.rev_map (fun c -> OpamFormula.to_string (Atom c)) r @ [OpamConsole.colorise' [`red;`bold] (OpamFormula.to_string (Atom (name, vform)))]) ^ (match unav_reasons (name, formula) with "" -> "" | s -> "\n " ^ s) | [] -> "" in List.map string_of_chain chains let strings_of_cycles cycles = List.map arrow_concat cycles let strings_of_conflict packages unav_reasons = function | univ, version_map, Conflict_dep reasons -> let r = reasons () in let cudfnv2opam = cudfnv2opam ~cudf_universe:univ ~version_map in strings_of_final_reasons packages cudfnv2opam unav_reasons r, strings_of_chains packages cudfnv2opam unav_reasons r, [] | _univ, _version_map, Conflict_cycle cycles -> [], [], strings_of_cycles cycles let conflict_chains packages = function | cudf_universe, version_map, Conflict_dep r -> make_chains packages (cudfnv2opam ~cudf_universe ~version_map) (r ()) | _ -> [] let string_of_conflict packages unav_reasons conflict = let final, chains, cycles = strings_of_conflict packages unav_reasons conflict in let b = Buffer.create 1024 in let pr_items b l = Buffer.add_string b (OpamStd.Format.itemize (fun s -> s) l) in if cycles <> [] then Printf.bprintf b "The actions to process have cyclic dependencies:\n%a" pr_items cycles; if chains <> [] then Printf.bprintf b "The following dependencies couldn't be met:\n%a" pr_items chains; if final <> [] then Printf.bprintf b "Your request can't be satisfied:\n%a" pr_items final; if final = [] && chains = [] && cycles = [] then (* No explanation found *) Printf.bprintf b "Sorry, no solution found: \ there seems to be a problem with your request.\n"; Buffer.add_string b "\n"; Buffer.contents b let check flag p = try Cudf.lookup_typed_package_property p flag = `Bool true with Not_found -> false let need_reinstall = check s_reinstall (* let is_installed_root = check s_installed_root let is_pinned = check s_pinned *) let default_preamble = let l = [ (s_source, `String None); (s_source_number, `String None); (s_reinstall, `Bool (Some false)); (s_installed_root, `Bool (Some false)); (s_pinned, `Bool (Some false)); (s_version_lag, `Nat (Some 0)); ] in Common.CudfAdd.add_properties Cudf.default_preamble l let remove universe name constr = let filter p = p.Cudf.package <> name || not (Cudf.version_matches p.Cudf.version constr) in let packages = Cudf.get_packages ~filter universe in Cudf.load_universe packages let uninstall_all universe = let packages = Cudf.get_packages universe in let packages = List.rev_map (fun p -> { p with Cudf.installed = false }) packages in Cudf.load_universe packages let install universe package = let p = Cudf.lookup_package universe (package.Cudf.package, package.Cudf.version) in let p = { p with Cudf.installed = true } in let packages = let filter p = p.Cudf.package <> package.Cudf.package || p.Cudf.version <> package.Cudf.version in Cudf.get_packages ~filter universe in Cudf.load_universe (p :: packages) let remove_all_uninstalled_versions_but universe name constr = let filter p = p.Cudf.installed || p.Cudf.package <> name || Cudf.version_matches p.Cudf.version constr in let packages = Cudf.get_packages ~filter universe in Cudf.load_universe packages let to_cudf univ req = ( Common.CudfAdd.add_properties default_preamble (List.map (fun s -> s, `Int (Some 0)) req.extra_attributes), univ, { Cudf.request_id = "opam"; install = req.wish_install; remove = req.wish_remove; upgrade = req.wish_upgrade; req_extra = [] } ) let string_of_request r = Printf.sprintf "install:%s remove:%s upgrade:%s" (string_of_vpkgs r.wish_install) (string_of_vpkgs r.wish_remove) (string_of_vpkgs r.wish_upgrade) let solver_calls = ref 0 let dump_universe oc univ = Cudf_printer.pp_cudf oc (default_preamble, univ, Cudf.default_request) let dump_cudf_request ~version_map (_, univ,_ as cudf) criteria = function | None -> None | Some f -> ignore ( version_map: int OpamPackage.Map.t ); incr solver_calls; let filename = Printf.sprintf "%s-%d.cudf" f !solver_calls in let oc = open_out filename in let module Solver = (val OpamSolverConfig.(Lazy.force !r.solver)) in Printf.fprintf oc "# Solver: %s\n" (OpamCudfSolver.get_name (module Solver)); Printf.fprintf oc "# Criteria: %s\n" criteria; Cudf_printer.pp_cudf oc cudf; OpamPackage.Map.iter (fun (pkg:OpamPackage.t) (vnum: int) -> let name = OpamPackage.name_to_string pkg in let version = OpamPackage.version_to_string pkg in Printf.fprintf oc "#v2v:%s:%d=%s\n" name vnum version; ) version_map; close_out oc; Graph.output (Graph.of_universe univ) f; Some filename let dump_cudf_error ~version_map univ req = let cudf_file = match OpamSolverConfig.(!r.cudf_file) with | Some f -> f | None -> let (/) = Filename.concat in OpamCoreConfig.(!r.log_dir) / ("solver-error-"^string_of_int (OpamStubs.getpid())) in match dump_cudf_request (to_cudf univ req) ~version_map (OpamSolverConfig.criteria req.criteria) (Some cudf_file) with | Some f -> f | None -> assert false let call_external_solver ~version_map univ req = let cudf_request = to_cudf univ req in if Cudf.universe_size univ > 0 then let criteria = OpamSolverConfig.criteria req.criteria in let chrono = OpamConsole.timer () in ignore (dump_cudf_request ~version_map cudf_request criteria OpamSolverConfig.(!r.cudf_file)); try let r = Algo.Depsolver.check_request_using ~call_solver:(OpamSolverConfig.call_solver ~criteria) ~criteria ~explain:true cudf_request in log "Solver call done in %.3f" (chrono ()); r with | OpamCudfSolver.Timeout -> let msg = Printf.sprintf "Sorry, resolution of the request timed out.\n\ Try to specify a simpler request, use a different solver, or \ increase the allowed time by setting OPAMSOLVERTIMEOUT to a bigger \ value (currently, it is set to %.1f seconds)." OpamSolverConfig.(OpamStd.Option.default 0. !r.solver_timeout) in raise (Solver_failure msg) | Failure msg -> let msg = Printf.sprintf "Solver failure: %s\nThis may be due to bad settings (solver or \ solver criteria) or a broken solver solver installation. Check \ $OPAMROOT/config, and the --solver and --criteria options." msg in raise (Solver_failure msg) | e -> OpamStd.Exn.fatal e; let msg = Printf.sprintf "Solver failed: %s" (Printexc.to_string e) in raise (Solver_failure msg) else Algo.Depsolver.Sat(None,Cudf.load_universe []) let check_request ?(explain=true) ~version_map univ req = match Algo.Depsolver.check_request ~explain (to_cudf univ req) with | Algo.Depsolver.Unsat (Some ({Algo.Diagnostic.result = Algo.Diagnostic.Failure _; _} as r)) -> make_conflicts ~version_map univ r | Algo.Depsolver.Sat (_,u) -> Success (remove u dose_dummy_request None) | Algo.Depsolver.Error msg -> let f = dump_cudf_error ~version_map univ req in let msg = Printf.sprintf "Internal solver failed with %s Request saved to %S" msg f in raise (Solver_failure msg) | Algo.Depsolver.Unsat _ -> (* normally when [explain] = false *) conflict_empty ~version_map univ (* Return the universe in which the system has to go *) let get_final_universe ~version_map univ req = let fail msg = let f = dump_cudf_error ~version_map univ req in let msg = Printf.sprintf "External solver failed with %s Request saved to %S" msg f in raise (Solver_failure msg) in match call_external_solver ~version_map univ req with | Algo.Depsolver.Sat (_,u) -> Success (remove u dose_dummy_request None) | Algo.Depsolver.Error "(CRASH) Solution file is empty" -> (* XXX Is this still needed with latest dose? *) Success (Cudf.load_universe []) | Algo.Depsolver.Error str -> fail str | Algo.Depsolver.Unsat r -> match r with | Some ({Algo.Diagnostic.result = Algo.Diagnostic.Failure _; _} as r) -> make_conflicts ~version_map univ r | Some {Algo.Diagnostic.result = Algo.Diagnostic.Success _; _}(* -> *) (* fail "inconsistent return value." *) | None -> (* External solver did not provide explanations, hopefully this will *) check_request ~version_map univ req let diff univ sol = let before = Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ) in let after = Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) sol) in let open Set.Op in let reinstall = Set.filter need_reinstall after in let install = after -- before ++ reinstall in let remove = before -- after ++ reinstall in install, remove (* Transform a diff from current to final state into a list of actions. At this point, we don't know about the root causes of the actions, they will be computed later. *) let actions_of_diff (install, remove) = let actions = [] in let actions = Set.fold (fun p acc -> `Install p :: acc) install actions in let actions = Set.fold (fun p acc -> `Remove p :: acc) remove actions in actions let resolve ~extern ~version_map universe request = log "resolve request=%a" (slog string_of_request) request; if extern then get_final_universe ~version_map universe request else check_request ~version_map universe request let to_actions f universe result = let aux u1 u2 = let diff = diff (f u1) u2 in actions_of_diff diff in map_success (aux universe) result let create_graph filter universe = let pkgs = Cudf.get_packages ~filter universe in let u = Cudf.load_universe pkgs in Graph.of_universe u let find_cycles g = let open ActionGraph in let roots = fold_vertex (fun v acc -> if in_degree g v = 0 then v::acc else acc) g [] in let roots = if roots = [] then fold_vertex (fun v acc -> v::acc) g [] else roots in let rec prefix_find acc v = function | x::_ when x = v -> Some (x::acc) | x::r -> prefix_find (x::acc) v r | [] -> None in let seen = Hashtbl.create 17 in let rec follow v path = match prefix_find [] v path with | Some cycle -> Hashtbl.add seen v (); [cycle@[v]] | None -> if Hashtbl.mem seen v then [] else let path = v::path in Hashtbl.add seen v (); List.fold_left (fun acc s -> follow s path @ acc) [] (succ g v) in List.fold_left (fun cycles root -> follow root [] @ cycles ) [] roots (* Compute the original causes of the actions, from the original set of packages in the user request. In the restricted dependency graph, for each action we find the closest package belonging to the user request and print out the closest neighbour that gets there. This way, if a -> b -> c and the user requests a to be installed, we can print: - install a - install b [required by a] - intall c [required by b] *) let compute_root_causes g requested reinstall = let module StringSet = OpamStd.String.Set in let requested_pkgnames = OpamPackage.Name.Set.fold (fun n s -> StringSet.add (Common.CudfAdd.encode (OpamPackage.Name.to_string n)) s) requested StringSet.empty in let reinstall_pkgnames = OpamPackage.Set.fold (fun nv s -> StringSet.add (Common.CudfAdd.encode (OpamPackage.name_to_string nv)) s) reinstall StringSet.empty in let actions = ActionGraph.fold_vertex (fun a acc -> Map.add (action_contents a) a acc) g Map.empty in let requested_actions = Map.filter (fun pkg _ -> StringSet.mem pkg.Cudf.package requested_pkgnames) actions in let merge_causes (c1,depth1) (c2,depth2) = (* When we found several causes explaining the same action, only keep the most likely one *) if c2 = Unknown || depth1 < depth2 then c1, depth1 else if c1 = Unknown || depth2 < depth1 then c2, depth2 else let (@) = List.fold_left (fun l a -> if List.mem a l then l else a::l) in match c1, c2 with | Required_by a, Required_by b -> Required_by (a @ b), depth1 | Use a, Use b -> Use (a @ b), depth1 | Conflicts_with a, Conflicts_with b -> Conflicts_with (a @ b), depth1 | Requested, a | a, Requested | Unknown, a | a, Unknown | Upstream_changes , a | a, Upstream_changes -> a, depth1 | _, c -> c, depth1 in let direct_cause consequence order cause = (* Investigate the reason of action [consequence], that was possibly triggered by [cause], where the actions are ordered as [consequence] [order] [cause]. *) match consequence, order, cause with | (`Install _ | `Change _), `Before, (`Install p | `Change (_,_,p)) -> (* Prerequisite *) Required_by [p] | `Change _, `After, (`Install p | `Change (_,_,p)) -> (* Change caused by change in dependencies *) Use [p] | `Reinstall _, `After, a -> (* Reinstall caused by action on deps *) Use [action_contents a] | (`Remove _ | `Change _ ), `Before, `Remove p -> (* Removal or change caused by the removal of a dependency *) Use [p] | `Remove _, `Before, (`Install p | `Change (_,_,p) | `Reinstall p) -> (* Removal caused by conflict *) Conflicts_with [p] | (`Install _ | `Change _), `Before, `Reinstall p -> (* New dependency of p? *) Required_by [p] | `Change _, _, _ -> (* The only remaining cause for changes is upstream *) Upstream_changes | (`Install _ | `Remove _), `After, _ -> (* Nothing can cause these actions after itself *) Unknown | (`Install _ | `Reinstall _), `Before, _ -> (* An install or reinstall doesn't cause any oter actions on its dependendants *) Unknown | `Build _, _, _ | _, _, `Build _ -> assert false in let get_causes acc roots = let rec aux seen depth pkgname causes = if depth > 100 then (OpamConsole.error "Internal error computing action causes: sorry, please report."; causes) else let action = Map.find pkgname actions in let seen = Set.add pkgname seen in let propagate causes actions direction = List.fold_left (fun causes act -> let p = action_contents act in if Set.mem p seen then causes else let cause = direct_cause act direction action in if cause = Unknown then causes else try Map.add p (merge_causes (cause,depth) (Map.find p causes)) causes with Not_found -> aux seen (depth + 1) p (Map.add p (cause,depth) causes) ) causes actions in let causes = propagate causes (ActionGraph.pred g action) `Before in let causes = propagate causes (ActionGraph.succ g action) `After in causes in let start = Map.fold (fun k _ acc -> Set.add k acc) roots Set.empty in let acc = Map.union (fun a _ -> a) acc roots in Set.fold (aux start 1) start acc in (* Compute the roots of the action given a condition *) let make_roots causes base_cause f = ActionGraph.fold_vertex (fun act acc -> if Map.mem (action_contents act) causes then acc else if f act then Map.add (action_contents act) (base_cause,0) acc else acc) g Map.empty in let causes = Map.empty in let causes = let roots = if Map.is_empty requested_actions then (* Assume a global upgrade *) make_roots causes Requested (function | `Change (`Up,_,_) -> true | _ -> false) else (Map.map (fun _ -> Requested, 0) requested_actions) in get_causes causes roots in let causes = (* Compute causes for remaining upgrades (maybe these could be removed from the actions altogether since they are unrelated to the request?) *) let roots = make_roots causes Unknown (function | `Change _ as act -> List.for_all (function `Change _ -> false | _ -> true) (ActionGraph.pred g act) | _ -> false) in get_causes causes roots in let causes = (* Compute causes for marked reinstalls *) let roots = make_roots causes Upstream_changes (function | `Reinstall p -> (* need_reinstall p is not available here *) StringSet.mem p.Cudf.package reinstall_pkgnames | _ -> false) in get_causes causes roots in Map.map fst causes (* Compute a full solution from a set of root actions. This means adding all required reinstallations and computing the graph of dependency of required actions *) let atomic_actions ~simple_universe ~complete_universe root_actions = log "graph_of_actions root_actions=%a" (slog string_of_actions) root_actions; let to_remove, to_install = List.fold_left (fun (rm,inst) a -> match a with | `Change (_,p1,p2) -> Set.add p1 rm, Set.add p2 inst | `Install p -> rm, Set.add p inst | `Reinstall p -> Set.add p rm, Set.add p inst | `Remove p -> Set.add p rm, inst) (Set.empty, Set.empty) root_actions in (* transitively add recompilations *) let to_remove, to_install = let packages = Set.union to_remove to_install in let package_graph = let filter p = p.Cudf.installed || Set.mem p packages in Graph.mirror (create_graph filter simple_universe) in Graph.Topo.fold (fun p (rm,inst) -> let actionned p = Set.mem p rm || Set.mem p inst in if not (actionned p) && List.exists actionned (Graph.pred package_graph p) then Set.add p rm, Set.add p inst else rm, inst) package_graph (to_remove, to_install) in let pkggraph set = create_graph (fun p -> Set.mem p set) complete_universe in (* Build the graph of atomic actions: Removals or installs *) let g = ActionGraph.create () in Set.iter (fun p -> ActionGraph.add_vertex g (`Remove p)) to_remove; Set.iter (fun p -> ActionGraph.add_vertex g (`Install (p))) to_install; (* reinstalls and upgrades: remove first *) Set.iter (fun p1 -> try let p2 = Set.find (fun p2 -> p1.Cudf.package = p2.Cudf.package) to_install in ActionGraph.add_edge g (`Remove p1) (`Install (p2)) with Not_found -> ()) to_remove; (* uninstall order *) Graph.iter_edges (fun p1 p2 -> ActionGraph.add_edge g (`Remove p1) (`Remove p2) ) (pkggraph to_remove); (* install order *) Graph.iter_edges (fun p1 p2 -> if Set.mem p1 to_install then let cause = if Set.mem p2 to_install then `Install ( p2) else `Remove p2 in ActionGraph.add_edge g cause (`Install ( p1)) ) (pkggraph (Set.union to_install to_remove)); (* conflicts *) let conflicts_graph = let filter p = Set.mem p to_remove || Set.mem p to_install in Algo.Defaultgraphs.PackageGraph.conflict_graph (Cudf.load_universe (Cudf.get_packages ~filter complete_universe)) in Algo.Defaultgraphs.PackageGraph.UG.iter_edges (fun p1 p2 -> if Set.mem p1 to_remove && Set.mem p2 to_install then ActionGraph.add_edge g (`Remove p1) (`Install ( p2)) else if Set.mem p2 to_remove && Set.mem p1 to_install then ActionGraph.add_edge g (`Remove p2) (`Install ( p1))) conflicts_graph; (* check for cycles *) match find_cycles g with | [] -> g | cycles -> raise (Cyclic_actions cycles) let packages u = Cudf.get_packages u opam-2.0.5/src/solver/opamSolver.ml0000644000175000017500000006310013511367404016240 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamPackage.Set.Op let log ?level fmt = OpamConsole.log ?level "SOLVER" fmt let slog = OpamConsole.slog module Action = OpamActionGraph.MakeAction(OpamPackage) module ActionGraph = OpamActionGraph.Make(Action) type solution = OpamCudf.ActionGraph.t let empty_universe = { u_packages = OpamPackage.Set.empty; u_installed = OpamPackage.Set.empty; u_available = OpamPackage.Set.empty; u_depends = OpamPackage.Map.empty; u_depopts = OpamPackage.Map.empty; u_conflicts = OpamPackage.Map.empty; u_action = Install; u_installed_roots = OpamPackage.Set.empty; u_pinned = OpamPackage.Set.empty; u_base = OpamPackage.Set.empty; u_reinstall = OpamPackage.Set.empty; u_attrs = []; } let is_installed universe (name,_) = OpamPackage.Set.exists (fun pkg -> OpamPackage.name pkg = name ) universe.u_installed let find_installed universe (name, _) = let pkg = OpamPackage.Set.find (fun pkg -> OpamPackage.name pkg = name ) universe.u_installed in OpamPackage.version pkg let is_available universe wish_remove (name, _ as c) = let version = find_installed universe c in OpamPackage.Set.exists (fun pkg -> OpamPackage.name pkg = name && OpamPackage.version pkg = version ) universe.u_available && List.for_all (fun (n, _) -> n <> name) wish_remove let cudf_versions_map universe packages = log ~level:3 "cudf_versions_map"; let add_referred_to_packages filt acc refmap = OpamPackage.Map.fold (fun _ deps acc -> List.fold_left (fun acc -> function | n, Some (_, v) -> OpamPackage.Set.add (OpamPackage.create n v) acc | _, None -> acc) acc (OpamFormula.atoms (filt deps))) refmap acc in let filt f = OpamFilter.filter_deps ~build:true ~post:true ~default:false f in let id = fun x -> x in let packages = add_referred_to_packages filt packages universe.u_depends in let packages = add_referred_to_packages filt packages universe.u_depopts in let packages = add_referred_to_packages id packages universe.u_conflicts in let pmap = OpamPackage.to_map packages in OpamPackage.Name.Map.fold (fun name versions acc -> let _, map = OpamPackage.Version.Set.fold (fun version (i,acc) -> let nv = OpamPackage.create name version in i + 1, OpamPackage.Map.add nv i acc) versions (1,acc) in map) pmap OpamPackage.Map.empty let name_to_cudf name = Common.CudfAdd.encode (OpamPackage.Name.to_string name) let constraint_to_cudf version_map name (op,v) = let nv = OpamPackage.create name v in try Some (op, OpamPackage.Map.find nv version_map) with Not_found -> (* The version for comparison doesn't exist: match to the closest existing version according to the direction of the comparison (this shouldn't happen for any constraint in the universe, now that we compute a full version map, but may still happen for user-provided constraints) *) let all_versions = OpamPackage.Map.filter (fun nv _ -> nv.name = name) version_map in match op with | `Neq -> None (* Always true *) | `Eq -> (* Always false *) Some (`Gt, OpamPackage.Map.cardinal all_versions) | (`Geq | `Gt | `Leq | `Lt) as op -> let sign, result_op = match op with | `Geq | `Gt -> (fun x -> x), `Geq | `Leq | `Lt -> (fun x -> -x), `Leq in let rev_version_map = OpamPackage.Map.fold (fun nv cv acc -> OpamStd.IntMap.add (sign cv) nv.version acc) all_versions OpamStd.IntMap.empty in let map = OpamStd.IntMap.filter (fun _ v1 -> sign (OpamPackage.Version.compare v v1) < 0) rev_version_map in if OpamStd.IntMap.is_empty map then match result_op with | `Geq -> Some (`Gt, max 1 (OpamPackage.Map.cardinal all_versions)) | `Leq -> Some (`Lt, 1) else Some (result_op, sign (fst (OpamStd.IntMap.min_binding map))) let atom2cudf _universe (version_map : int OpamPackage.Map.t) (name,cstr) = name_to_cudf name, OpamStd.Option.Op.(cstr >>= constraint_to_cudf version_map name) let lag_function = let exp = OpamStd.Option.default 1 (OpamStd.Config.env_int "VERSIONLAGPOWER") in let rec power n x = if n <= 0 then 1 else x * power (n-1) x in power exp let opam2cudf universe version_map packages = let set_to_bool_map set = OpamPackage.Set.fold (fun nv -> OpamPackage.Map.add nv true) (packages %% set) OpamPackage.Map.empty in let base_map = OpamPackage.Set.fold (fun nv -> OpamPackage.Map.add nv { Cudf.default_package with Cudf.package = name_to_cudf nv.name; pkg_extra = [ OpamCudf.s_source, `String(OpamPackage.name_to_string nv); OpamCudf.s_source_number, `String(OpamPackage.version_to_string nv); ]; }) packages OpamPackage.Map.empty in let only_packages m = OpamPackage.Map.merge (fun _ -> function None -> fun _ -> None | Some _ -> fun x -> x) base_map m in let installed_map = set_to_bool_map universe.u_installed in let keep_map = OpamPackage.Set.fold (fun nv acc -> if OpamPackage.Set.mem nv universe.u_available then OpamPackage.Map.add nv `Keep_version acc else if OpamPackage.has_name universe.u_available nv.name then OpamPackage.Map.add nv `Keep_package acc else acc) (packages %% universe.u_base) OpamPackage.Map.empty in let reinstall_map = set_to_bool_map universe.u_reinstall in let installed_root_map = set_to_bool_map universe.u_installed_roots in let pinned_to_current_version_map = set_to_bool_map universe.u_pinned in let version_lag_map = OpamPackage.Name.Map.fold (fun name version_set acc -> let nvers, vs = OpamPackage.Version.Set.fold (fun v (i,acc) -> i+1, OpamPackage.Version.Map.add v i acc) version_set (0, OpamPackage.Version.Map.empty) in OpamPackage.Version.Map.fold (fun v i -> let lag = lag_function (nvers - i - 1) in if lag > 0 then OpamPackage.Map.add (OpamPackage.create name v) lag else fun acc -> acc) vs acc) (OpamPackage.to_map packages) OpamPackage.Map.empty in let extras_maps = List.map (fun (label, set) -> OpamPackage.Set.fold (fun nv -> OpamPackage.Map.add nv (label, `Int 1)) (packages %% set) OpamPackage.Map.empty) universe.u_attrs in let add elts f map = OpamPackage.Map.merge (fun nv a b -> match a, b with | Some cp, None -> Some cp | Some cp, Some x -> Some (f nv x cp) | None, _ -> None) map elts in let univ0 = base_map |> add version_map (fun _ version cp -> {cp with Cudf.version}) |> add installed_map (fun _ installed cp -> {cp with Cudf.installed}) |> add keep_map (fun _ keep cp -> {cp with Cudf.keep}) |> add reinstall_map (fun _ x cp -> {cp with Cudf.pkg_extra = (OpamCudf.s_reinstall, `Bool x) :: cp.Cudf.pkg_extra}) |> add installed_root_map (fun _ x cp -> {cp with Cudf.pkg_extra = (OpamCudf.s_installed_root, `Bool x) :: cp.Cudf.pkg_extra}) |> add pinned_to_current_version_map (fun _ x cp -> {cp with Cudf.pkg_extra = (OpamCudf.s_pinned, `Bool x) :: cp.Cudf.pkg_extra}) |> add version_lag_map (fun _ x cp -> {cp with Cudf.pkg_extra = (OpamCudf.s_version_lag, `Int x) :: cp.Cudf.pkg_extra}) |> List.fold_right (fun m -> add m (fun _ x cp -> {cp with Cudf.pkg_extra = x :: cp.Cudf.pkg_extra})) extras_maps in let preresolve_deps f = OpamFilter.atomise_extended f |> OpamFormula.map (fun (name, (filter, cstr)) -> let cstr = match cstr with | None -> None | Some (op, FString v) -> let v = OpamPackage.Version.of_string v in constraint_to_cudf version_map name (op, v) | _ -> assert false in Atom (name_to_cudf name, (filter, cstr))) |> OpamFormula.cnf_of_formula in let depends_map = OpamPackage.Map.map preresolve_deps (only_packages universe.u_depends) in let depopts_map = OpamPackage.Map.map preresolve_deps (only_packages universe.u_depopts) in let conflicts_map = OpamPackage.Map.mapi (fun nv conflicts -> (nv.name, None) :: (* prevents install of multiple versions of the same pkg *) OpamFormula.set_to_disjunction universe.u_packages conflicts) (only_packages universe.u_conflicts) in let conflicts_map_resolved = OpamPackage.Map.map (List.rev_map (atom2cudf universe version_map)) conflicts_map in fun ~depopts ~build ~post -> let all_depends_map = if depopts then OpamPackage.Map.union (fun d dopts -> OpamFormula.(ands [d; dopts])) depends_map depopts_map else depends_map in let depends_map_resolved = OpamPackage.Map.map (fun f -> f |> OpamFormula.map (fun (name, (filter, cstr)) -> if OpamFilter.eval_to_bool ~default:false (OpamFilter.deps_var_env ~build ~post) filter then Atom (name, cstr) else Empty) |> OpamFormula.ands_to_list |> List.map (OpamFormula.fold_right (fun acc x -> x::acc) [])) all_depends_map in univ0 |> add depends_map_resolved (fun _ depends cp -> {cp with Cudf.depends}) |> add conflicts_map_resolved (fun _ conflicts cp -> {cp with Cudf.conflicts}) |> OpamPackage.Map.values (* load a cudf universe from an opam one *) let load_cudf_universe opam_universe ?version_map opam_packages = let chrono = OpamConsole.timer () in let version_map = match version_map with | Some vm -> vm | None -> cudf_versions_map opam_universe opam_packages in log ~level:3 "Load cudf universe: opam2cudf"; let opam_packages = if OpamPackage.Set.subset opam_universe.u_base opam_universe.u_available then (* Filter out extra compiler versions, they add too much cost to the solver and are not needed *) opam_packages -- (OpamPackage.packages_of_names opam_packages OpamPackage.Name.Set.Op.( OpamPackage.names_of_packages opam_universe.u_base -- OpamPackage.names_of_packages opam_universe.u_pinned) -- opam_universe.u_base) else opam_packages in let univ_gen = opam2cudf opam_universe version_map opam_packages in log ~level:3 "Preload of cudf universe: done in %.3fs" (chrono ()); fun ?(depopts=false) ~build ~post () -> log "Load cudf universe (depopts:%a, build:%b, post:%b)" (slog string_of_bool) depopts build post; let chrono = OpamConsole.timer () in let cudf_universe = let cudf_packages = univ_gen ~depopts ~build ~post in log ~level:3 "opam2cudf: done in %.3fs" (chrono ()); try Cudf.load_universe cudf_packages with Cudf.Constraint_violation s -> OpamConsole.error_and_exit `Solver_failure "Malformed CUDF universe (%s)" s in log ~level:3 "Secondary load of cudf universe: done in %.3fs" (chrono ()); (* let universe = Algo.Depsolver.trim universe in *) cudf_universe let string_of_request r = let to_string = OpamFormula.string_of_conjunction OpamFormula.string_of_atom in Printf.sprintf "install:%s remove:%s upgrade:%s" (to_string r.wish_install) (to_string r.wish_remove) (to_string r.wish_upgrade) (* Unused? let map_cause f = function | Upstream_changes -> Upstream_changes | Use l -> Use (List.rev_map f l) | Required_by l -> Required_by (List.rev_map f l) | Conflicts_with l -> Conflicts_with (List.rev_map f l) | Requested -> Requested | Unknown -> Unknown *) let cudf_to_opam_graph cudf2opam cudf_graph = let size = OpamCudf.ActionGraph.nb_vertex cudf_graph in let opam_graph = ActionGraph.create ~size () in OpamCudf.ActionGraph.iter_vertex (fun package -> ActionGraph.add_vertex opam_graph (map_action cudf2opam package) ) cudf_graph; OpamCudf.ActionGraph.iter_edges (fun p1 p2 -> ActionGraph.add_edge opam_graph (map_action cudf2opam p1) (map_action cudf2opam p2) ) cudf_graph; opam_graph let map_request f r = let f = List.rev_map f in { wish_install = f r.wish_install; wish_remove = f r.wish_remove; wish_upgrade = f r.wish_upgrade; criteria = r.criteria; extra_attributes = r.extra_attributes; } (* Remove duplicate packages *) (* Add upgrade constraints *) (* Remove constraints in best_effort mode *) let cleanup_request universe (req:atom request) = if OpamSolverConfig.best_effort () then { req with wish_install = []; wish_upgrade = []; } else let wish_install = List.filter (fun (n,_) -> not (List.mem_assoc n req.wish_upgrade)) req.wish_install in let wish_upgrade = List.rev_map (fun (n,c as pkg) -> if c = None && is_installed universe pkg && is_available universe req.wish_remove pkg then n, Some (`Geq, find_installed universe pkg) else pkg ) req.wish_upgrade in { req with wish_install; wish_upgrade } let cycle_conflict ~version_map univ cycles = OpamCudf.cycle_conflict ~version_map univ (List.map (List.map (fun a -> Action.to_string (map_action OpamCudf.cudf2opam a))) cycles) let resolve universe ~orphans request = log "resolve request=%a" (slog string_of_request) request; let all_packages = universe.u_available ++ universe.u_installed ++ orphans in let version_map = cudf_versions_map universe all_packages in let univ_gen = load_cudf_universe universe ~version_map all_packages in let simple_universe, cudf_orphans = let u = univ_gen ~build:true ~post:true () in let cudf_orphans = OpamPackage.Set.fold (fun nv acc -> let cnv = name_to_cudf nv.name, OpamPackage.Map.find nv version_map in let cp = Cudf.lookup_package u cnv in Cudf.remove_package u cnv; cp :: acc) orphans [] in u, cudf_orphans in let add_orphan_packages u = Cudf.load_universe (List.rev_append cudf_orphans (Cudf.get_packages u)) in let request = let extra_attributes = OpamStd.List.sort_nodup compare (List.map fst universe.u_attrs @ request.extra_attributes) in { request with extra_attributes } in let request = cleanup_request universe request in let cudf_request = map_request (atom2cudf universe version_map) request in let resolve u req = try let resp = OpamCudf.resolve ~extern:true ~version_map u req in OpamCudf.to_actions add_orphan_packages u resp with OpamCudf.Solver_failure msg -> OpamConsole.error_and_exit `Solver_failure "%s" msg in match resolve simple_universe cudf_request with | Conflicts _ as c -> c | Success actions -> let simple_universe = univ_gen ~depopts:true ~build:false ~post:false () in let complete_universe = univ_gen ~depopts:true ~build:true ~post:false () in try let atomic_actions = OpamCudf.atomic_actions ~simple_universe ~complete_universe actions in Success atomic_actions with OpamCudf.Cyclic_actions cycles -> cycle_conflict ~version_map complete_universe cycles let get_atomic_action_graph t = cudf_to_opam_graph OpamCudf.cudf2opam t let installable universe = log "trim"; let simple_universe = load_cudf_universe universe universe.u_available ~build:true ~post:true () in let trimmed_universe = (* Algo.Depsolver.trim simple_universe => this can explode memory, we need to specify [~explain:false] *) let open Algo in let open Depsolver in let trimmed_pkgs = ref [] in let callback d = if Algo.Diagnostic.is_solution d then match d.Diagnostic.request with |[p] -> trimmed_pkgs := p::!trimmed_pkgs |_ -> assert false in ignore (univcheck ~callback ~explain:false simple_universe); Cudf.load_universe !trimmed_pkgs in Cudf.fold_packages (fun universe pkg -> OpamPackage.Set.add (OpamCudf.cudf2opam pkg) universe) OpamPackage.Set.empty trimmed_universe let installable_subset universe packages = log "trim-subset"; let version_map = cudf_versions_map universe universe.u_available in let simple_universe = load_cudf_universe ~build:true ~post:true universe ~version_map universe.u_available () in let cudf_packages = Cudf.get_packages ~filter:(fun p -> OpamPackage.Set.mem (OpamCudf.cudf2opam p) packages) simple_universe in let trimmed_universe = (* Algo.Depsolver.trimlist simple_universe with [~explain:false] *) let open Algo in let open Depsolver in let trimmed_pkgs = ref [] in let callback d = if Algo.Diagnostic.is_solution d then match d.Diagnostic.request with |[p] -> trimmed_pkgs := p::!trimmed_pkgs |_ -> assert false in ignore (listcheck ~callback ~explain:false simple_universe cudf_packages); Cudf.load_universe !trimmed_pkgs in Cudf.fold_packages (fun universe pkg -> OpamPackage.Set.add (OpamCudf.cudf2opam pkg) universe) OpamPackage.Set.empty trimmed_universe let filter_dependencies f_direction ~depopts ~build ~post ~installed ?(unavailable=false) universe packages = if OpamPackage.Set.is_empty packages then [] else let u_packages = packages ++ if installed then universe.u_installed else if unavailable then universe.u_packages else universe.u_available in log ~level:3 "filter_dependencies packages=%a" (slog OpamPackage.Set.to_string) packages; let version_map = cudf_versions_map universe u_packages in let cudf_universe = load_cudf_universe ~depopts ~build ~post universe ~version_map u_packages () in let cudf_packages = opam2cudf universe ~depopts ~build ~post version_map packages in log ~level:3 "filter_dependencies: dependency"; let topo_packages = f_direction cudf_universe cudf_packages in let result = List.rev_map OpamCudf.cudf2opam topo_packages in log "filter_dependencies result=%a" (slog (OpamStd.List.to_string OpamPackage.to_string)) result; result let dependencies = filter_dependencies OpamCudf.dependencies let reverse_dependencies = filter_dependencies OpamCudf.reverse_dependencies let coinstallability_check universe packages = let version_map = cudf_versions_map universe universe.u_packages in let cudf_universe = load_cudf_universe ~build:true ~post:true ~version_map universe universe.u_packages () in let cudf_packages = opam2cudf universe ~depopts:false ~build:true ~post:true version_map packages in match Algo.Depsolver.edos_coinstall cudf_universe cudf_packages with | { Algo.Diagnostic.result = Algo.Diagnostic.Success _; _ } -> None | { Algo.Diagnostic.result = Algo.Diagnostic.Failure _; _ } as c -> match OpamCudf.make_conflicts ~version_map cudf_universe c with | Conflicts cs -> Some cs | _ -> None let check_for_conflicts universe = coinstallability_check universe universe.u_installed let atom_coinstallability_check universe atoms = let packages = OpamFormula.packages_of_atoms universe.u_available atoms in let map = OpamPackage.to_map packages in List.for_all (fun (n, _) -> OpamPackage.Name.Map.mem n map) atoms && let version_map = cudf_versions_map universe universe.u_packages in let cudf_universe = load_cudf_universe ~build:true ~post:true ~version_map universe universe.u_packages () in let cudf_ll = OpamPackage.Name.Map.fold (fun n versions acc -> let packages = OpamPackage.Version.Set.fold (fun v -> OpamPackage.(Set.add (create n v))) versions OpamPackage.Set.empty in opam2cudf universe ~depopts:false ~build:true ~post:true version_map packages :: acc) map [] in let result = Algo.Depsolver.edos_coinstall_prod cudf_universe cudf_ll in List.exists Algo.Diagnostic.is_solution result let new_packages sol = OpamCudf.ActionGraph.fold_vertex (fun action packages -> match action with | `Install p | `Change (_,_,p) -> OpamPackage.Set.add (OpamCudf.cudf2opam p) packages | `Reinstall _ | `Remove _ | `Build _ -> packages ) sol OpamPackage.Set.empty let all_packages sol = OpamCudf.ActionGraph.fold_vertex (fun action packages -> List.fold_left (fun packages p -> OpamPackage.Set.add (OpamCudf.cudf2opam p) packages) packages (full_action_contents action)) sol OpamPackage.Set.empty let stats sol = OpamCudf.ActionGraph.fold_vertex (fun action stats -> match action with | `Install _ -> {stats with s_install = stats.s_install+1} | `Change (`Up,_,_) -> {stats with s_upgrade = stats.s_upgrade+1} | `Change (`Down,_,_) -> {stats with s_downgrade = stats.s_downgrade+1} | `Reinstall _ -> {stats with s_reinstall = stats.s_reinstall+1} | `Remove _ -> {stats with s_remove = stats.s_remove+1} | `Build _ -> stats) (OpamCudf.ActionGraph.reduce sol) { s_install=0; s_reinstall=0; s_upgrade=0; s_downgrade=0; s_remove=0 } let string_of_stats stats = let utf = (OpamConsole.utf8 ()) in let stats = [ stats.s_install; stats.s_reinstall; stats.s_upgrade; stats.s_downgrade; stats.s_remove; ] in let titles = List.map (fun a -> let s = OpamActionGraph.action_strings a in if utf then OpamActionGraph.action_color a s else s) [`Install (); `Reinstall (); `Change (`Up,(),()); `Change (`Down,(),()); `Remove ()] in let msgs = List.filter (fun (a,_) -> a <> 0) (List.combine stats titles) in if utf then OpamStd.List.concat_map " " (fun (n,t) -> Printf.sprintf "%s %s" t (string_of_int n)) msgs else OpamStd.List.concat_map " | " (fun (n,t) -> Printf.sprintf "%s to %s" (OpamConsole.colorise `yellow (string_of_int n)) t) msgs let solution_is_empty t = OpamCudf.ActionGraph.is_empty t let print_solution ~messages ~append ~requested ~reinstall t = let dump_cudf sfx t = match OpamSolverConfig.(!r.cudf_file) with | None -> () | Some f -> let filename = Printf.sprintf "%s-actions%s.dot" f sfx in let oc = open_out filename in ActionGraph.Dot.output_graph oc (cudf_to_opam_graph OpamCudf.cudf2opam t); close_out oc in dump_cudf "-full" t; let t = OpamCudf.ActionGraph.reduce t in dump_cudf "" t; let causes = OpamCudf.compute_root_causes t requested reinstall in let actions, details = OpamCudf.ActionGraph.Topological.fold (fun a (actions,details) -> let cause = try OpamCudf.Map.find (action_contents a) causes with Not_found -> Unknown in let action = map_action OpamCudf.cudf2opam a in let cudf_name p = OpamPackage.name_to_string (OpamCudf.cudf2opam p) in let cause = string_of_cause cudf_name cause in let messages = match a with | `Install p | `Change (_,_,p) | `Reinstall p -> messages (OpamCudf.cudf2opam p) | `Remove _ | `Build _ -> [] in action :: actions, (cause, messages) :: details ) t ([],[]) in let actions, details = List.rev actions, List.rev details in Action.to_aligned_strings ~append actions |> List.map2 (fun (cause, messages) line -> " " :: line @ [if cause = "" then "" else Printf.sprintf "[%s]" cause] @ if messages = [] then [] else [String.concat "\n" messages] ) details |> OpamStd.Format.align_table |> OpamConsole.print_table ~sep:" " stdout let dump_universe universe oc = let version_map = cudf_versions_map universe universe.u_packages in let cudf_univ = load_cudf_universe ~depopts:false ~build:true ~post:true ~version_map universe universe.u_available () in OpamCudf.dump_universe oc cudf_univ; (* Add explicit bindings to retrieve original versions of non-available and non-existing (but referred to) packages *) OpamPackage.Map.iter (fun nv i -> if not (OpamPackage.Set.mem nv universe.u_available) then Printf.fprintf oc "#v2v:%s:%d=%s\n" (OpamPackage.name_to_string nv) i (OpamPackage.version_to_string nv) ) version_map let filter_solution filter t = let t = OpamCudf.ActionGraph.copy t in let rec rm iter_deps v = if OpamCudf.ActionGraph.mem_vertex t v then ( iter_deps (rm iter_deps) t v; OpamCudf.ActionGraph.remove_vertex t v ) in OpamCudf.ActionGraph.iter_vertex (function | `Remove nv as a when not (filter (OpamCudf.cudf2opam nv)) -> rm OpamCudf.ActionGraph.iter_pred a | (`Install nv | `Change (_,_,nv)) as a when not (filter (OpamCudf.cudf2opam nv)) -> rm OpamCudf.ActionGraph.iter_succ a | _ -> ()) t; t let request ?(criteria=`Default) ?(install=[]) ?(upgrade=[]) ?(remove=[]) () = { wish_install = install; wish_upgrade = upgrade; wish_remove = remove; criteria; extra_attributes = []; } opam-2.0.5/src/solver/opamCudfSolver.mli0000644000175000017500000000350713511367404017220 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Various implementations of the low-level CUDF resolution, most of them relying on external solvers (aspcud, etc.). Used for calling-back below Dose. *) include module type of struct include OpamCudfSolverSig end module Aspcud : S module Aspcud_old : S module Mccs : S module Packup : S (** The list of supported solvers, in decreasing order of preference *) val default_solver_selection: (module S) list (** Generates a custom solver implementation from a user command. Contains some magic: - if the command matches one of the predefined ones, the default criteria are taken from there - if the command is a singleton and matches, it is expanded similarly from the pre-defined solvers *) val custom_solver : OpamTypes.arg list -> (module S) (** Like [custom_solver], but takes a simple command as a string *) val solver_of_string : string -> (module S) (** Gets the first present solver from the list. Exits with error if none was found. *) val get_solver : ?internal:bool -> (module S) list -> (module S) val has_builtin_solver : unit -> bool (** Gets the full solver name with params *) val get_name : (module S) -> string opam-2.0.5/src/solver/opamSolver.mli0000644000175000017500000001051313511367404016411 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Entry point to the solver, conversion of opam package universes to Cudf, dependencies computation. Front-end to Dose. *) open OpamTypes module Action : OpamActionGraph.ACTION with type package = package module ActionGraph : OpamActionGraph.SIG with type package = package type solution val empty_universe: universe (** {2 Solver} *) (** Convert a request to a string *) val string_of_request: atom request -> string (** Compute statistics about a solution *) val stats: solution -> stats (** Return the new packages in the solution *) val new_packages: solution -> package_set (** Return all packages appearing in the solution *) val all_packages: solution -> package_set (** Pretty-printing of statistics *) val string_of_stats: stats -> string (** Is the solution empty? *) val solution_is_empty: solution -> bool (** Display a solution *) val print_solution: messages:(package -> string list) -> append:(package -> string) -> requested:name_set -> reinstall:package_set -> solution -> unit (** Computes an opam->cudf version map from a set of package *) val cudf_versions_map: universe -> package_set -> int OpamPackage.Map.t (** Creates a CUDF universe from an OPAM universe, including the given packages. Evaluation of the first 3 arguments is staged. Warning: when [depopts] is [true], the optional dependencies may become strong dependencies. *) val load_cudf_universe: universe -> ?version_map:int package_map -> package_set -> ?depopts:bool -> build:bool -> post:bool -> unit -> Cudf.universe (** Build a request *) val request: ?criteria:solver_criteria -> ?install:atom list -> ?upgrade:atom list -> ?remove:atom list -> unit -> atom request (** Given a description of packages, return a solution preserving the consistency of the initial description. *) val resolve : universe -> orphans:package_set -> atom request -> (solution, OpamCudf.conflict) result (** Returns the graph of atomic actions (rm, inst) from a solution *) val get_atomic_action_graph : solution -> ActionGraph.t (** Keep only the packages that are installable. *) val installable: universe -> package_set (** Like [installable], but within a subset and potentially much faster *) val installable_subset: universe -> package_set -> package_set (** Return the topological sort of the transitive dependency closures of a collection of packages.*) val dependencies : depopts:bool -> build:bool -> post:bool -> installed:bool -> ?unavailable:bool -> universe -> package_set -> package list (** Same as [dependencies] but for reverse dependencies *) val reverse_dependencies : depopts:bool -> build:bool -> post:bool -> installed:bool -> ?unavailable:bool -> universe -> package_set -> package list (** Check the current set of installed packages in a universe for inconsistencies *) val check_for_conflicts : universe -> OpamCudf.conflict option (** Checks the given package set for complete installability ; returns None if they can all be installed together *) val coinstallability_check : universe -> package_set -> OpamCudf.conflict option (** Checks if the given atoms can be honored at the same time in the given universe *) val atom_coinstallability_check : universe -> atom list -> bool (** Dumps a cudf file containing all available packages in the given universe, plus version bindings (as '#v2v' comments) for the other ones. *) val dump_universe: universe -> out_channel -> unit (** Filters actions in a solution. Dependents of a removed actions are removed to keep consistency *) val filter_solution: (package -> bool) -> solution -> solution opam-2.0.5/src/solver/opamSolverConfig.mli0000644000175000017500000000350613511367404017543 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration options for the solver lib (record, global reference, setter, initialisation) *) type t = private { cudf_file: string option; solver: (module OpamCudfSolver.S) Lazy.t; best_effort: bool; solver_preferences_default: string option Lazy.t; solver_preferences_upgrade: string option Lazy.t; solver_preferences_fixup: string option Lazy.t; solver_preferences_best_effort_prefix: string option Lazy.t; solver_timeout: float option; } type 'a options_fun = ?cudf_file:string option -> ?solver:(module OpamCudfSolver.S) Lazy.t -> ?best_effort:bool -> ?solver_preferences_default:string option Lazy.t -> ?solver_preferences_upgrade:string option Lazy.t -> ?solver_preferences_fixup:string option Lazy.t -> ?solver_preferences_best_effort_prefix:string option Lazy.t -> ?solver_timeout:float option -> 'a include OpamStd.Config.Sig with type t := t and type 'a options_fun := 'a options_fun val call_solver: criteria:string -> Cudf.cudf -> Cudf.preamble option * Cudf.universe (** Checks if best_effort was set and is supported *) val best_effort: unit -> bool val criteria: OpamTypes.solver_criteria -> string opam-2.0.5/src/solver/opamActionGraph.mli0000644000175000017500000000535313511367404017344 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2014 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Handles graphs of actions (package changes), based on ocamlgraph *) open OpamTypes module type ACTION = sig type package module Pkg: GenericPackage with type t = package include OpamParallel.VERTEX with type t = package action val to_string: [< t ] -> string val to_aligned_strings: ?append:(package -> string) -> [< t ] list -> string list list module Set: OpamStd.SET with type elt = package action module Map: OpamStd.MAP with type key = package action end module MakeAction (P: GenericPackage) : ACTION with type package = P.t and type t = P.t OpamTypes.action module type SIG = sig type package include OpamParallel.GRAPH with type V.t = package OpamTypes.action (** Reduces a graph of atomic or concrete actions (only removals, installs and builds) by turning removal+install to reinstalls or up/down-grades, best for display. Dependency ordering won't be as accurate though, as there is no proper ordering of (reinstall a, reinstall b) if b depends on a. The resulting graph contains at most one action per package name. There is no guarantee however that the resulting graph is acyclic. *) val reduce: t -> t (** Expand install actions, adding a build action preceding them. The argument [noop_remove] is a function that should return `true` for package where the `remove` action is known not to modify the filesystem (such as `conf-*` package). *) val explicit: ?noop_remove:(package -> bool) -> t -> t (** Folds on all recursive successors of the given action, including itself, depth-first. *) val fold_descendants: (V.t -> 'a -> 'a) -> 'a -> t -> V.t -> 'a end module Make (A: ACTION) : SIG with type package = A.package (** Some messages that may be used for displaying actions. Single utf8 chars if the corresponding option is set, otherwise words. *) val action_strings: ?utf8:bool -> 'a action -> string (** Colorise string according to the action *) val action_color: 'a action -> string -> string opam-2.0.5/src/state/0000755000175000017500000000000013511367404013365 5ustar nicoonicooopam-2.0.5/src/state/opamPackageVar.mli0000644000175000017500000000620113511367404016750 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Resolution and handling of opam variables + filters *) open OpamTypes open OpamStateTypes (** Lists of available switch-global variables and their description *) val global_variable_names: (string * string) list (** Lists of predefined package variables and their description *) val package_variable_names: (string * string) list (** Variables that are pre-defined in the dependency filtered-formula scope, and which resolution is delayed to after the universe is computed (these are the only ones allowed in the universe, and resolved by [OpamFilter.filter_deps]) *) val predefined_depends_variables: full_variable list (** Resolves globally available variables only *) val resolve_global: 'a global_state -> full_variable -> variable_contents option (** Resolves global variables within the context of a switch. If a package is specified, "name" and "version" as taken to exclusively resolve to the current package name and version. *) val resolve_switch: ?package:package -> 'a switch_state -> full_variable -> variable_contents option (** Resolves filter variables, including global, switch and package variables ; a map of locally defined variables can be supplied, as well as the opam file of origin, which is used to resolve self-references (implicit ["%{bin}%"] or explicit ["%{_:bin}%"] *) val resolve: 'a switch_state -> ?opam:OpamFile.OPAM.t -> ?local:OpamVariable.variable_contents option OpamVariable.Map.t -> OpamFilter.env (** Like [resolve_switch], but takes more specific parameters so that it can be used before the switch state is fully loaded *) val resolve_switch_raw: ?package:package -> 'a global_state -> switch -> OpamFile.Switch_config.t -> full_variable -> variable_contents option val is_dev_package: 'a switch_state -> OpamFile.OPAM.t -> bool (** The defaults are [true] for [build], false for [dev] and [post], and defined by OpamStateConfig for [test] and [bool]. *) val filter_depends_formula: ?build:bool -> ?post:bool -> ?test:bool -> ?doc:bool -> ?dev:bool -> ?default:bool -> env:OpamFilter.env -> filtered_formula -> formula (** Assumes [filter_default=false] by default, i.e. dependencies with undefined filters are discarded. *) val all_depends: ?build:bool -> ?post:bool -> ?test:bool -> ?doc:bool -> ?dev:bool -> ?filter_default:bool -> ?depopts:bool -> 'a switch_state -> OpamFile.OPAM.t -> formula opam-2.0.5/src/state/opamSysPoll.ml0000644000175000017500000001234713511367404016210 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat open OpamStd.Option.Op let command_output c = match List.filter (fun s -> String.trim s <> "") (OpamSystem.read_command_output c) with | [""] -> None | [s] -> Some s | _ -> None | exception (OpamSystem.Process_error _ | OpamSystem.Command_not_found _) -> None let norm s = if s = "" then None else Some (String.lowercase_ascii s) let normalise_arch raw = match String.lowercase_ascii raw with | "x86" | "i386" | "i586" | "i686" -> "x86_32" | "x86_64" | "amd64" -> "x86_64" | "powerpc" | "ppc" | "ppcle" -> "ppc32" | "ppc64" | "ppc64le" -> "ppc64" | "aarch64_be" | "aarch64" | "armv8b" | "armv8l" -> "arm64" | a when List.exists (fun prefix -> OpamStd.String.starts_with ~prefix a) ["armv5"; "armv6"; "earmv6"; "armv7"; "earmv7"] -> "arm32" | s -> s let arch_lazy = lazy ( let raw = match Sys.os_type with | "Unix" | "Cygwin" -> OpamStd.Sys.uname "-m" | "Win32" -> if Sys.word_size = 32 && not (OpamStubs.isWoW64 ()) then Some "i686" else Some "x86_64" | _ -> None in match raw with | None | Some "" -> None | Some a -> Some (normalise_arch a) ) let arch () = Lazy.force arch_lazy let normalise_os raw = match String.lowercase_ascii raw with | "darwin" | "osx" -> "macos" | s -> s let os_lazy = lazy ( let raw = match Sys.os_type with | "Unix" -> OpamStd.Sys.uname "-s" | s -> norm s in match raw with | None | Some "" -> None | Some s -> Some (normalise_os s) ) let os () = Lazy.force os_lazy let os_release_field = let os_release_file = lazy ( List.find Sys.file_exists ["/etc/os-release"; "/usr/lib/os-release"] |> OpamProcess.read_lines |> OpamStd.List.filter_map (fun s -> try Scanf.sscanf s "%s@= %s" (fun x v -> let contents = try Scanf.sscanf v "\"%s@\"" (fun s -> s) with Scanf.Scan_failure _ | End_of_file -> v in Some (x, contents)) with Scanf.Scan_failure _ | End_of_file -> None) ) in fun f -> try Some (List.assoc f (Lazy.force os_release_file)) with Not_found -> None let is_android, android_release = let prop = lazy (command_output ["getprop"; "ro.build.version.release"]) in (fun () -> Lazy.force prop <> None), (fun () -> Lazy.force prop) let os_distribution_lazy = lazy ( match os () with | Some "macos" as macos -> if OpamSystem.resolve_command "brew" <> None then Some "homebrew" else if OpamSystem.resolve_command "port" <> None then Some "macports" else macos | Some "linux" as linux -> (if is_android () then Some "android" else os_release_field "ID" >>= norm >>+ fun () -> command_output ["lsb_release"; "-i"; "-s"] >>= norm >>+ fun () -> try List.find Sys.file_exists ["/etc/redhat-release"; "/etc/centos-release"; "/etc/gentoo-release"; "/etc/issue"] |> fun s -> Scanf.sscanf s " %s " norm with Not_found -> linux) | os -> os ) let os_distribution () = Lazy.force os_distribution_lazy let os_version_lazy = lazy ( match os () with | Some "linux" -> android_release () >>= norm >>+ fun () -> command_output ["lsb_release"; "-s"; "-r"] >>= norm >>+ fun () -> os_release_field "VERSION_ID" >>= norm | Some "macos" -> command_output ["sw_vers"; "-productVersion"] >>= norm | Some "win32" -> let (major, minor, build, _) = OpamStubs.getWindowsVersion () in OpamStd.Option.some @@ Printf.sprintf "%d.%d.%d" major minor build | Some "cygwin" -> (try command_output ["cmd"; "/C"; "ver"] >>= fun s -> Scanf.sscanf s "%_s@[ Version %s@]" norm with Scanf.Scan_failure _ | End_of_file -> None) | Some "freebsd" -> OpamStd.Sys.uname "-U" >>= norm | _ -> OpamStd.Sys.uname "-r" >>= norm ) let os_version () = Lazy.force os_version_lazy let os_family_lazy = lazy ( match os () with | Some "linux" -> (os_release_field "ID_LIKE" >>= fun s -> Scanf.sscanf s " %s" norm (* first word *)) >>+ os_distribution | Some ("freebsd" | "openbsd" | "netbsd" | "dragonfly") -> Some "bsd" | Some ("win32" | "cygwin") -> Some "windows" | _ -> os_distribution () ) let os_family () = Lazy.force os_family_lazy let variables = List.map (fun (n, v) -> OpamVariable.of_string n, lazy (Lazy.force v >>| fun v -> OpamTypes.S v)) [ "arch", arch_lazy; "os", os_lazy; "os-distribution", os_distribution_lazy; "os-version", os_version_lazy; "os-family", os_family_lazy; ] opam-2.0.5/src/state/dune0000644000175000017500000000102513511367404014241 0ustar nicoonicoo(library (name opam_state) (public_name opam-state) (libraries opam-repository) (synopsis "OCaml Package Manager instance management library") (modules_without_implementation OpamStateTypes) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (wrapped false)) (rule (targets opamScript.ml) (deps ../../shell/crunch.ml (glob_files shellscripts/*.*sh)) (action (with-stdout-to %{targets} (run ocaml %{deps})))) opam-2.0.5/src/state/opamFormatUpgrade.ml0000644000175000017500000012646013511367404017345 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamStd.Op open OpamFilename.Op let log fmt = OpamConsole.log "FMT_UPG" fmt let slog = OpamConsole.slog exception Upgrade_done of OpamFile.Config.t (* - Package and aux functions - *) let upgrade_depexts_to_2_0_beta5 filename depexts = let arch = OpamVariable.of_string "arch" in let os = OpamVariable.of_string "os" in let os_family = OpamVariable.of_string "os-family" in let distro = OpamVariable.of_string "os-distribution" in let eq var v = FOp (FIdent ([], var, None), `Eq, FString v) in (* Transform all known tags into the corresponding filters *) let rec transform_filter = let transform_tag = function | "amd64" -> eq arch "x86_64" | "x86" -> eq arch "x86_32" | "arm"|"armv7" -> eq arch "arm32" | "ppc" -> eq arch "ppc32" | "x86_64" | "ppc64" as a -> eq arch a | "osx" -> eq os "macos" | "linux" | "unix" | "xenserver" | "freebsd" | "openbsd" | "netbsd" | "dragonfly" | "win32" | "cygwin" as o -> eq os o | "nixpkgs" -> eq distro "nixos" | "arch" -> eq distro "archlinux" | "homebrew" | "macports" | "debian" | "ubuntu" | "centos" | "fedora" | "rhel" | "opensuse" | "oraclelinux" | "mageia" | "alpine" | "archlinux" | "gentoo" | "nixos" as d -> eq distro d | "bsd" -> eq os_family "bsd" | "mswindows" -> eq os_family "windows" | "source" -> failwith "\"source\" tag" | s -> failwith ("Unknown tag "^s) in function | FAnd (f1, f2) -> FAnd (transform_filter f1, transform_filter f2) | FString s -> transform_tag s | _ -> raise Exit (* the filter is already in the new format if it contains anything else *) in OpamStd.List.filter_map (fun (names, filter) -> try Some (names, transform_filter filter) with | Exit -> Some (names, filter) | Failure m -> OpamConsole.warning "Ignored depext in %s: %s" filename m; None) depexts let opam_file_from_1_2_to_2_0 ?filename opam = let ocaml_pkgname = OpamPackage.Name.of_string "ocaml" in let ocaml_wrapper_pkgname = OpamPackage.Name.of_string "ocaml" in let ocaml_official_pkgname = OpamPackage.Name.of_string "ocaml-base-compiler" in let ocaml_variants_pkgname = OpamPackage.Name.of_string "ocaml-variants" in let ocaml_system_pkgname = OpamPackage.Name.of_string "ocaml-system" in let filename = match filename with | Some f -> OpamFile.to_string f | None -> match OpamFile.OPAM.metadata_dir opam with | Some d -> OpamFilename.to_string (d // "opam") | None -> "opam file" in let available = OpamFilter.distribute_negations (OpamFile.OPAM.available opam) in let sym_op = function | (`Eq | `Neq) as op -> op | `Gt -> `Lt | `Geq -> `Leq | `Lt -> `Gt | `Leq -> `Geq in let mk_constraint op v = Atom (Constraint (op, FString v)) in let get_atom ?(op=`Eq) v = if v = "system" then ocaml_system_pkgname, Empty else (if String.contains v '+' then ocaml_variants_pkgname else ocaml_official_pkgname), mk_constraint op v in let module NMap = OpamPackage.Name.Map in let pkg_deps, pkg_conflicts, available_opt = let rec aux avail = match avail with | FOp (FString _ as fs, op, (FIdent _ as fid)) -> aux (FOp (fid, sym_op op, fs)) | FOp (FIdent ([],var,None), op, FString v) -> (match OpamVariable.to_string var, op with | "ocaml-version", _ -> NMap.singleton ocaml_wrapper_pkgname (mk_constraint op v), NMap.empty, None | "compiler", `Neq -> NMap.empty, NMap.of_list [get_atom v], None | "compiler", op -> NMap.of_list [get_atom ~op v], NMap.empty, None | _ -> NMap.empty, NMap.empty, Some avail) | FIdent ([], v, None) when OpamVariable.to_string v = "preinstalled" -> NMap.singleton ocaml_system_pkgname Empty, NMap.empty, None | FNot (FIdent ([], v, None)) when OpamVariable.to_string v = "preinstalled" -> NMap.empty, NMap.singleton ocaml_system_pkgname Empty, None | FNot f -> let pkg_deps, pkg_conflicts, available_opt = aux f in pkg_conflicts, pkg_deps, OpamStd.Option.map (fun f -> FNot f) available_opt | FAnd (f1,f2) -> let deps1, cflt1, f1 = aux f1 in let deps2, cflt2, f2 = aux f2 in (NMap.union (fun d1 d2 -> OpamFormula.ands [d1; d2]) deps1 deps2, NMap.union (fun c1 c2 -> OpamFormula.ors [c1; c2]) cflt1 cflt2, match f1, f2 with | Some f1, Some f2 -> Some (FAnd (f1, f2)) | None, f | f, None -> f) | FOr (f1,f2) -> let deps1, cflt1, f1 = aux f1 in let deps2, cflt2, f2 = aux f2 in let err () = OpamConsole.error "Unconvertible 'available:' disjunction in %s" filename in (NMap.union (fun d1 d2 -> OpamFormula.ors [d1; d2]) deps1 deps2, NMap.union (fun c1 c2 -> OpamFormula.ands [c1; c2]) cflt1 cflt2, match f1, f2 with | Some f1, Some f2 -> Some (FOr (f1,f2)) | None, None -> None | None, f | f, None -> err (); f) | f -> NMap.empty, NMap.empty, Some f in aux available in let pkg_deps = if NMap.mem ocaml_wrapper_pkgname pkg_deps || OpamFile.OPAM.has_flag Pkgflag_Conf opam then pkg_deps else NMap.add ocaml_wrapper_pkgname Empty pkg_deps in let available = OpamStd.Option.default (FBool true) available_opt in if List.exists (fun v -> match OpamVariable.Full.to_string v with | "ocaml-version" | "compiler" | "preinstalled" | "ocaml-native" | "ocaml-native-tools" | "ocaml-native-dynlink" -> true | _ -> false) (OpamFilter.variables available) then OpamConsole.warning "Could not translate some 'ocaml-*' variables in the 'available:' \ field of %s: %s" filename (OpamFilter.to_string available); let depends = let to_add,conj = List.fold_left (fun (to_add,conj) -> function | Atom (pkgname, cstr) as atom -> (try NMap.remove pkgname to_add, Atom (pkgname, OpamFormula.ands [cstr; NMap.find pkgname to_add]) :: conj with Not_found -> to_add, atom :: conj) | f -> to_add, f::conj) (pkg_deps, []) (OpamFormula.ands_to_list (OpamFile.OPAM.depends opam)) in let remain = List.map (fun (name, cstr) -> Atom (name, cstr)) (NMap.bindings to_add) in OpamFormula.ands (remain @ List.rev conj) in let rwr_depflags = let rwr_vars v = match OpamVariable.Full.to_string v with | "test" -> OpamVariable.Full.of_string "with-test" | "doc" -> OpamVariable.Full.of_string "with-doc" | _ -> v in OpamFormula.map (fun (name, cstr) -> let cstr = OpamFormula.map (function | Filter f -> Atom (Filter (OpamFilter.map_variables rwr_vars f)) | Constraint _ as c -> Atom c) cstr in Atom (name, cstr)) in let depends = rwr_depflags depends in let depopts = rwr_depflags (OpamFile.OPAM.depopts opam) in let conflicts = let to_add, disj = List.fold_left (fun (to_add,disj) -> function | Atom (pkgname, cstr) as atom -> (try NMap.remove pkgname to_add, Atom (pkgname, OpamFormula.ors [cstr; NMap.find pkgname to_add]) :: disj with Not_found -> to_add, atom :: disj) | f -> to_add, f::disj) (pkg_conflicts,[]) (OpamFormula.ors_to_list (OpamFile.OPAM.conflicts opam)) in let remain = List.map (fun (name, cstr) -> Atom (name, cstr)) (NMap.bindings to_add) in OpamFormula.ors (remain @ List.rev disj) in let rewrite_var v = let mkvar s = OpamVariable.Full.create ocaml_pkgname (OpamVariable.of_string s) in match OpamVariable.Full.scope v with | OpamVariable.Full.Global -> (match OpamVariable.(to_string (Full.variable v)) with | "compiler" -> mkvar "compiler" | "preinstalled" -> mkvar "preinstalled" | "ocaml-version" -> mkvar "version" | "ocaml-native" -> mkvar "native" | "ocaml-native-tools" -> mkvar "native-tools" | "ocaml-native-dynlink" -> mkvar "native-dynlink" | _ -> v) | _ -> v in let auto_add_flags opam = (* Automatically add light-uninstall for trivial commands that won't need the source *) if OpamFile.OPAM.remove opam <> [] && List.for_all (fun (cmd, _filter) -> match cmd with | [] | (CString ("ocamlfind" | "rm"), _) :: _ -> true | _ -> false) (OpamFile.OPAM.remove opam) then OpamFile.OPAM.add_flags [Pkgflag_LightUninstall] opam else opam in let filter_out_flagtags opam = OpamFile.OPAM.with_tags (List.filter (fun tag -> OpamFile.OPAM.flag_of_tag tag = None) (OpamFile.OPAM.tags opam)) opam in let build_doc, install_doc = let rec split acc = function | [] -> List.rev acc, [] | (cmd, _ as c) :: r as l -> if List.exists (function | CString s, _ -> OpamStd.String.contains ~sub:"install" s | _ -> false) cmd then List.rev acc, l else split (c::acc) r in split [] (OpamFile.OPAM.deprecated_build_doc opam) in let add_filter to_add cmdlist = List.map (fun (cmd,filter) -> cmd, match filter with | None -> Some to_add | Some f -> Some (FAnd (to_add, f))) cmdlist in let test_filter = FIdent ([], OpamVariable.of_string "with-test", None) in let doc_filter = FIdent ([], OpamVariable.of_string "with-doc", None) in let build = OpamFile.OPAM.build opam @ add_filter test_filter (OpamFile.OPAM.deprecated_build_test opam) @ add_filter doc_filter build_doc in let install = OpamFile.OPAM.install opam @ add_filter doc_filter install_doc in let dev_repo = OpamStd.Option.map (OpamUrl.parse ~handle_suffix:true @* OpamUrl.to_string) (OpamFile.OPAM.dev_repo opam) in let depexts = upgrade_depexts_to_2_0_beta5 filename (OpamFile.OPAM.depexts opam) in let rwr_os_filters = OpamSysPoll.normalise_os in let rwr_arch_filters = OpamSysPoll.normalise_arch in let rewrite_filter = OpamFilter.map_up (function | FOp (FIdent ([],vname,None) as v, op, FString value) as ft -> (match OpamVariable.to_string vname with | "os" -> FOp (v, op, FString (rwr_os_filters value)) | "arch" -> FOp (v, op, FString (rwr_arch_filters value)) | _ -> ft) | FOp (FString value, op, (FIdent ([],vname,None) as v)) as ft -> (match OpamVariable.to_string vname with | "os" -> FOp (FString (rwr_os_filters value), op, v) | "arch" -> FOp (FString (rwr_arch_filters value), op, v) | _ -> ft) | ft -> ft) in opam |> OpamFile.OPAM.with_opam_version (OpamVersion.of_string "2.0") |> OpamFile.OPAM.with_depends depends |> OpamFile.OPAM.with_depopts depopts |> OpamFile.OPAM.with_conflicts conflicts |> OpamFile.OPAM.with_available available |> OpamFile.OPAM.with_build build |> OpamFile.OPAM.with_install install |> OpamFile.OPAM.with_dev_repo_opt dev_repo |> OpamFile.OPAM.with_deprecated_build_test [] |> OpamFile.OPAM.with_deprecated_build_doc [] |> OpamFileTools.map_all_variables rewrite_var |> OpamFileTools.map_all_filters rewrite_filter |> OpamFile.OPAM.with_depexts depexts |> auto_add_flags |> filter_out_flagtags (* - Progressive version update functions - *) let v1_1 = OpamVersion.of_string "1.1" let from_1_0_to_1_1 root _config = OpamConsole.error_and_exit `Configuration_error "You appear to have an opam setup dating back to opam 1.0, which is no \ longer supported since opam 2.0. Please remove \"%s\" and run \ `opam init`" (OpamFilename.Dir.to_string root) let v1_2 = OpamVersion.of_string "1.2" let from_1_1_to_1_2 root config = log "Upgrade pinned packages format to 1.2"; let aliases = OpamFile.Aliases.safe_read (OpamFile.make (root // "aliases")) in let remove_pinned_suffix d = let s = OpamFilename.Dir.to_string d in if Filename.check_suffix s ".pinned" then OpamFilename.move_dir ~src:d ~dst:(OpamFilename.Dir.of_string (Filename.chop_suffix s ".pinned")) in let packages = lazy ( OpamPackage.Set.of_list (OpamPackage.Map.keys (OpamFile.Package_index.safe_read (OpamFile.make (root / "repo" // "package-index")))) ) in OpamSwitch.Map.iter (fun switch _ -> let switch_root = root / OpamSwitch.to_string switch in let pinned_version name = try let f = OpamFile.make (switch_root / "overlay" / OpamPackage.Name.to_string name // "opam") in match OpamFile.OPAM.version_opt (OpamFile.OPAM.read f) with | None -> raise Not_found | Some v -> v with e -> OpamStd.Exn.fatal e; try OpamPackage.version (OpamPackage.max_version (Lazy.force packages) name) with Not_found -> OpamPackage.Version.of_string "0" in let fix_version nv = let obsolete_pinned_v = OpamPackage.Version.of_string "pinned" in if nv.version = obsolete_pinned_v then let name = nv.name in OpamPackage.create name (pinned_version name) else nv in List.iter remove_pinned_suffix (OpamFilename.dirs (switch_root / "packages.dev")); List.iter remove_pinned_suffix (OpamFilename.dirs (switch_root / "overlay")); let switch_prefix = switch_root in let installed_f = OpamFile.make OpamFilename.Op.(switch_prefix // "installed") in let installed = OpamFile.PkgList.safe_read installed_f in OpamFile.PkgList.write installed_f (OpamPackage.Set.map fix_version installed); let installed_roots_f = OpamFile.make OpamFilename.Op.(switch_prefix // "installed.roots") in let installed_roots = OpamFile.PkgList.safe_read installed_roots_f in OpamFile.PkgList.write installed_roots_f (OpamPackage.Set.map fix_version installed_roots); (* Move .config files *) List.iter (fun f -> let name = OpamFilename.Base.to_string @@ OpamFilename.basename @@ OpamFilename.chop_extension f in if name <> "global-config" then let dst = switch_root / "lib" / name // "opam.config" in OpamFilename.mkdir (OpamFilename.dirname dst); OpamFilename.move ~src:f ~dst ) (OpamFilename.files (switch_root / "config")) ) aliases; config let v1_3_dev2 = OpamVersion.of_string "1.3~dev2" let from_1_2_to_1_3_dev2 root config = log "Upgrade switch state files format to 1.3"; let aliases = OpamFile.Aliases.safe_read (OpamFile.make (root // "aliases")) in OpamSwitch.Map.iter (fun switch c -> let switch_dir = root / OpamSwitch.to_string switch in let installed_f = switch_dir // "installed" in let installed_roots_f = switch_dir // "installed.roots" in let pinned_f = switch_dir // "pinned" in let installed = OpamFile.PkgList.safe_read (OpamFile.make installed_f) in let installed_roots = OpamFile.PkgList.safe_read (OpamFile.make installed_roots_f) in let pinned = OpamFile.Pinned_legacy.safe_read (OpamFile.make pinned_f) in let pinned = OpamPackage.Name.Map.mapi (fun name pin -> let v = match pin with | OpamFile.Pinned_legacy.Version v -> v | OpamFile.Pinned_legacy.Source _ -> let overlay = OpamFile.make (switch_dir / "overlay" / OpamPackage.Name.to_string name // "opam") in let opam = OpamFile.OPAM.safe_read overlay in OpamStd.Option.default (OpamPackage.Version.of_string "0") (OpamFile.OPAM.version_opt opam) in v, pin) pinned in let sel_pinned = OpamPackage.Name.Map.fold (fun name (v,_) -> OpamPackage.Set.add (OpamPackage.create name v)) pinned OpamPackage.Set.empty in let compiler = let version = match OpamStd.String.cut_at c '+' with | Some (v,_) -> v | None -> c in let comp = OpamFile.Comp.read (OpamFile.make (root / "compilers" / version / c // (c ^".comp"))) in let atoms = OpamFormula.atoms (OpamFile.Comp.packages comp) in List.fold_left (fun acc (name,_) -> let nv = try let v, _ = OpamPackage.Name.Map.find name pinned in OpamPackage.create name v with Not_found -> try OpamPackage.max_version installed name with Not_found -> OpamPackage.create name (OpamPackage.Version.of_string "~unknown") in OpamPackage.Set.add nv acc) OpamPackage.Set.empty atoms in OpamFile.LegacyState.write (OpamFile.make (switch_dir // "state")) { sel_installed = installed; sel_roots = installed_roots; sel_pinned; sel_compiler = compiler }; OpamFilename.remove installed_f; OpamFilename.remove installed_roots_f; OpamFilename.remove pinned_f; (* Move .config files back *) OpamPackage.Set.iter (fun nv -> let name = nv.name in let src = switch_dir / "lib" / OpamPackage.Name.to_string name // "opam.config" in let dst = switch_dir / "config" // (OpamPackage.Name.to_string name ^ ".config") in if OpamFilename.exists src then OpamFilename.move ~src ~dst) installed) aliases; config let v1_3_dev5 = OpamVersion.of_string "1.3~dev5" let from_1_3_dev2_to_1_3_dev5 root conf = log "Upgrade switch state files format to 1.3 step 2"; let aliases_f = OpamFile.make (root // "aliases") in let aliases = OpamFile.Aliases.safe_read aliases_f in OpamSwitch.Map.iter (fun switch comp_name -> (* Convert state-file table format to selections file, opam syntax format *) let switch_dir = root / OpamSwitch.to_string switch in let state_f = OpamFile.make (switch_dir // "state") in let selections = OpamFile.LegacyState.safe_read state_f in let selections_f = OpamFile.make (switch_dir // "switch-state") in let comp_version = match OpamStd.String.cut_at comp_name '+' with | Some (v,_) -> v | None -> comp_name in (* Change comp file to a package *) let selections = if comp_name <> "empty" then let comp_f = OpamFile.make (root / "compilers" / comp_version / comp_name // (comp_name ^ ".comp")) in let comp = OpamFile.Comp.read comp_f in let descr_f = OpamFile.make (root / "compilers" / comp_version / comp_name // (comp_name ^ ".descr")) in let descr = OpamStd.Option.default (OpamFile.Descr.create "Switch relying on a system-wide installation of OCaml") (OpamFile.Descr.read_opt descr_f) in let comp_opam = OpamFile.Comp.to_package comp (Some descr) in let nv = OpamFile.OPAM.package comp_opam in let name = nv.name in let switch_config_f = OpamFile.make (switch_dir / "config" // "global-config.config") in let switch_config = OpamFile.Dot_config.safe_read switch_config_f in let config = if OpamFile.Comp.preinstalled comp then let config = OpamFile.Dot_config.create @@ List.map (fun (v,c) -> OpamVariable.of_string v, c) @@ [ "compiler", S comp_name; "preinstalled", B true; ] in let ocamlc = try let path = OpamStd.Env.get "PATH" |> OpamStd.Sys.split_path_variable |> List.filter (fun s -> not (OpamStd.String.starts_with ~prefix:(OpamFilename.Dir.to_string root) s)) in List.fold_left (function | None -> fun d -> let f = OpamStd.Sys.executable_name (Filename.concat d "ocamlc") in if Sys.file_exists f then Some (OpamFilename.of_string f) else None | s -> fun _ -> s) None path with Not_found -> None in match ocamlc with | Some ocamlc -> let vnum = OpamSystem.read_command_output ~verbose:false [ OpamFilename.to_string ocamlc ; "-vnum" ] in config |> OpamFile.Dot_config.with_file_depends [ocamlc, OpamHash.compute (OpamFilename.to_string ocamlc)] |> OpamFile.Dot_config.set (OpamVariable.of_string "ocaml-version") (Some (S (String.concat "" vnum))) | None -> config else let get_dir d = match OpamFile.Dot_config.variable switch_config (OpamVariable.of_string d) with | Some (S d) -> OpamFilename.Dir.of_string d | _ -> OpamPath.Switch.get_stdpath root switch OpamFile.Switch_config.empty (std_path_of_string d) in OpamFile.Dot_config.create @@ List.map (fun (v,c) -> OpamVariable.of_string v, c) @@ [ "ocaml-version", S (OpamFile.Comp.version comp); "compiler", S comp_name; "preinstalled", B false; "ocaml-native", B (OpamFilename.exists (get_dir "bin" // "ocamlopt")); "ocaml-native-tools", B (OpamFilename.exists (get_dir "bin" // "ocamlc.opt")); "ocaml-native-dynlink", B (OpamFilename.exists (get_dir "lib" / "ocaml" // "dynlink.cmxa")); "ocaml-stubsdir", S (OpamFilename.Dir.to_string (get_dir "stublibs")); ] in let config_f = OpamFile.make (switch_dir / "config" // (OpamPackage.Name.to_string name ^".config")) in OpamFile.OPAM.write (OpamFile.make (root / "packages" / OpamPackage.Name.to_string name / OpamPackage.to_string nv // "opam")) comp_opam; OpamFile.Dot_config.write config_f config; (* Also export compiler variables as globals *) OpamFile.Dot_config.write switch_config_f (OpamFile.Dot_config.with_vars (OpamFile.Dot_config.bindings switch_config @ OpamFile.Dot_config.bindings config) switch_config); { selections with sel_installed = OpamPackage.Set.add nv selections.sel_installed; sel_compiler = OpamPackage.Set.add nv selections.sel_compiler; sel_roots = OpamPackage.Set.add nv selections.sel_roots; } else selections in OpamFile.SwitchSelections.write selections_f selections; OpamFilename.remove (OpamFile.filename state_f)) aliases; let conf = OpamFile.Config.with_installed_switches (OpamSwitch.Map.keys aliases) conf in OpamFilename.remove (OpamFile.filename aliases_f); conf let v1_3_dev6 = OpamVersion.of_string "1.3~dev6" let from_1_3_dev5_to_1_3_dev6 root conf = log "Upgrade switch state files format to 1.3 step 3"; (* Move switch internals to [switch/.opam-switch] *) List.iter (fun switch -> let switch_dir = root / OpamSwitch.to_string switch in let meta_dir = switch_dir / ".opam-switch" in OpamFilename.mkdir meta_dir; List.iter (fun f -> let src = switch_dir // f in let dst = meta_dir // f in if OpamFilename.exists src then OpamFilename.move ~src ~dst) ["lock"; "switch-state"; "reinstall"; "environment"]; List.iter (fun d -> let src = switch_dir / d in let dst = meta_dir / d in if OpamFilename.exists_dir src then OpamFilename.move_dir ~src ~dst) ["backup"; "build"; "install"; "config"; "packages.dev"; "overlay"] ) (OpamFile.Config.installed_switches conf); conf let v1_3_dev7 = OpamVersion.of_string "1.3~dev7" let from_1_3_dev6_to_1_3_dev7 root conf = log "Upgrade switch state files format to 1.3 step 4"; (* Get mirrors of the metadata of all installed packages into switch_meta_dir/packages *) List.iter (fun switch -> let switch_dir = root / OpamSwitch.to_string switch in let meta_dir = switch_dir / ".opam-switch" in let installed = (OpamFile.SwitchSelections.safe_read (OpamFile.make (meta_dir // "switch-state"))) .sel_installed in OpamFilename.mkdir (meta_dir / "packages"); OpamPackage.Set.iter (fun nv -> let dstdir = meta_dir / "packages" / OpamPackage.to_string nv in try let srcdir = List.find (fun d -> OpamFilename.exists (d // "opam")) [ meta_dir / "overlay" / OpamPackage.Name.to_string nv.name; root / "packages" / OpamPackage.Name.to_string nv.name / OpamPackage.to_string nv; ] in match OpamFileTools.read_opam srcdir with | Some opam -> OpamFile.OPAM.write (OpamFile.make (dstdir // "opam")) opam; OpamStd.Option.iter (fun src -> OpamFilename.copy_dir ~src ~dst:(dstdir / "files")) (OpamFilename.opt_dir (srcdir / "files")) | None -> raise Not_found with Not_found -> OpamFile.OPAM.write (OpamFile.make (dstdir // "opam")) (OpamFile.OPAM.create nv) ) installed) (OpamFile.Config.installed_switches conf); OpamFilename.rmdir (root / "packages"); OpamFilename.rmdir (root / "packages.dev"); OpamFilename.rmdir (root / "state.cache"); conf let v2_0_alpha = OpamVersion.of_string "2.0~alpha" let from_1_3_dev7_to_2_0_alpha root conf = log "Upgrade switch state files format to 2.0~alpha"; (* leftovers from previous upgrades *) OpamFilename.rmdir (root / "compilers"); OpamFilename.remove (root / "repo" // "package-index"); OpamFilename.remove (root / "repo" // "compiler-index"); (* turn repo priorities into an ordered list in ~/.opam/config, repo conf files into a single file repo/repos-config *) let prio_repositories = List.map (fun name -> let conf_file = OpamFile.make (root / "repo" / OpamRepositoryName.to_string name // "config") in let module RCL = OpamFile.Repo_config_legacy in let conf = RCL.read conf_file in OpamFilename.remove (OpamFile.filename conf_file); conf.RCL.repo_priority, name, conf.RCL.repo_url) (OpamFile.Config.repositories conf) in OpamFile.Repos_config.write (OpamPath.repos_config root) (OpamRepositoryName.Map.of_list (List.map (fun (_, r, u) -> r, Some (u,None)) prio_repositories)); let prio_repositories = List.stable_sort (fun (prio1, _, _) (prio2, _, _) -> prio2 - prio1) prio_repositories in let repositories_list = List.map (fun (_, r, _) -> r) prio_repositories in OpamFile.Config.with_repositories repositories_list conf let v2_0_alpha2 = OpamVersion.of_string "2.0~alpha2" let from_2_0_alpha_to_2_0_alpha2 root conf = List.iter (fun switch -> let switch_dir = root / OpamSwitch.to_string switch in let meta_dir = switch_dir / ".opam-switch" in (* Cleanup exported variables from the switch config (they are now defined in wrapper package 'ocaml', and accessed as e.g. 'ocaml:native-dynlink') *) let to_remove_vars = List.map OpamVariable.of_string [ "ocaml-version"; "compiler"; "preinstalled"; "ocaml-native"; "ocaml-native-tools"; "ocaml-native-dynlink"; "ocaml-stubsdir"; ] in let remove_vars config = OpamFile.Dot_config.with_vars (List.filter (fun (var, _) -> not (List.mem var to_remove_vars)) (OpamFile.Dot_config.bindings config)) config in let switch_config_f = OpamFile.make (meta_dir / "config" // "global-config.config") in let switch_config = OpamFile.Dot_config.safe_read switch_config_f in OpamFile.Dot_config.write switch_config_f (remove_vars switch_config); (* Rename the 'ocaml' compiler packages to their proper instance (and let the wrapper 'ocaml' package be pulled from the repository later on to detect and set the 'ocaml:*' variables *) let selections_file = OpamFile.make (meta_dir // "switch-state") in let selections = OpamFile.SwitchSelections.safe_read selections_file in let new_compilers = OpamPackage.Set.map (fun nv -> if nv.name <> OpamPackage.Name.of_string "ocaml" then nv else let config_f nv = OpamFile.make (meta_dir / "config" // (OpamPackage.Name.to_string nv.name ^ ".config")) in let config = OpamFile.Dot_config.safe_read (config_f nv) in let ocaml_version_var = OpamVariable.of_string "ocaml-version" in let ocaml_version = match OpamFile.Dot_config.variable switch_config ocaml_version_var with | Some (S v) -> OpamPackage.Version.of_string v | _ -> match OpamFile.Dot_config.variable config ocaml_version_var with | Some (S v) -> OpamPackage.Version.of_string v | _ -> nv.version in let full_version = OpamPackage.Version.to_string nv.version in let name, version = match OpamStd.String.cut_at full_version '+' with | None when full_version = "system" -> OpamPackage.Name.of_string "ocaml-system", ocaml_version | None -> OpamPackage.Name.of_string "ocaml-base-compiler", ocaml_version | Some (_version, _variant) -> OpamPackage.Name.of_string "ocaml-variants", OpamPackage.Version.of_string full_version in let new_nv = OpamPackage.create name version in let pkgdir nv = meta_dir / "packages" / OpamPackage.to_string nv in if OpamFilename.exists_dir (pkgdir nv) then OpamFilename.move_dir ~src:(pkgdir nv) ~dst:(pkgdir new_nv); OpamStd.Option.Op.( OpamFilename.opt_file (pkgdir new_nv // "opam") >>| OpamFile.make >>= fun f -> OpamFile.OPAM.read_opt f >>| opam_file_from_1_2_to_2_0 ~filename:f >>| OpamFile.OPAM.write_with_preserved_format f ) |> ignore; if OpamFile.exists (config_f nv) then (OpamFile.Dot_config.write (config_f new_nv) (remove_vars config); OpamFilename.remove (OpamFile.filename (config_f nv))); let install_f nv = meta_dir / "install" // (OpamPackage.Name.to_string nv.name ^ ".install") in if OpamFilename.exists (install_f nv) then OpamFilename.move ~src:(install_f nv) ~dst:(install_f new_nv); let changes_f nv = meta_dir / "install" // (OpamPackage.Name.to_string nv.name ^ ".changes") in if OpamFilename.exists (changes_f nv) then OpamFilename.move ~src:(changes_f nv) ~dst:(changes_f new_nv); new_nv ) selections.sel_compiler in let selections = let open OpamPackage.Set.Op in { selections with sel_installed = selections.sel_installed -- selections.sel_compiler ++ new_compilers; sel_roots = selections.sel_roots -- selections.sel_compiler ++ new_compilers; sel_compiler = new_compilers } in OpamFile.SwitchSelections.write selections_file selections; (* Update pinned overlay opam files *) OpamPackage.Set.iter (fun nv -> let pkg_dir = meta_dir / "overlay" / OpamPackage.Name.to_string nv.name in let opamf = pkg_dir // "opam" in let opam0 = OpamFile.make opamf in OpamStd.Option.iter (fun opam -> opam_file_from_1_2_to_2_0 ~filename:opam0 opam |> OpamFile.OPAM.write_with_preserved_format opam0; OpamFilename.remove (pkg_dir // "descr"); OpamFilename.remove (pkg_dir // "url") ) (OpamFileTools.read_opam pkg_dir) ) selections.sel_pinned; ) (OpamFile.Config.installed_switches conf); OpamFile.Config.with_eval_variables [ OpamVariable.of_string "sys-ocaml-version", ["ocamlc"; "-vnum"], "OCaml version present on your system independently of opam, if any"; ] conf let v2_0_alpha3 = OpamVersion.of_string "2.0~alpha3" let from_2_0_alpha2_to_2_0_alpha3 root conf = List.iter (fun switch -> let switch_dir = root / OpamSwitch.to_string switch in let old_global_config = switch_dir / ".opam-switch" / "config" // "global-config.config" in match OpamFile.Dot_config.read_opt (OpamFile.make old_global_config) with | None -> () | Some oldconf -> let new_config_file = switch_dir / ".opam-switch" // "switch-config" in let opam_root, paths, variables = List.fold_left (fun (root, paths, variables) (var, value) -> match OpamVariable.to_string var, value with | "root", S r -> (Some (OpamFilename.Dir.of_string r), paths, variables) | stdpath, S d when (try ignore (std_path_of_string stdpath); true with Failure _ -> false) -> root, (std_path_of_string stdpath, d) :: paths, variables | _, value -> root, paths, (var, value) :: variables) (None, [], []) (OpamFile.Dot_config.bindings oldconf) in let new_config = { OpamFile.Switch_config. opam_version = OpamVersion.nopatch v2_0_alpha3; synopsis = ""; repos = None; opam_root; paths; variables; wrappers = OpamFile.Wrappers.empty; env = []; } in OpamFile.Switch_config.write (OpamFile.make new_config_file) new_config; OpamFilename.remove old_global_config ) (OpamFile.Config.installed_switches conf); conf let v2_0_beta = OpamVersion.of_string "2.0~beta" let from_2_0_alpha3_to_2_0_beta root conf = List.iter (fun switch -> let switch_meta_dir = root / OpamSwitch.to_string switch / ".opam-switch" in let packages_dev_dir = switch_meta_dir / "packages.dev" in (* old *) let sources_dir = switch_meta_dir / "sources" in (* new *) let state = OpamFile.SwitchSelections.safe_read (OpamFile.make (switch_meta_dir // "switch-state")) in OpamFilename.mkdir sources_dir; List.iter (fun d -> try let name = OpamPackage.Name.of_string OpamFilename.(Base.to_string (basename_dir d)) in let dst = if OpamPackage.has_name state.sel_pinned name then sources_dir / OpamPackage.Name.to_string name else let nv = OpamPackage.package_of_name state.sel_installed name in sources_dir / OpamPackage.to_string nv in (* Extract version-pinned archives to source dirs *) match OpamFilename.files d with | file::[] when OpamFilename.is_archive file -> OpamFilename.extract_in file dst; OpamFilename.remove file | _ -> () with Failure _ | Not_found -> () ) (OpamFilename.dirs packages_dev_dir); OpamFilename.rmdir packages_dev_dir; ) (OpamFile.Config.installed_switches conf); (if OpamFile.Config.default_compiler conf <> Empty then conf else OpamFile.Config.with_default_compiler (OpamFormula.ors [ OpamFormula.Atom (OpamPackage.Name.of_string "ocaml-system", OpamFormula.Atom (`Geq, OpamPackage.Version.of_string "4.02.3")); OpamFormula.Atom (OpamPackage.Name.of_string "ocaml-base-compiler", OpamFormula.Empty); ]) conf) |> OpamFile.Config.with_eval_variables ((OpamVariable.of_string "arch", ["uname"; "-m"], "Host architecture, as returned by 'uname -m'") :: OpamFile.Config.eval_variables conf) let v2_0_beta5 = OpamVersion.of_string "2.0~beta5" let from_2_0_beta_to_2_0_beta5 root conf = List.iter (fun switch -> let switch_meta_dir = root / OpamSwitch.to_string switch / ".opam-switch" in let switch_config = OpamFile.make (switch_meta_dir // "switch-config") in let module C = OpamFile.Switch_config in let config = C.safe_read switch_config in let rem_variables = List.map OpamVariable.of_string ["os"; "make"] in let config = { config with C.variables = List.filter (fun (var,_) -> not (List.mem var rem_variables)) config.C.variables; } in OpamFile.Switch_config.write switch_config config; let opam_files_dirs = OpamFilename.dirs (switch_meta_dir / "packages") @ OpamFilename.dirs (switch_meta_dir / "overlay") in List.iter (fun d -> let opam = OpamFile.make (d // "opam") in try OpamFile.OPAM.read opam |> fun o -> OpamFile.OPAM.with_depexts (upgrade_depexts_to_2_0_beta5 (OpamFile.to_string opam) (OpamFile.OPAM.depexts o)) o |> OpamFile.OPAM.write_with_preserved_format opam with e -> OpamStd.Exn.fatal e) opam_files_dirs ) (OpamFile.Config.installed_switches conf); let rem_eval_variables = List.map OpamVariable.of_string ["arch"] in OpamFile.Config.with_eval_variables (List.filter (fun (v,_,_) -> not (List.mem v rem_eval_variables)) (OpamFile.Config.eval_variables conf)) conf let v2_0 = OpamVersion.of_string "2.0" let from_2_0_beta5_to_2_0 _ conf = conf let latest_version = v2_0 let as_necessary global_lock root config = let config_version = OpamFile.Config.opam_version config in let cmp = OpamVersion.(compare current_nopatch config_version) in if cmp = 0 then () else if cmp < 0 then if OpamFormatConfig.(!r.skip_version_checks) then () else OpamConsole.error_and_exit `Configuration_error "%s reports a newer opam version, aborting." (OpamFilename.Dir.to_string root) else if OpamVersion.compare config_version latest_version >= 0 then () else let is_dev = OpamVersion.git () <> None in OpamConsole.formatted_msg "This %sversion of opam requires an update to the layout of %s \ from version %s to version %s, which can't be reverted.\n\ You may want to back it up before going further.\n" (if is_dev then "development " else "") (OpamFilename.Dir.to_string root) (OpamVersion.to_string config_version) (OpamVersion.to_string latest_version); let dontblock = (* Deadlock until one is killed in interactive mode, but abort in batch *) if OpamStd.Sys.tty_out then None else Some true in try OpamFilename.with_flock_upgrade `Lock_write ?dontblock global_lock @@ fun _ -> if is_dev && Some "yes" = OpamConsole.read "Type \"yes\" to perform the update and continue:" || not is_dev && OpamConsole.confirm "Perform the update and continue?" then let update_to v f config = if OpamVersion.compare config_version v < 0 then let config = f root config |> OpamFile.Config.with_opam_version v in (* save the current version to mitigate damage is the upgrade goes wrong afterwards *) OpamFile.Config.write (OpamPath.config root) (OpamFile.Config.with_opam_version v config); config else config in let config = config |> update_to v1_1 from_1_0_to_1_1 |> update_to v1_2 from_1_1_to_1_2 |> update_to v1_3_dev2 from_1_2_to_1_3_dev2 |> update_to v1_3_dev5 from_1_3_dev2_to_1_3_dev5 |> update_to v1_3_dev6 from_1_3_dev5_to_1_3_dev6 |> update_to v1_3_dev7 from_1_3_dev6_to_1_3_dev7 |> update_to v2_0_alpha from_1_3_dev7_to_2_0_alpha |> update_to v2_0_alpha2 from_2_0_alpha_to_2_0_alpha2 |> update_to v2_0_alpha3 from_2_0_alpha2_to_2_0_alpha3 |> update_to v2_0_beta from_2_0_alpha3_to_2_0_beta |> update_to v2_0_beta5 from_2_0_beta_to_2_0_beta5 |> update_to v2_0 from_2_0_beta5_to_2_0 in OpamConsole.msg "Format upgrade done.\n"; raise (Upgrade_done config) else OpamStd.Sys.exit_because `Aborted with OpamSystem.Locked -> OpamConsole.error_and_exit `Locked "Could not acquire lock for performing format upgrade." let opam_file ?(quiet=false) ?filename opam = let v = OpamFile.OPAM.opam_version opam in if OpamVersion.compare v v2_0_alpha3 < 0 then ((match filename with | Some f when not quiet -> log "Internally converting format of %a from %a to %a" (slog OpamFile.to_string) f (slog OpamVersion.to_string) v (slog OpamVersion.to_string) latest_version | _ -> ()); opam_file_from_1_2_to_2_0 ?filename opam) else opam let opam_file_with_aux ?(quiet=false) ?dir ~files ?filename opam = let opam = OpamFileTools.add_aux_files ?dir ~files_subdir_hashes:files opam in opam_file ~quiet ?filename opam let comp_file ?package ?descr comp = OpamFile.Comp.to_package ?package comp descr |> opam_file_from_1_2_to_2_0 opam-2.0.5/src/state/opamEnv.ml0000644000175000017500000005747613511367404015347 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamTypesBase open OpamStd.Op open OpamFilename.Op let log fmt = OpamConsole.log "ENV" fmt let slog = OpamConsole.slog (* - Environment and updates handling - *) let split_var v = OpamStd.Sys.split_path_variable ~clean:false v let join_var l = String.concat (String.make 1 OpamStd.Sys.path_sep) l (* To allow in-place updates, we store intermediate values of path-like as a pair of list [(rl1, l2)] such that the value is [List.rev_append rl1 l2] and the place where the new value should be inserted is in front of [l2] *) let unzip_to elt = let rec aux acc = function | [] -> None | x::r -> if x = elt then Some (acc, r) else aux (x::acc) r in aux [] let rezip ?insert (l1, l2) = List.rev_append l1 (match insert with None -> l2 | Some i -> i::l2) let rezip_to_string ?insert z = join_var (rezip ?insert z) let apply_op_zip op arg (rl1,l2 as zip) = let colon_eq ?(eqcol=false) = function (* prepend a, but keep ":"s *) | [] | [""] -> [], [arg; ""] | "" :: l -> (* keep surrounding colons *) if eqcol then l@[""], [arg] else l, [""; arg] | l -> l, [arg] in match op with | Eq -> [],[arg] | PlusEq -> [], arg :: rezip zip | EqPlus -> List.rev_append l2 rl1, [arg] | EqPlusEq -> rl1, arg::l2 | ColonEq -> let l, add = colon_eq (rezip zip) in [], add @ l | EqColon -> let l, add = colon_eq ~eqcol:true (List.rev_append l2 rl1) in l, List.rev add (** Undoes previous updates done by opam, useful for not duplicating already done updates; this is obviously not perfect, as all operators are not reversible. [cur_value] is provided as a list split at path_sep. None is returned if the revert doesn't match. Otherwise, a zip (pair of lists [(preceding_elements_reverted, following_elements)]) is returned, to keep the position of the matching element and allow [=+=] to be applied later. A pair or empty lists is returned if the variable should be unset or has an unknown previous value. *) let reverse_env_update op arg cur_value = match op with | Eq -> if arg = join_var cur_value then Some ([],[]) else None | PlusEq | EqPlusEq -> unzip_to arg cur_value | EqPlus -> (match unzip_to arg (List.rev cur_value) with | None -> None | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1)) | ColonEq -> (match unzip_to arg cur_value with | Some ([], [""]) -> Some ([], []) | r -> r) | EqColon -> (match unzip_to arg (List.rev cur_value) with | Some ([], [""]) -> Some ([], []) | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1) | None -> None) let updates_from_previous_instance = lazy ( match OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" with | None -> None | Some pfx -> let env_file = OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx) in try OpamFile.Environment.read_opt env_file with e -> OpamStd.Exn.fatal e; None ) let expand (updates: env_update list) : env = (* Reverse all previous updates, in reverse order, on current environment *) let reverts = match Lazy.force updates_from_previous_instance with | None -> [] | Some updates -> List.fold_right (fun (var, op, arg, _) defs0 -> let v_opt, defs = OpamStd.List.pick_assoc var defs0 in let v = OpamStd.Option.Op.((v_opt >>| rezip >>+ fun () -> OpamStd.Env.getopt var >>| split_var) +! []) in match reverse_env_update op arg v with | Some v -> (var, v)::defs | None -> defs0) updates [] in (* And apply the new ones *) let rec apply_updates reverts acc = function | (var, op, arg, doc) :: updates -> let zip, reverts = let f, var = if Sys.win32 then String.uppercase_ascii, String.uppercase_ascii var else (fun x -> x), var in match OpamStd.List.find_opt (fun (v, _, _) -> f v = var) acc with | Some (_, z, _doc) -> z, reverts | None -> match OpamStd.List.pick_assoc var reverts with | Some z, reverts -> z, reverts | None, _ -> match OpamStd.Env.getopt var with | Some s -> ([], split_var s), reverts | None -> ([], []), reverts in apply_updates reverts ((var, apply_op_zip op arg zip, doc) :: acc) updates | [] -> List.rev @@ List.rev_append (List.rev_map (fun (var, z, doc) -> var, rezip_to_string z, doc) acc) @@ List.rev_map (fun (var, z) -> var, rezip_to_string z, Some "Reverting previous opam update") reverts in apply_updates reverts [] updates let add (env: env) (updates: env_update list) = let env = if Sys.win32 then (* * Environment variable names are case insensitive on Windows *) let updates = List.rev_map (fun (u,_,_,_) -> (String.uppercase_ascii u, "", "", None)) updates in List.filter (fun (k,_,_) -> let k = String.uppercase_ascii k in List.for_all (fun (u,_,_,_) -> u <> k) updates) env else List.filter (fun (k,_,_) -> List.for_all (fun (u,_,_,_) -> u <> k) updates) env in env @ expand updates let compute_updates ?(force_path=false) st = (* Todo: put these back into their packages! let perl5 = OpamPackage.Name.of_string "perl5" in let add_to_perl5lib = OpamPath.Switch.lib t.root t.switch t.switch_config perl5 in let new_perl5lib = "PERL5LIB", "+=", OpamFilename.Dir.to_string add_to_perl5lib in *) let fenv ?opam v = try OpamPackageVar.resolve st ?opam v with Not_found -> log "Undefined variable: %s" (OpamVariable.Full.to_string v); None in let bindir = OpamPath.Switch.bin st.switch_global.root st.switch st.switch_config in let path = "PATH", (if force_path then PlusEq else EqPlusEq), OpamFilename.Dir.to_string bindir, Some ("Binary dir for opam switch "^OpamSwitch.to_string st.switch) in let man_path = let open OpamStd.Sys in match os () with | OpenBSD | NetBSD | FreeBSD | Darwin | DragonFly -> [] (* MANPATH is a global override on those, so disabled for now *) | _ -> ["MANPATH", EqColon, OpamFilename.Dir.to_string (OpamPath.Switch.man_dir st.switch_global.root st.switch st.switch_config), Some "Current opam switch man dir"] in let env_expansion ?opam (name,op,str,cmt) = let s = OpamFilter.expand_string ~default:(fun _ -> "") (fenv ?opam) str in name, op, s, cmt in let switch_env = ("OPAM_SWITCH_PREFIX", Eq, OpamFilename.Dir.to_string (OpamPath.Switch.root st.switch_global.root st.switch), Some "Prefix of the current opam switch") :: List.map env_expansion st.switch_config.OpamFile.Switch_config.env in let pkg_env = (* XXX: Does this need a (costly) topological sort? *) OpamPackage.Set.fold (fun nv acc -> match OpamPackage.Map.find_opt nv st.opams with | Some opam -> List.map (env_expansion ~opam) (OpamFile.OPAM.env opam) @ acc | None -> acc) st.installed [] in switch_env @ pkg_env @ man_path @ [path] let updates_common ~set_opamroot ~set_opamswitch root switch = let root = if set_opamroot then [ "OPAMROOT", Eq, OpamFilename.Dir.to_string root, Some "Opam root in use" ] else [] in let switch = if set_opamswitch then [ "OPAMSWITCH", Eq, OpamSwitch.to_string switch, None ] else [] in root @ switch let updates ?(set_opamroot=false) ?(set_opamswitch=false) ?force_path st = updates_common ~set_opamroot ~set_opamswitch st.switch_global.root st.switch @ compute_updates ?force_path st let get_pure ?(updates=[]) () = let env = List.map (fun (v,va) -> v,va,None) (OpamStd.Env.list ()) in add env updates let get_opam ?(set_opamroot=false) ?(set_opamswitch=false) ~force_path st = add [] (updates ~set_opamroot ~set_opamswitch ~force_path st) let get_opam_raw ?(set_opamroot=false) ?(set_opamswitch=false) ~force_path root switch = let env_file = OpamPath.Switch.environment root switch in let upd = OpamFile.Environment.safe_read env_file in let upd = ("OPAM_SWITCH_PREFIX", Eq, OpamFilename.Dir.to_string (OpamPath.Switch.root root switch), Some "Prefix of the current opam switch") :: List.filter (function ("OPAM_SWITCH_PREFIX", Eq, _, _) -> false | _ -> true) upd in let upd = if force_path then List.map (function | "PATH", EqPlusEq, v, doc -> "PATH", PlusEq, v, doc | e -> e) upd else List.map (function | "PATH", PlusEq, v, doc -> "PATH", EqPlusEq, v, doc | e -> e) upd in add [] (updates_common ~set_opamroot ~set_opamswitch root switch @ upd) let get_full ?(set_opamroot=false) ?(set_opamswitch=false) ~force_path ?updates:(u=[]) st = let env0 = List.map (fun (v,va) -> v,va,None) (OpamStd.Env.list ()) in let updates = u @ updates ~set_opamroot ~set_opamswitch ~force_path st in add env0 updates let is_up_to_date_raw updates = OpamStateConfig.(!r.no_env_notice) || let not_utd = List.fold_left (fun notutd (var, op, arg, _doc as upd) -> match OpamStd.Env.getopt var with | None -> upd::notutd | Some v -> if reverse_env_update op arg (split_var v) = None then upd::notutd else List.filter (fun (v, _, _, _) -> v <> var) notutd) [] updates in let r = not_utd = [] in if not r then log "Not up-to-date env variables: [%a]" (slog @@ String.concat " " @* List.map (fun (v, _, _, _) -> v)) not_utd else log "Environment is up-to-date"; r let is_up_to_date_switch root switch = let env_file = OpamPath.Switch.environment root switch in try match OpamFile.Environment.read_opt env_file with | Some upd -> is_up_to_date_raw upd | None -> true with e -> OpamStd.Exn.fatal e; true let switch_path_update ~force_path root switch = let bindir = OpamPath.Switch.bin root switch (OpamFile.Switch_config.safe_read (OpamPath.Switch.switch_config root switch)) in [ "PATH", (if force_path then PlusEq else EqPlusEq), OpamFilename.Dir.to_string bindir, Some "Current opam switch binary dir" ] let path ~force_path root switch = let env = expand (switch_path_update ~force_path root switch) in let (_, path_value, _) = List.find (fun (v, _, _) -> v = "PATH") env in path_value let full_with_path ~force_path ?(updates=[]) root switch = let env0 = List.map (fun (v,va) -> v,va,None) (OpamStd.Env.list ()) in add env0 (switch_path_update ~force_path root switch @ updates) let is_up_to_date st = is_up_to_date_raw (updates ~set_opamroot:false ~set_opamswitch:false ~force_path:false st) let eval_string gt ?(set_opamswitch=false) switch = let root = let opamroot_cur = OpamFilename.Dir.to_string gt.root in let opamroot_env = OpamStd.Option.Op.( OpamStd.Env.getopt "OPAMROOT" +! OpamFilename.Dir.to_string OpamStateConfig.(default.root_dir) ) in if opamroot_cur <> opamroot_env then Printf.sprintf " --root=%s" opamroot_cur else "" in let switch = match switch with | None -> "" | Some sw -> let sw_cur = OpamSwitch.to_string sw in let sw_env = OpamStd.Option.Op.( OpamStd.Env.getopt "OPAMSWITCH" ++ (OpamStateConfig.get_current_switch_from_cwd gt.root >>| OpamSwitch.to_string) ++ (OpamFile.Config.switch gt.config >>| OpamSwitch.to_string) ) in if Some sw_cur <> sw_env then Printf.sprintf " --switch=%s" sw_cur else "" in let setswitch = if set_opamswitch then " --set-switch" else "" in match OpamStd.Sys.guess_shell_compat () with | SH_fish -> Printf.sprintf "eval (opam env%s%s%s)" root switch setswitch | SH_csh -> Printf.sprintf "eval `opam env%s%s%s`" root switch setswitch | _ -> Printf.sprintf "eval $(opam env%s%s%s)" root switch setswitch (* -- Shell and init scripts handling -- *) (** The shells for which we generate init scripts (bash and sh are the same entry) *) let shells_list = [ SH_sh; SH_zsh; SH_csh; SH_fish ] let complete_file = function | SH_sh | SH_bash -> Some "complete.sh" | SH_zsh -> Some "complete.zsh" | SH_csh | SH_fish -> None let env_hook_file = function | SH_sh | SH_bash -> Some "env_hook.sh" | SH_zsh -> Some "env_hook.zsh" | SH_csh -> Some "env_hook.csh" | SH_fish -> Some "env_hook.fish" let variables_file = function | SH_sh | SH_bash | SH_zsh -> "variables.sh" | SH_csh -> "variables.csh" | SH_fish -> "variables.fish" let init_file = function | SH_sh | SH_bash -> "init.sh" | SH_zsh -> "init.zsh" | SH_csh -> "init.csh" | SH_fish -> "init.fish" let complete_script = function | SH_sh | SH_bash -> Some OpamScript.complete | SH_zsh -> Some OpamScript.complete_zsh | SH_csh | SH_fish -> None let env_hook_script_base = function | SH_sh | SH_bash -> Some OpamScript.env_hook | SH_zsh -> Some OpamScript.env_hook_zsh | SH_csh -> Some OpamScript.env_hook_csh | SH_fish -> Some OpamScript.env_hook_fish let export_in_shell shell = let make_comment comment_opt = OpamStd.Option.to_string (Printf.sprintf "# %s\n") comment_opt in let sh (k,v,comment) = Printf.sprintf "%s%s=%s; export %s;\n" (make_comment comment) k v k in let csh (k,v,comment) = Printf.sprintf "%sif ( ! ${?%s} ) setenv %s \"\"\nsetenv %s %s\n" (make_comment comment) k k k v in let fish (k,v,comment) = (* Fish converts some colon-separated vars to arrays, which have to be treated differently. MANPATH is handled automatically, so better not to set it at all when not already defined *) let to_arr_string v = OpamStd.List.concat_map " " (fun v -> if v = Printf.sprintf "\"$%s\"" k then "$"^k (* remove quotes *) else v) (OpamStd.String.split v ':') in match k with | "PATH" -> Printf.sprintf "%sset -gx %s %s;\n" (make_comment comment) k (to_arr_string v) | "MANPATH" -> Printf.sprintf "%sif [ (count $%s) -gt 0 ]; set -gx %s %s; end;\n" (make_comment comment) k k (to_arr_string v) | _ -> (* Regular string variables *) Printf.sprintf "%sset -gx %s %s;\n" (make_comment comment) k v in match shell with | SH_zsh | SH_bash | SH_sh -> sh | SH_fish -> fish | SH_csh -> csh let env_hook_script shell = OpamStd.Option.map (fun script -> export_in_shell shell ("OPAMNOENVNOTICE", "true", None) ^ script) (env_hook_script_base shell) let source root shell f = let file f = OpamFilename.to_string (OpamPath.init root // f) in match shell with | SH_csh -> Printf.sprintf "source %s >& /dev/null || true\n" (file f) | SH_fish -> Printf.sprintf "source %s > /dev/null 2> /dev/null; or true\n" (file f) | SH_sh | SH_bash | SH_zsh -> Printf.sprintf "test -r %s && . %s > /dev/null 2> /dev/null || true\n" (file f) (file f) let if_interactive_script shell t e = let ielse else_opt = match else_opt with | None -> "" | Some e -> Printf.sprintf "else\n %s" e in match shell with | SH_sh | SH_zsh | SH_bash -> Printf.sprintf "if [ -t 0 ]; then\n %s%sfi\n" t @@ ielse e | SH_csh -> Printf.sprintf "if ( $?prompt ) then\n %s%sendif\n" t @@ ielse e | SH_fish -> Printf.sprintf "if isatty\n %s%send\n" t @@ ielse e let init_script root shell = let interactive = List.map (source root shell) @@ OpamStd.List.filter_some [complete_file shell; env_hook_file shell] in String.concat "\n" @@ (if interactive <> [] then [if_interactive_script shell (String.concat "\n " interactive) None] else []) @ [source root shell (variables_file shell)] let string_of_update st shell updates = let fenv = OpamPackageVar.resolve st in let aux (ident, symbol, string, comment) = let string = OpamFilter.expand_string ~default:(fun _ -> "") fenv string |> OpamStd.Env.escape_single_quotes ~using_backslashes:(shell = SH_fish) in let key, value = ident, match symbol with | Eq -> Printf.sprintf "'%s'" string | PlusEq | ColonEq | EqPlusEq -> Printf.sprintf "'%s':\"$%s\"" string ident | EqColon | EqPlus -> Printf.sprintf "\"$%s\":'%s'" ident string in export_in_shell shell (key, value, comment) in OpamStd.List.concat_map "" aux updates let write_script dir (name, body) = let file = dir // name in try OpamFilename.write file body with e -> OpamStd.Exn.fatal e; OpamConsole.error "Could not write %s" (OpamFilename.to_string file) let write_init_shell_scripts root = let scripts = List.map (fun shell -> init_file shell, init_script root shell) shells_list in List.iter (write_script (OpamPath.init root)) scripts let write_static_init_scripts root ?completion ?env_hook () = write_init_shell_scripts root; let update_scripts filef scriptf enable = let scripts = OpamStd.List.filter_map (fun shell -> match filef shell, scriptf shell with | Some f, Some s -> Some (f, s) | _ -> None) shells_list in match enable with | Some true -> List.iter (write_script (OpamPath.init root)) scripts | Some false -> List.iter (fun (f,_) -> OpamFilename.remove (OpamPath.init root // f)) scripts | None -> () in update_scripts complete_file complete_script completion; update_scripts env_hook_file env_hook_script env_hook let write_custom_init_scripts root custom = List.iter (fun (name, script) -> write_script (OpamPath.hooks_dir root) (name, script); OpamFilename.chmod (OpamPath.hooks_dir root // name) 0o777 ) custom let write_dynamic_init_scripts st = let updates = updates ~set_opamroot:false ~set_opamswitch:false st in try OpamFilename.with_flock_upgrade `Lock_write ~dontblock:true st.switch_global.global_lock @@ fun _ -> List.iter (fun shell -> write_script (OpamPath.init st.switch_global.root) (variables_file shell, string_of_update st shell updates)) [SH_sh; SH_csh; SH_fish] with OpamSystem.Locked -> OpamConsole.warning "Global shell init scripts not installed (could not acquire lock)" let clear_dynamic_init_scripts gt = List.iter (fun shell -> OpamFilename.remove (OpamPath.init gt.root // variables_file shell)) [SH_sh; SH_csh; SH_fish] let dot_profile_needs_update root dot_profile = if not (OpamFilename.exists dot_profile) then `yes else let body = OpamFilename.read dot_profile in let pattern1 = "opam config env" in let pattern1b = "opam env" in let pattern2 = OpamFilename.to_string (OpamPath.init root // "init") in let pattern3 = OpamStd.String.remove_prefix ~prefix:(OpamFilename.Dir.to_string root) pattern2 in let uncommented_re patts = Re.(compile (seq [bol; rep (diff any (set "#:")); alt (List.map str patts)])) in if Re.execp (uncommented_re [pattern1; pattern1b; pattern2]) body then `no else if Re.execp (uncommented_re [pattern3]) body then `otherroot else `yes let update_dot_profile root dot_profile shell = let pretty_dot_profile = OpamFilename.prettify dot_profile in let bash_src () = if shell = SH_bash || shell = SH_sh then OpamConsole.note "Make sure that %s is well %s in your ~/.bashrc.\n" pretty_dot_profile (OpamConsole.colorise `underline "sourced") in match dot_profile_needs_update root dot_profile with | `no -> OpamConsole.msg " %s is already up-to-date.\n" pretty_dot_profile; bash_src() | `otherroot -> OpamConsole.msg " %s is already configured for another opam root.\n" pretty_dot_profile | `yes -> let init_file = init_file shell in let body = if OpamFilename.exists dot_profile then OpamFilename.read dot_profile else "" in OpamConsole.msg " Updating %s.\n" pretty_dot_profile; bash_src(); let body = Printf.sprintf "%s\n\n\ # opam configuration\n\ %s" (OpamStd.String.strip body) (source root shell init_file) in OpamFilename.write dot_profile body let update_user_setup root ?dot_profile shell = if dot_profile <> None then ( OpamConsole.msg "\nUser configuration:\n"; OpamStd.Option.iter (fun f -> update_dot_profile root f shell) dot_profile ) let check_and_print_env_warning st = if not (is_up_to_date st) && (OpamFile.Config.switch st.switch_global.config = Some st.switch || OpamStateConfig.(!r.switch_from <> `Command_line)) then OpamConsole.formatted_msg "# Run %s to update the current shell environment\n" (OpamConsole.colorise `bold (eval_string st.switch_global (Some st.switch))) let setup root ~interactive ?dot_profile ?update_config ?env_hook ?completion shell = let update_dot_profile = match update_config, dot_profile, interactive with | Some false, _, _ -> None | _, None, _ -> invalid_arg "OpamEnv.setup" | Some true, Some dot_profile, _ -> Some dot_profile | None, _, false -> None | None, Some dot_profile, true -> OpamConsole.header_msg "Required setup - please read"; OpamConsole.msg "\n\ \ In normal operation, opam only alters files within ~/.opam.\n\ \n\ \ However, to best integrate with your system, some environment variables\n\ \ should be set. If you allow it to, this initialisation step will update\n\ \ your %s configuration by adding the following line to %s:\n\ \n\ \ %s\ \n\ \ Otherwise, every time you want to access your opam installation, you will\n\ \ need to run:\n\ \n\ \ %s\n\ \n\ \ You can always re-run this setup with 'opam init' later.\n\n" (OpamConsole.colorise `bold @@ string_of_shell shell) (OpamConsole.colorise `cyan @@ OpamFilename.prettify dot_profile) (OpamConsole.colorise `bold @@ source root shell (init_file shell)) (OpamConsole.colorise `bold @@ "eval $(opam env)"); match OpamConsole.read "Do you want opam to modify %s? [N/y/f]\n\ (default is 'no', use 'f' to choose a different file)" (OpamFilename.prettify dot_profile) with | Some ("y" | "Y" | "yes" | "YES" ) -> Some dot_profile | Some ("f" | "F" | "file" | "FILE") -> begin match OpamConsole.read " Enter the name of the file to update:" with | None -> OpamConsole.msg "Alright, assuming you changed your mind, not \ performing any changes.\n"; None | Some f -> Some (OpamFilename.of_string f) end | _ -> None in let env_hook = match env_hook, interactive with | Some b, _ -> Some b | None, false -> None | None, true -> Some (OpamConsole.confirm ~default:false "A hook can be added to opam's init scripts to ensure that the \ shell remains in sync with the opam environment when they are \ loaded. Set that up?") in update_user_setup root ?dot_profile:update_dot_profile shell; write_static_init_scripts root ?completion ?env_hook () opam-2.0.5/src/state/opamFileTools.ml0000644000175000017500000010225313511367404016477 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase let log fmt = OpamConsole.log "opam-file" fmt open OpamFile.OPAM (** manipulation utilities *) let names_of_formula flag f = OpamPackageVar.filter_depends_formula ~build:true ~post:true ~dev:true ~test:flag ~doc:flag ~default:false ~env:OpamStd.Option.none f |> OpamFormula.atoms |> List.map fst |> OpamPackage.Name.Set.of_list let all_commands t = t.build @ t.install @ t.remove @ t.run_test @ t.deprecated_build_doc let all_urls t = let urlf_urls uf = OpamFile.URL.url uf :: OpamFile.URL.mirrors uf in (match t.url with Some uf -> urlf_urls uf | None -> []) @ (match t.dev_repo with Some u -> [u] | None -> []) @ List.fold_left (fun acc (_, uf) -> urlf_urls uf @ acc) [] t.extra_sources let filters_of_formula f = OpamFormula.fold_left (fun acc (_, f) -> OpamFormula.fold_left (fun acc -> function | Constraint (_,f) -> f :: acc | Filter f -> f :: acc) acc f) [] f (* Doesn't include filters in commands *) let all_filters ?(exclude_post=false) t = OpamStd.List.filter_map snd t.patches @ OpamStd.List.filter_map snd t.messages @ (if exclude_post then [] else OpamStd.List.filter_map snd t.post_messages) @ List.map snd t.depexts @ OpamStd.List.filter_map snd t.libraries @ OpamStd.List.filter_map snd t.syntax @ [t.available] @ filters_of_formula (OpamFormula.ands (t.depends :: t.depopts :: t.conflicts :: List.map (fun (_,f,_) -> f) t.features)) let map_all_filters f t = let mapsnd x = List.map (fun (x, ft) -> x, f ft) x in let mapsndopt x = List.map (function | (x, Some ft) -> x, Some (f ft) | nf -> nf) x in let map_commands = List.map (fun (args, filter) -> List.map (function | s, Some ft -> s, Some (f ft) | nf -> nf) args, OpamStd.Option.map f filter) in let map_filtered_formula = OpamFormula.map (fun (name, fc) -> let fc = OpamFormula.map (function | Filter flt -> Atom (Filter (f flt)) | Constraint (relop, flt) -> Atom (Constraint (relop, (f flt)))) fc in Atom (name, fc)) in let map_features = List.map (fun (var, fformula, doc) -> var, map_filtered_formula fformula, doc) in t |> with_patches (mapsndopt t.patches) |> with_messages (mapsndopt t.messages) |> with_post_messages (mapsndopt t.post_messages) |> with_depexts (mapsnd t.depexts) |> with_libraries (mapsndopt t.libraries) |> with_syntax (mapsndopt t.syntax) |> with_available (f t.available) |> with_depends (map_filtered_formula t.depends) |> with_depopts (map_filtered_formula t.depopts) |> with_conflicts (map_filtered_formula t.conflicts) |> with_features (map_features t.features) |> with_build (map_commands t.build) |> with_run_test (map_commands t.run_test) |> with_install (map_commands t.install) |> with_remove (map_commands t.remove) |> with_deprecated_build_test (map_commands t.deprecated_build_test) |> with_deprecated_build_doc (map_commands t.deprecated_build_doc) (* Returns all variables from all commands (or on given [command]) and all filters *) let all_variables ?exclude_post ?command t = let commands = match command with | Some cmd -> cmd | None -> all_commands t in OpamFilter.commands_variables commands @ List.fold_left (fun acc f -> OpamFilter.variables f @ acc) [] (all_filters ?exclude_post t) let map_all_variables f t = let map_fld (x, flt) = x, OpamFilter.map_variables f flt in let map_optfld = function | x, Some flt -> x, Some (OpamFilter.map_variables f flt) | _, None as optfld -> optfld in let map_commands = let map_args = List.map (fun (s, filter) -> (match s with | CString s -> CString (OpamFilter.map_variables_in_string f s) | CIdent id -> let id = try filter_ident_of_string id |> OpamFilter.map_variables_in_fident f |> string_of_filter_ident with Failure _ -> id in CIdent id), OpamStd.Option.Op.(filter >>| OpamFilter.map_variables f)) in List.map (fun (args, filter) -> map_args args, OpamStd.Option.Op.(filter >>| OpamFilter.map_variables f)) in let map_filtered_formula = OpamFormula.map (fun (name, fc) -> let fc = OpamFormula.map (function | Filter flt -> Atom (Filter (OpamFilter.map_variables f flt)) | Constraint (relop, flt) -> Atom (Constraint (relop, (OpamFilter.map_variables f flt)))) fc in Atom (name, fc) ) in let map_features = List.map (fun (var, fformula, doc) -> var, map_filtered_formula fformula, doc) in t |> with_patches (List.map map_optfld t.patches) |> with_messages (List.map map_optfld t.messages) |> with_post_messages (List.map map_optfld t.post_messages) |> with_depexts (List.map map_fld t.depexts) |> with_libraries (List.map map_optfld t.libraries) |> with_syntax (List.map map_optfld t.syntax) |> with_build (map_commands t.build) |> with_run_test (map_commands t.run_test) |> with_install (map_commands t.install) |> with_remove (map_commands t.remove) |> with_depends (map_filtered_formula t.depends) |> with_depopts (map_filtered_formula t.depopts) |> with_conflicts (map_filtered_formula t.conflicts) |> with_available (OpamFilter.map_variables f t.available) |> with_features (map_features t.features) |> with_deprecated_build_test (map_commands t.deprecated_build_test) |> with_deprecated_build_doc (map_commands t.deprecated_build_doc) let all_expanded_strings t = List.map fst t.messages @ List.map fst t.post_messages @ List.fold_left (fun acc (args, _) -> List.fold_left (fun acc -> function CString s, _ -> s :: acc | _ -> acc) acc args) [] (all_commands t) @ List.fold_left (OpamFilter.fold_down_left (fun acc -> function FString s -> s :: acc | _ -> acc)) [] (all_filters t) let all_depends t = OpamPackage.Name.Set.union (names_of_formula true t.depends) (names_of_formula true t.depopts) (* Templating & linting *) let template nv = let maintainer = let from_git = try match OpamSystem.read_command_output ["git"; "config"; "--get"; "user.name"], OpamSystem.read_command_output ["git"; "config"; "--get"; "user.email"] with | [name], [email] -> Some [Printf.sprintf "%s <%s>" name email] | _ -> raise Not_found with e -> OpamStd.Exn.fatal e; None in match from_git with | Some u -> u | None -> let email = try Some (Sys.getenv "EMAIL") with Not_found -> None in try let open Unix in let pw = getpwuid (getuid ()) in let email = match email with | Some e -> e | None -> pw.pw_name^"@"^gethostname () in match OpamStd.String.split pw.pw_gecos ',' with | name::_ -> [Printf.sprintf "%s <%s>" name email] | _ -> [email] with Not_found -> match email with | Some e -> [e] | None -> [] in create nv |> with_name_opt None |> with_maintainer maintainer |> with_build [[CString "./configure", None; CString "--prefix=%{prefix}%", None], None; [CIdent "make", None], None] |> with_install [[CIdent "make", None; CString "install", None], None] |> with_depends (Atom (OpamPackage.Name.of_string "specify-dependencies-here", (Atom (Constraint (`Geq, FString "optional-version"))))) |> with_author maintainer |> with_homepage [""] |> with_license [""] |> with_dev_repo (OpamUrl.of_string "git+https://") |> with_bug_reports [""] |> with_synopsis "" let lint ?check_extra_files ?(check_upstream=false) t = let format_errors = List.map (fun (field, (pos, msg)) -> 3, `Error, Printf.sprintf "File format error in '%s'%s: %s" field (match pos with | Some (_,li,col) when li >= 0 && col >= 0 -> Printf.sprintf " at line %d, column %d" li col | _ -> "") msg) (OpamFile.OPAM.format_errors t) in let cond num level msg ?detail cd = if cd then let msg = match detail with | Some d -> Printf.sprintf "%s: \"%s\"" msg (String.concat "\", \"" d) | None -> msg in Some (num, level, msg) else None in let all_commands = all_commands t in let all_expanded_strings = all_expanded_strings t in let all_depends = all_depends t in let warnings = [ cond 20 `Warning "Field 'opam-version' refers to the patch version of opam, it \ should be of the form MAJOR.MINOR" ~detail:[OpamVersion.to_string t.opam_version] (OpamVersion.nopatch t.opam_version <> t.opam_version); cond 21 `Error "Field 'opam-version' doesn't match the current version, \ validation may not be accurate" ~detail:[OpamVersion.to_string t.opam_version] (OpamVersion.compare t.opam_version OpamVersion.current_nopatch <> 0); (* cond (t.name = None) "Missing field 'name' or directory in the form 'name.version'"; cond (t.version = None) "Missing field 'version' or directory in the form 'name.version'"; *) (let empty_fields = OpamStd.List.filter_map (function n,[""] -> Some n | _ -> None) ["maintainer", t.maintainer; "homepage", t.homepage; "author", t.author; "license", t.license; "doc", t.doc; "tags", t.tags; "bug_reports", t.bug_reports] in cond 22 `Error "Some fields are present but empty; remove or fill them" ~detail:empty_fields (empty_fields <> [])); cond 23 `Error "Missing field 'maintainer'" (t.maintainer = []); cond 24 `Error "Field 'maintainer' has the old default value" (List.mem "contact@ocamlpro.com" t.maintainer && not (List.mem "org:ocamlpro" t.tags)); cond 25 `Warning "Missing field 'authors'" (t.author = []); cond 26 `Warning "No field 'install', but a field 'remove': install instructions \ probably part of 'build'. Use the 'install' field or a .install \ file" (t.install = [] && t.build <> [] && t.remove <> []); (* cond 27 `Warning "No field 'remove' while a field 'install' is present, uncomplete \ uninstallation suspected" (t.install <> [] && t.remove = []); *) (let unk_flags = OpamStd.List.filter_map (function | Pkgflag_Unknown s -> Some s | _ -> None) t.flags in cond 28 `Error "Unknown package flags found" ~detail:unk_flags (unk_flags <> [])); (let filtered_vars = OpamFilter.variables_of_filtered_formula t.depends @ OpamFilter.variables_of_filtered_formula t.depopts |> List.filter (fun v -> not (OpamVariable.Full.is_global v)) |> List.map OpamVariable.Full.to_string in cond 29 `Error "Package dependencies mention package variables" ~detail:filtered_vars (filtered_vars <> [])); (* cond 30 `Error "Field 'depopts' is not a pure disjunction" (List.exists (function | OpamFormula.Atom _ -> false | _ -> true) (OpamFormula.ors_to_list t.depopts)); *) (let dup_depends = OpamPackage.Name.Set.inter (names_of_formula false t.depends) (names_of_formula true t.depopts) in cond 31 `Error "Fields 'depends' and 'depopts' refer to the same package names" ~detail:OpamPackage.Name. (List.map to_string (Set.elements dup_depends)) (not (OpamPackage.Name.Set.is_empty dup_depends))); cond 32 `Error "Field 'ocaml-version:' and variable 'ocaml-version' are deprecated, use \ a dependency towards the 'ocaml' package instead for availability, and \ the 'ocaml:version' package variable for scripts" (t.ocaml_version <> None || List.mem (OpamVariable.Full.of_string "ocaml-version") (all_variables t)); cond 33 `Error "Field 'os' is deprecated, use 'available' and the 'os' variable \ instead" (t.os <> Empty); (let pkg_vars = List.filter (fun v -> not (OpamVariable.Full.is_global v)) (OpamFilter.variables t.available) in cond 34 `Error "Field 'available:' contains references to package-local variables. \ It should only be determined from global configuration variables" ~detail:(List.map OpamVariable.Full.to_string pkg_vars) (pkg_vars <> [])); cond 35 `Warning "Missing field 'homepage'" (t.homepage = []); (* cond (t.doc = []) *) (* "Missing field 'doc'"; *) cond 36 `Warning "Missing field 'bug-reports'" (t.bug_reports = []); cond 37 `Warning "Missing field 'dev-repo'" (t.dev_repo = None && t.url <> None); (* cond 38 `Warning "Package declares 'depexts', but has no 'post-messages' to help \ the user out when they are missing" (t.depexts <> None && t.post_messages = []); *) cond 39 `Error "Command 'make' called directly, use the built-in variable \ instead" (List.exists (function | (CString "make", _)::_, _ -> true | _ -> false ) all_commands); (* cond 40 `Warning "Field 'features' is still experimental and not yet to be used on \ the official repo" (t.features <> []); (let alpha_flags = OpamStd.List.filter_map (function | Pkgflag_LightUninstall | Pkgflag_Unknown _ -> None | f -> if List.exists (fun tag -> flag_of_tag tag = Some f) t.tags then None else Some (string_of_pkg_flag f)) t.flags in cond 40 `Warning "Package uses flags that aren't recognised by earlier versions in \ OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \ instead for compatibility" ~detail:alpha_flags (alpha_flags <> [])); *) (let undep_pkgs = List.fold_left (fun acc v -> match OpamVariable.Full.package v with | Some n when t.OpamFile.OPAM.name <> Some n && not (OpamPackage.Name.Set.mem n all_depends) && OpamVariable.(Full.variable v <> of_string "installed") -> OpamPackage.Name.Set.add n acc | _ -> acc) OpamPackage.Name.Set.empty (all_variables ~exclude_post:true t) in cond 41 `Warning "Some packages are mentioned in package scripts or features, but \ there is no dependency or depopt toward them" ~detail:OpamPackage.Name. (List.map to_string (Set.elements undep_pkgs)) (not (OpamPackage.Name.Set.is_empty undep_pkgs))); cond 42 `Error "The 'dev-repo:' field doesn't use version control. You should use \ URLs of the form \"git://\", \"git+https://\", \"hg+https://\"..." (match t.dev_repo with | None -> false | Some { OpamUrl.backend = #OpamUrl.version_control; _ } -> false | Some _ -> true); cond 43 `Error "Conjunction used in 'conflicts:' field. Only '|' is allowed" (OpamVersion.compare t.opam_version (OpamVersion.of_string "1.3") >= 0 && let rec ors_only_constraint = function | Atom _ | Empty -> true | Or (a, b) -> ors_only_constraint a && ors_only_constraint b | And (a, Atom (Filter _)) | And (Atom (Filter _), a) | Block a -> ors_only_constraint a | And _ -> false in let rec check = function | Atom (_, c) -> ors_only_constraint c | Empty -> true | Or (a, b) -> check a && check b | Block a -> check a | And _ -> false in not (check t.conflicts)); cond 44 `Warning "The 'plugin' package flag is set but the package name doesn't \ begin with 'opam-'" (OpamVersion.compare t.opam_version (OpamVersion.of_string "1.3") >= 0 && List.mem Pkgflag_Plugin t.flags && match t.OpamFile.OPAM.name with | None -> false | Some name -> not (OpamStd.String.starts_with ~prefix:"opam-" (OpamPackage.Name.to_string name))); (let unclosed = List.fold_left (fun acc s -> List.rev_append (OpamFilter.unclosed_expansions s) acc) [] all_expanded_strings in cond 45 `Error "Unclosed variable interpolations in strings" ~detail:(List.map snd unclosed) (unclosed <> [])); cond 46 `Error "Package is flagged \"conf\" but has source, install or remove \ instructions" (has_flag Pkgflag_Conf t && (t.install <> [] || t.remove <> [] || t.url <> None || t.extra_sources <> [])); cond 47 `Warning "Synopsis (or description first line) should start with a capital and \ not end with a dot" (let valid_re = Re.(compile (seq [bos; diff any (alt [blank; lower]); rep any; diff any (alt [blank; char '.']); eos])) in match t.descr with None -> false | Some d -> not (Re.execp valid_re (OpamFile.Descr.synopsis d))); cond 48 `Warning "The fields 'build-test:' and 'build-doc:' are deprecated, and should be \ replaced by uses of the 'with-test' and 'with-doc' filter variables in \ the 'build:' and 'install:' fields, and by the newer 'run-test:' \ field" (t.deprecated_build_test <> [] || t.deprecated_build_doc <> []); (let suspicious_urls = List.filter (fun u -> OpamUrl.parse ~handle_suffix:true (OpamUrl.to_string u) <> u) (all_urls t) in cond 49 `Warning "The following URLs don't use version control but look like version \ control URLs" ~detail:(List.map OpamUrl.to_string suspicious_urls) (suspicious_urls <> [])); cond 50 `Warning "The 'post' flag doesn't make sense with build or optional \ dependencies" (List.mem (OpamVariable.Full.of_string "post") (List.flatten (List.map OpamFilter.variables (filters_of_formula t.depopts))) || OpamFormula.fold_left (fun acc (_, f) -> acc || let vars = OpamFormula.fold_left (fun vars f -> match f with | Constraint _ -> vars | Filter fi -> OpamFilter.variables fi @ vars) [] f in List.mem (OpamVariable.Full.of_string "build") vars && List.mem (OpamVariable.Full.of_string "post") vars) false t.depends); cond 51 `Error "The behaviour for negated dependency flags 'build' or 'post' is \ unspecified" (OpamFormula.fold_left (fun acc (_, f) -> acc || OpamFormula.fold_left (fun acc f -> acc || match f with | Filter fi -> OpamFilter.fold_down_left (fun acc fi -> acc || match fi with | FNot (FIdent ([], var, None)) -> (match OpamVariable.to_string var with | "build" | "post" -> true | _ -> false) | _ -> false) false (OpamFilter.distribute_negations fi) | _ -> false) false f) false (OpamFormula.ands [t.depends; t.depopts])); cond 52 `Error "Package is needlessly flagged \"light-uninstall\", since it has no \ remove instructions" (has_flag Pkgflag_LightUninstall t && t.remove = []); (let mismatching_extra_files = match t.extra_files, check_extra_files with | None, _ | _, None -> [] | Some fs, Some [] -> List.map fst fs | Some efiles, Some ffiles -> OpamStd.List.filter_map (fun (n, _) -> if List.mem_assoc n ffiles then None else Some n) efiles @ OpamStd.List.filter_map (fun (n, check_f) -> try if check_f (List.assoc n efiles) then None else Some n with Not_found -> Some n) ffiles in cond 53 `Error "Mismatching 'extra-files:' field" ~detail:(List.map OpamFilename.Base.to_string mismatching_extra_files) (mismatching_extra_files <> [])); (let spaced_depexts = List.concat (List.map (fun (dl,_) -> List.filter (fun d -> String.contains d ' ' || String.length d = 0) dl) t.depexts) in cond 54 `Warning "External dependencies should not contain spaces nor empty string" ~detail:spaced_depexts (spaced_depexts <> [])); (let bad_os_arch_values = List.fold_left (OpamFilter.fold_down_left (fun acc -> function | FOp (FIdent ([],vname,None), _, FString value) | FOp (FString value, _, FIdent ([],vname,None)) -> (match OpamVariable.to_string vname with | "os" -> let norm = OpamSysPoll.normalise_os value in if value <> norm then (value, norm)::acc else acc | "arch" -> let norm = OpamSysPoll.normalise_arch value in if value <> norm then (value, norm)::acc else acc | _ -> acc) | _ -> acc)) [] (all_filters t) in cond 55 `Error "Non-normalised OS or arch string being tested" ~detail:(List.map (fun (used,norm) -> Printf.sprintf "%s (use %s instead)" used norm) bad_os_arch_values) (bad_os_arch_values <> [])); cond 56 `Warning "It is discouraged for non-compiler packages to use 'setenv:'" (t.env <> [] && not (has_flag Pkgflag_Compiler t)); cond 57 `Error "Synopsis and description must not be both empty" (t.descr = None || t.descr = Some OpamFile.Descr.empty); (let vars = all_variables ~exclude_post:false ~command:[] t in let exists svar = List.exists (fun v -> v = OpamVariable.Full.of_string svar) vars in let rem_test = exists "test" in let rem_doc = exists "doc" in cond 58 `Warning (let var, s_, nvar = match rem_test, rem_doc with | true, true -> "`test` and `doc`", "s", "s are `with-test` and `with-doc`" | true, false -> "`test`", "", " is `with-test`" | false, true -> "`doc`", "", " is `with-doc`" | _ -> "","","" in Printf.sprintf "Found %s variable%s, predefined one%s" var s_ nvar) (rem_test || rem_doc)); cond 59 `Warning "url don't contain a checksum" (check_upstream && OpamStd.Option.map OpamFile.URL.checksum t.url = Some []); (let upstream_error = if not check_upstream then None else match t.url with | None -> Some "No url defined" | Some url -> let open OpamProcess.Job.Op in OpamProcess.Job.run @@ OpamFilename.with_tmp_dir_job @@ fun dir -> OpamProcess.Job.catch (function Failure msg -> Done (Some msg) | OpamDownload.Download_fail (s,l) -> Done (Some (OpamStd.Option.default l s)) | e -> Done (Some (Printexc.to_string e))) @@ fun () -> OpamDownload.download ~overwrite:false (OpamFile.URL.url url) dir @@| fun f -> (match OpamFile.URL.checksum url with | [] -> None | chks -> let not_corresponding = List.filter (fun chk -> not (OpamHash.check_file (OpamFilename.to_string f) chk)) chks in if not_corresponding = [] then None else let msg = Printf.sprintf "Cheksum%s %s don't verify archive" (if List.length chks = 1 then "" else "s") (OpamStd.List.to_string OpamHash.to_string not_corresponding) in Some msg) in cond 60 `Error "Upstream check failed" ~detail:[OpamStd.Option.default "" upstream_error] (upstream_error <> None)); (let with_test = List.exists ((=) (OpamVariable.Full.of_string "with-test")) (OpamFilter.commands_variables t.run_test) in cond 61 `Warning "`with-test` variable in `run-test` is out of scope, it will be ignored" with_test); ] in format_errors @ OpamStd.List.filter_map (fun x -> x) warnings let extra_files_default filename = let dir = OpamFilename.Op.(OpamFilename.dirname (OpamFile.filename filename) / "files") in List.map (fun f -> OpamFilename.Base.of_string (OpamFilename.remove_prefix dir f), OpamHash.check_file (OpamFilename.to_string f)) (OpamFilename.rec_files dir) let lint_gen ?check_extra_files ?check_upstream reader filename = let warnings, t = let warn_of_bad_format (pos, msg) = 2, `Error, Printf.sprintf "File format error%s: %s" (match pos with | Some (_,li,col) when li >= 0 && col >= 0 -> Printf.sprintf " at line %d, column %d" li col | _ -> "") msg in try let f = reader filename in let _, t = OpamPp.parse ~pos:(pos_file (OpamFile.filename filename)) (OpamFormat.I.map_file OpamFile.OPAM.pp_raw_fields) f in let t, warnings = match OpamPackage.of_filename (OpamFile.filename filename) with | None -> t, [] | Some nv -> let fname = nv.OpamPackage.name in let fversion = nv.OpamPackage.version in let t, name_warn = match t.OpamFile.OPAM.name with | Some tname -> if tname = fname then t, [] else t, [ 4, `Warning, Printf.sprintf "Field 'name: %S' while the directory name or pinning \ implied %S" (OpamPackage.Name.to_string tname) (OpamPackage.Name.to_string fname) ] | None -> OpamFile.OPAM.with_name fname t, [] in let t, version_warn = match t.OpamFile.OPAM.version with | Some tversion -> if tversion = fversion then t, [] else t, [ 4, `Warning, Printf.sprintf "Field 'version: %S' while the directory name or pinning \ implied %S" (OpamPackage.Version.to_string tversion) (OpamPackage.Version.to_string fversion) ] | None -> OpamFile.OPAM.with_version fversion t, [] in t, name_warn @ version_warn in warnings, Some (OpamFile.OPAM.with_metadata_dir (Some (OpamFilename.dirname (OpamFile.filename filename))) t) with | OpamSystem.File_not_found _ -> OpamConsole.error "%s not found" (OpamFile.to_string filename); [0, `Error, "File does not exist"], None | OpamLexer.Error _ | Parsing.Parse_error -> [1, `Error, "File does not parse"], None | OpamPp.Bad_format bf -> [warn_of_bad_format bf], None | OpamPp.Bad_format_list bfl -> List.map warn_of_bad_format bfl, None in let check_extra_files = match check_extra_files with | None -> extra_files_default filename | Some f -> f in warnings @ (match t with Some t -> lint ~check_extra_files ?check_upstream t | None -> []), t let lint_file ?check_extra_files ?check_upstream filename = let reader filename = try let ic = OpamFilename.open_in (OpamFile.filename filename) in try let f = OpamFile.Syntax.of_channel filename ic in close_in ic; f with e -> close_in ic; raise e with OpamSystem.File_not_found _ -> OpamConsole.error_and_exit `Bad_arguments "File %s not found" (OpamFile.to_string filename) in lint_gen ?check_extra_files ?check_upstream reader filename let lint_channel ?check_extra_files ?check_upstream filename ic = let reader filename = OpamFile.Syntax.of_channel filename ic in lint_gen ?check_extra_files ?check_upstream reader filename let lint_string ?check_extra_files ?check_upstream filename string = let reader filename = OpamFile.Syntax.of_string filename string in lint_gen ?check_extra_files ?check_upstream reader filename let warns_to_string ws = OpamStd.List.concat_map "\n" (fun (n, w, s) -> let ws = match w with | `Warning -> OpamConsole.colorise `yellow "warning" | `Error -> OpamConsole.colorise `red "error" in OpamStd.Format.reformat ~indent:14 (Printf.sprintf " %16s %2d: %s" ws n s)) ws (* Package definition loading *) open OpamFilename.Op open OpamStd.Option.Op let try_read rd f = try rd f, None with | (OpamSystem.Internal_error _ | Not_found) as exc -> if OpamFormatConfig.(!r.strict) then OpamConsole.error_and_exit `File_error "Could not read file %s: %s.\nAborting (strict mode)." (OpamFile.to_string f) (Printexc.to_string exc); None, let f = OpamFile.filename f in Some (OpamFilename.(Base.to_string (basename f)), (Some (pos_file f), Printexc.to_string exc)) | OpamPp.Bad_format bf as exc -> if OpamFormatConfig.(!r.strict) then OpamConsole.error_and_exit `File_error "Errors while parsing %s: %s.\nAborting (strict mode)." (OpamFile.to_string f) (Printexc.to_string exc); None, let f = OpamFile.filename f in Some (OpamFilename.(Base.to_string (basename f)), bf) let add_aux_files ?dir ~files_subdir_hashes opam = let dir = match dir with | None -> OpamFile.OPAM.metadata_dir opam | some -> some in match dir with | None -> opam | Some dir -> let (url_file: OpamFile.URL.t OpamFile.t) = OpamFile.make (dir // "url") in let (descr_file: OpamFile.Descr.t OpamFile.t) = OpamFile.make (dir // "descr") in let files_dir = OpamFilename.Op.(dir / "files") in let opam = match OpamFile.OPAM.url opam, try_read OpamFile.URL.read_opt url_file with | None, (Some url, None) -> OpamFile.OPAM.with_url url opam | Some opam_url, (Some url, errs) -> if url = opam_url && errs = None then log "Duplicate definition of url in '%s' and opam file" (OpamFile.to_string url_file) else OpamConsole.warning "File '%s' ignored (conflicting url already specified in the \ 'opam' file)" (OpamFile.to_string url_file); opam | _, (_, Some err) -> OpamFile.OPAM.with_format_errors (err :: opam.format_errors) opam | _, (None, None) -> opam in let opam = match OpamFile.OPAM.descr opam, try_read OpamFile.Descr.read_opt descr_file with | None, (Some descr, None) -> OpamFile.OPAM.with_descr descr opam | Some _, (Some _, _) -> log "Duplicate descr in '%s' and opam file" (OpamFile.to_string descr_file); opam | _, (_, Some err) -> OpamFile.OPAM.with_format_errors (err :: opam.format_errors) opam | _, (None, None) -> opam in let opam = if not files_subdir_hashes then opam else let extra_files = OpamFilename.opt_dir files_dir >>| fun dir -> List.map (fun f -> OpamFilename.Base.of_string (OpamFilename.remove_prefix dir f), OpamHash.compute (OpamFilename.to_string f)) (OpamFilename.rec_files dir) in match OpamFile.OPAM.extra_files opam, extra_files with | None, None -> opam | None, Some ef -> OpamFile.OPAM.with_extra_files ef opam | Some ef, None -> log "Missing expected extra files %s at %s/files" (OpamStd.List.concat_map ", " (fun (f,_) -> OpamFilename.Base.to_string f) ef) (OpamFilename.Dir.to_string dir); opam | Some oef, Some ef -> let sort = List.sort (fun (b, _) (b', _) -> compare b b') in if sort oef <> sort ef then log "Mismatching extra-files at %s" (OpamFilename.Dir.to_string dir); opam in opam let read_opam dir = let (opam_file: OpamFile.OPAM.t OpamFile.t) = OpamFile.make (dir // "opam") in match try_read OpamFile.OPAM.read_opt opam_file with | Some opam, None -> Some (add_aux_files ~dir ~files_subdir_hashes:true opam) | _, Some err -> OpamConsole.warning "Could not read file %s. skipping:\n%s" (OpamFile.to_string opam_file) (OpamPp.string_of_bad_format (OpamPp.Bad_format (snd err))); None | None, None -> None opam-2.0.5/src/state/opamPinned.ml0000644000175000017500000001676513511367404016030 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamFilename.Op let package st name = OpamPackage.package_of_name st.pinned name let package_opt st name = try Some (package st name) with Not_found -> None let version st name = (package st name).version let packages st = st.pinned let possible_definition_filenames dir name = [ dir / (OpamPackage.Name.to_string name ^ ".opam") // "opam"; dir // (OpamPackage.Name.to_string name ^ ".opam"); dir / "opam" / (OpamPackage.Name.to_string name ^ ".opam") // "opam"; dir / "opam" // (OpamPackage.Name.to_string name ^ ".opam"); dir / "opam" // "opam"; dir // "opam" ] let check_locked default = match OpamStateConfig.(!r.locked) with | None -> default | Some ext -> let fl = OpamFilename.add_extension default ext in if OpamFilename.exists fl then (let base_depends = OpamFile.make default |> OpamFile.OPAM.read |> OpamFile.OPAM.depends in let lock_depends = OpamFile.make fl |> OpamFile.OPAM.read |> OpamFile.OPAM.depends in let ldep_names = OpamFormula.fold_left (fun acc (n,_) -> OpamPackage.Name.Set.add n acc) OpamPackage.Name.Set.empty lock_depends in let base_formula = OpamFilter.filter_deps ~build:true ~post:true ~test:true ~doc:true ~dev:true base_depends in let lock_formula = OpamFilter.filter_deps ~build:true ~post:true ~test:true ~doc:true ~dev:true lock_depends in let lpkg_f = lock_formula |> OpamFormula.atoms |> OpamPackage.Name.Map.of_list in (* Check consistency between them. It is based on the fact that locked file dependencies are an and list with precise version, i.e., pkg { =v0.1}. Construction of a two list: missing dependencies and inconsistent ones (version mismatch) *) let (@) = List.rev_append in let rec fold formula = List.fold_left cross ([],[]) (OpamFormula.ands_to_list formula) and cross (cont,cons) formula = match formula with | Atom (bn, bvf) -> ( let cont = if OpamPackage.Name.Set.mem bn ldep_names then cont else bn::cont in let cons = match OpamPackage.Name.Map.find_opt bn lpkg_f with | Some (Some (`Eq, lv)) -> if OpamFormula.check_version_formula bvf lv then cons else (bn, lv, bvf)::cons | _ -> cons in (cont,cons)) | Or (or1, or2) -> let or1_cont, or1_cons = fold or1 in let or2_cont, or2_cons = fold or2 in let cont = if or1_cont = [] || or2_cont = [] then cont else or1_cont @ or2_cont @ cont in let cons = if or1_cons = [] || or2_cons = [] then cons else or1_cons @ or2_cons @ cons in (cont,cons) | And (and1, and2) -> let and1_cont, and1_cons = fold and1 in let and2_cont, and2_cons = fold and2 in ((and1_cont @ and2_cont @ cont), (and1_cons @ and2_cons @ cons)) | Block f -> cross (cont,cons) f | Empty -> (cont,cons) in let contains, consistent = fold base_formula in if contains <> [] || consistent <> [] then (OpamConsole.warning "Lock file %s is outdated, you may want to re-run opam lock:\n%s" (OpamConsole.colorise `underline (OpamFilename.Base.to_string (OpamFilename.basename fl))) ((if contains <> [] then Printf.sprintf "Dependencies present in opam file not in lock file:\n%s" (OpamStd.Format.itemize OpamPackage.Name.to_string contains) else "") ^ (if consistent <> [] then Printf.sprintf "Dependencies in lock file not consistent wit opam file filter:\n%s" (OpamStd.Format.itemize (fun (n,lv,(bv: OpamFormula.version_formula)) -> Printf.sprintf "%s: %s in not contained in {%s}" (OpamPackage.Name.to_string n) (OpamPackage.Version.to_string lv) (OpamFormula.string_of_formula (fun (op, vc) -> Printf.sprintf "%s %s" (OpamPrinter.relop op) (OpamPackage.Version.to_string vc)) bv)) consistent) else ""))); fl) else default let find_opam_file_in_source name dir = let opt = OpamStd.List.find_opt OpamFilename.exists (possible_definition_filenames dir name) in (match opt with | Some base -> Some (check_locked base) | _ -> opt) |> OpamStd.Option.map OpamFile.make let name_of_opam_filename dir file = let open OpamStd.Option.Op in let suffix = ".opam" in let get_name s = if Filename.check_suffix s suffix then Some Filename.(chop_suffix (basename s) suffix) else None in let rel = OpamFilename.remove_prefix dir file in let rel = match OpamStateConfig.(!r.locked) with | None -> rel | Some suf -> let ext = "."^suf in if OpamStd.String.ends_with ~suffix:(suffix^ext) rel then OpamStd.String.remove_suffix ~suffix:ext rel else rel in (get_name (Filename.basename rel) >>+ fun () -> get_name (Filename.dirname rel)) >>= fun name -> try Some (OpamPackage.Name.of_string name) with Failure _ -> None let files_in_source d = let baseopam = OpamFilename.Base.of_string "opam" in let files d = List.filter (fun f -> OpamFilename.basename f = baseopam || OpamFilename.check_suffix f ".opam") (OpamFilename.files d) @ OpamStd.List.filter_map (fun d -> if OpamFilename.(basename_dir d = Base.of_string "opam") || OpamStd.String.ends_with ~suffix:".opam" (OpamFilename.Dir.to_string d) then OpamFilename.opt_file OpamFilename.Op.(d//"opam") else None) (OpamFilename.dirs d) in files d @ files (d / "opam") |> List.map check_locked |> OpamStd.List.filter_map (fun f -> try (* Ignore empty files *) if (Unix.stat (OpamFilename.to_string f)).Unix.st_size = 0 then None else Some (name_of_opam_filename d f, OpamFile.make f) with Unix.Unix_error _ -> OpamConsole.error "Can not read %s, ignored." (OpamFilename.to_string f); None) let orig_opam_file name opam = let open OpamStd.Option.Op in OpamFile.OPAM.metadata_dir opam >>= fun dir -> OpamStd.List.find_opt OpamFilename.exists [ dir // (OpamPackage.Name.to_string name ^ ".opam"); dir // "opam" ] >>| OpamFile.make opam-2.0.5/src/state/opamFileTools.mli0000644000175000017500000000713013511367404016646 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2016 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Tools for manipulating and checking package definition ("opam") files *) open OpamTypes (** Create an OPAM package template filled with common options *) val template: package -> OpamFile.OPAM.t (** Runs several sanity checks on the opam file; returns a list of warnings. [`Error] level should be considered unfit for publication, while [`Warning] are advisory but may be accepted. The int is an identifier for this specific warning/error. If [check_extra_files] is unspecified, warning 53 won't be checked. *) val lint: ?check_extra_files:(basename * (OpamHash.t -> bool)) list -> ?check_upstream: bool -> OpamFile.OPAM.t -> (int * [`Warning|`Error] * string) list (** Same as [lint], but operates on a file, which allows catching parse errors too. You can specify an expected name and version. [check_extra_files] defaults to a function that will look for a [files/] directory besides [filename] *) val lint_file: ?check_extra_files:(basename * (OpamHash.t -> bool)) list -> ?check_upstream: bool -> OpamFile.OPAM.t OpamFile.typed_file -> (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option (** Same as [lint_file], but taking input from a channel. [check_extra_files] defaults to a function that will look for a [files/] directory besides [filename] *) val lint_channel: ?check_extra_files:(basename * (OpamHash.t -> bool)) list -> ?check_upstream: bool -> OpamFile.OPAM.t OpamFile.typed_file -> in_channel -> (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option (** Like [lint_file], but takes the file contents as a string. [check_extra_files] defaults to a function that will look for a [files/] directory besides [filename] *) val lint_string: ?check_extra_files:(basename * (OpamHash.t -> bool)) list -> ?check_upstream: bool -> OpamFile.OPAM.t OpamFile.typed_file -> string -> (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option (** Utility function to print validation results *) val warns_to_string: (int * [`Warning|`Error] * string) list -> string (** Read the opam metadata from a given directory (opam file, with possible overrides from url and descr files). Also includes the names and hashes of files below files/ *) val read_opam: dirname -> OpamFile.OPAM.t option (** Adds data from 'url' and 'descr' files found in the specified dir or the opam file's metadata dir, if not already present in the opam file. if [files_subdir_hashes] is [true], also adds the names and hashes of files found below 'files/' *) val add_aux_files: ?dir:dirname -> files_subdir_hashes:bool -> OpamFile.OPAM.t -> OpamFile.OPAM.t (** {2 Tools to manipulate the [OpamFile.OPAM.t] contents} *) val map_all_variables: (full_variable -> full_variable) -> OpamFile.OPAM.t -> OpamFile.OPAM.t val map_all_filters: (filter -> filter) -> OpamFile.OPAM.t -> OpamFile.OPAM.t opam-2.0.5/src/state/opamUpdate.ml0000644000175000017500000004643213511367404016027 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamStd.Op open OpamProcess.Job.Op open OpamFilename.Op let log fmt = OpamConsole.log "UPDATE" fmt let slog = OpamConsole.slog let eval_redirect gt repo = if repo.repo_url.OpamUrl.backend <> `http then None else let redirect = repo.repo_root |> OpamRepositoryPath.repo |> OpamFile.Repo.safe_read |> OpamFile.Repo.redirect in let redirect = List.fold_left (fun acc (redirect, filter) -> if OpamFilter.opt_eval_to_bool (OpamPackageVar.resolve_global gt) filter then (redirect, filter) :: acc else acc ) [] redirect in match redirect with | [] -> None | (redirect, f) :: _ -> let redirect_url = if OpamStd.String.contains ~sub:"://" redirect then OpamUrl.of_string redirect else OpamUrl.Op.(repo.repo_url / redirect) in if redirect_url = repo.repo_url then None else Some (redirect_url, f) let repository gt repo = let max_loop = 10 in if repo.repo_url = OpamUrl.empty then Done (fun rt -> rt) else (* Recursively traverse redirection links, but stop after 10 steps or if we cycle back to the initial repo. *) let rec job r n = if n = 0 then (OpamConsole.warning "%s: Too many redirections, stopping." (OpamRepositoryName.to_string repo.repo_name); Done r) else let text = OpamProcess.make_command_text ~color:`blue (OpamRepositoryName.to_string repo.repo_name) OpamUrl.(string_of_backend repo.repo_url.backend) in OpamProcess.Job.with_text text @@ OpamRepository.update r @@+ fun () -> if n <> max_loop && r = repo then (OpamConsole.warning "%s: Cyclic redirections, stopping." (OpamRepositoryName.to_string repo.repo_name); Done r) else match eval_redirect gt r with | None -> Done r | Some (new_url, f) -> OpamFilename.cleandir repo.repo_root; let reason = match f with | None -> "" | Some f -> Printf.sprintf " (%s)" (OpamFilter.to_string f) in OpamConsole.note "The repository '%s' will be *%s* redirected to %s%s" (OpamRepositoryName.to_string repo.repo_name) (OpamConsole.colorise `bold "permanently") (OpamUrl.to_string new_url) reason; job { r with repo_url = new_url } (n-1) in job repo max_loop @@+ fun repo -> let repo_file_path = OpamRepositoryPath.repo repo.repo_root in if not (OpamFile.exists repo_file_path) then OpamConsole.warning "The repository '%s' at %s doesn't have a 'repo' file, and might not be \ compatible with this version of opam." (OpamRepositoryName.to_string repo.repo_name) (OpamUrl.to_string repo.repo_url); let repo_file = OpamFile.Repo.safe_read repo_file_path in let repo_file = OpamFile.Repo.with_root_url repo.repo_url repo_file in let repo_vers = OpamStd.Option.default OpamVersion.current_nopatch @@ OpamFile.Repo.opam_version repo_file in if not OpamFormatConfig.(!r.skip_version_checks) && OpamVersion.compare repo_vers OpamVersion.current > 0 then Printf.ksprintf failwith "repository format version is %s, and this is only opam %s" (OpamVersion.to_string repo_vers) (OpamVersion.to_string OpamVersion.current); List.iter (fun (msg, filter) -> if OpamFilter.opt_eval_to_bool (OpamPackageVar.resolve_global gt) filter then OpamConsole.formatted_msg ~indent:4 "%s (at %s): %s\n" (OpamConsole.colorise' [`bold;`green] (OpamRepositoryName.to_string repo.repo_name)) (OpamConsole.colorise `bold (OpamUrl.to_string repo.repo_url)) msg) (OpamFile.Repo.announce repo_file); let opams = OpamRepositoryState.load_repo_opams repo in Done ( (* Return an update function to make parallel execution possible *) fun rt -> { rt with repositories = OpamRepositoryName.Map.add repo.repo_name repo rt.repositories; repos_definitions = OpamRepositoryName.Map.add repo.repo_name repo_file rt.repos_definitions; repo_opams = OpamRepositoryName.Map.add repo.repo_name opams rt.repo_opams; } ) let repositories rt repos = let command repo = OpamProcess.Job.catch (fun ex -> OpamStd.Exn.fatal ex; OpamConsole.error "Could not update repository %S: %s" (OpamRepositoryName.to_string repo.repo_name) (match ex with Failure s -> s | ex -> Printexc.to_string ex); Done ([repo], fun t -> t)) @@ fun () -> repository rt.repos_global repo @@| fun f -> [], f in let failed, rt_update = OpamParallel.reduce ~jobs:OpamStateConfig.(!r.dl_jobs) ~command ~merge:(fun (failed1, f1) (failed2, f2) -> failed1 @ failed2, f1 @* f2) ~nil:([], fun x -> x) ~dry_run:OpamStateConfig.(!r.dryrun) repos in let rt = rt_update rt in OpamRepositoryState.write_config rt; OpamRepositoryState.Cache.save rt; failed, rt let fetch_dev_package url srcdir ?(working_dir=false) nv = let remote_url = OpamFile.URL.url url in let mirrors = remote_url :: OpamFile.URL.mirrors url in let checksum = OpamFile.URL.checksum url in log "updating %a" (slog OpamUrl.to_string) remote_url; OpamRepository.pull_tree ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) (OpamPackage.to_string nv) srcdir checksum ~working_dir mirrors let pinned_package st ?version ?(working_dir=false) name = log "update-pinned-package %s%a" (OpamPackage.Name.to_string name) (slog @@ function true -> " (working dir)" | false -> "") working_dir; let open OpamStd.Option.Op in let root = st.switch_global.root in let overlay_dir = OpamPath.Switch.Overlay.package root st.switch name in let overlay_opam = OpamFileTools.read_opam overlay_dir in match overlay_opam >>| fun opam -> opam, OpamFile.OPAM.url opam with | None | Some (_, None) -> Done ((fun st -> st), false) | Some (opam, Some urlf) -> let url = OpamFile.URL.url urlf in let version = OpamFile.OPAM.version_opt opam ++ version +! OpamPackage.Version.of_string "dev" in let nv = OpamPackage.create name version in let srcdir = OpamPath.Switch.pinned_package root st.switch name in (* Four versions of the metadata: from the old and new versions of the package, from the current overlay, and also the original one from the repo *) let add_extra_files srcdir file opam = if OpamFilename.dirname (OpamFile.filename file) <> srcdir then OpamFileTools.add_aux_files ~files_subdir_hashes:true opam else opam in let old_source_opam_hash, old_source_opam = match OpamPinned.find_opam_file_in_source name srcdir with | None -> None, None | Some f -> Some (OpamHash.compute (OpamFile.to_string f)), try Some (OpamFile.OPAM.read f |> OpamFile.OPAM.with_name name |> add_extra_files srcdir f) with e -> OpamStd.Exn.fatal e; None in let repo_opam = let packages = OpamPackage.Map.filter (fun nv _ -> nv.name = name) st.repos_package_index in (* get the latest version below v *) match OpamPackage.Map.split nv packages with | _, (Some opam), _ -> Some opam | below, None, _ when not (OpamPackage.Map.is_empty below) -> Some (snd (OpamPackage.Map.max_binding below)) | _, None, above when not (OpamPackage.Map.is_empty above) -> Some (snd (OpamPackage.Map.min_binding above)) | _ -> None in (if working_dir then Done () else (match url.OpamUrl.hash with | None -> Done true | Some h -> OpamRepository.current_branch url @@| fun branch -> branch = Some h) @@+ function false -> Done () | true -> OpamRepository.is_dirty url @@| function false -> () | true -> OpamConsole.note "Ignoring uncommitted changes in %s (`--working-dir' not active)." url.OpamUrl.path) @@+ fun () -> (* Do the update *) fetch_dev_package urlf srcdir ~working_dir nv @@+ fun result -> let new_source_opam = OpamPinned.find_opam_file_in_source name srcdir >>= fun f -> let warns, opam_opt = OpamFileTools.lint_file f in let warns, opam_opt = match opam_opt with | Some opam0 -> let opam = OpamFormatUpgrade.opam_file ~quiet:true ~filename:f opam0 in if opam <> opam0 then OpamFileTools.lint opam, Some opam else warns, Some opam0 | None -> warns, opam_opt in if warns <> [] && match old_source_opam_hash with | None -> true | Some h -> not (OpamHash.check_file (OpamFile.to_string f) h) then (OpamConsole.warning "%s opam file from upstream of %s:" (if opam_opt = None then "Fatal errors, not using" else "Failed checks in") (OpamConsole.colorise `bold (OpamPackage.Name.to_string name)); OpamConsole.errmsg "%s\n" (OpamFileTools.warns_to_string warns)); opam_opt >>| OpamFile.OPAM.with_name name >>| add_extra_files srcdir f in let equal_opam a b = let cleanup_opam o = let v = (try Some ((OpamFile.OPAM.version_opt o) +! (OpamSwitchState.get_package st name |> OpamPackage.version)) with Not_found -> None) +! (OpamPackage.Version.of_string "~dev") in o |> OpamFile.OPAM.with_url_opt None |> OpamFile.OPAM.with_version v in OpamFile.OPAM.effectively_equal (cleanup_opam (OpamFormatUpgrade.opam_file a)) (cleanup_opam (OpamFormatUpgrade.opam_file b)) in let changed_opam old new_ = match old, new_ with | None, Some _ -> true | _, None -> false | Some a, Some b -> not (equal_opam a b) in let save_overlay opam = OpamFilename.mkdir overlay_dir; let opam_file = OpamPath.Switch.Overlay.opam root st.switch name in List.iter OpamFilename.remove OpamPath.Switch.Overlay.([ OpamFile.filename opam_file; OpamFile.filename (url root st.switch name); OpamFile.filename (descr root st.switch name); ]); let files_dir = OpamPath.Switch.Overlay.files root st.switch name in OpamFilename.rmdir files_dir; let opam = OpamFile.OPAM.with_url urlf @@ OpamFile.OPAM.with_name name opam in let opam = if OpamFile.OPAM.version_opt opam = None then OpamFile.OPAM.with_version version opam else opam in List.iter (fun (file, rel_file, hash) -> if OpamFilename.exists file && OpamHash.check_file (OpamFilename.to_string file) hash then OpamFilename.copy ~src:file ~dst:(OpamFilename.create files_dir rel_file) else OpamConsole.warning "Ignoring file %s with invalid hash" (OpamFilename.to_string file)) (OpamFile.OPAM.get_extra_files opam); OpamFile.OPAM.write opam_file (OpamFile.OPAM.with_extra_files_opt None opam); opam in match result, new_source_opam with | Result (), Some new_opam when changed_opam old_source_opam new_source_opam && changed_opam overlay_opam new_source_opam -> log "Metadata from the package source of %s changed" (OpamPackage.to_string nv); let interactive_part st = if not (changed_opam old_source_opam overlay_opam) || not (changed_opam repo_opam overlay_opam) then (* No manual changes *) (OpamConsole.formatted_msg "[%s] Installing new package description from upstream %s\n" (OpamConsole.colorise `green (OpamPackage.Name.to_string name)) (OpamUrl.to_string url); let opam = save_overlay new_opam in OpamSwitchState.update_pin nv opam st) else if OpamConsole.formatted_msg "[%s] Conflicting update of the metadata from %s." (OpamConsole.colorise `green (OpamPackage.Name.to_string name)) (OpamUrl.to_string url); OpamConsole.confirm "\nOverride files in %s (there will be a backup)?" (OpamFilename.Dir.to_string overlay_dir) then ( let bak = OpamPath.backup_dir root / (OpamPackage.Name.to_string name ^ ".bak") in OpamFilename.mkdir (OpamPath.backup_dir root); OpamFilename.rmdir bak; OpamFilename.copy_dir ~src:overlay_dir ~dst:bak; OpamConsole.formatted_msg "User metadata backed up in %s\n" (OpamFilename.Dir.to_string bak); let opam = save_overlay new_opam in OpamSwitchState.update_pin nv opam st) else st in Done (interactive_part, true) | (Up_to_date _ | Not_available _), _ -> Done ((fun st -> st), false) | Result (), Some new_opam when not (changed_opam old_source_opam overlay_opam) -> (* The new opam is not _effectively_ different from the old, so no need to confirm, but use it still (e.g. descr may have changed) *) let opam = save_overlay new_opam in Done ((fun st -> {st with opams = OpamPackage.Map.add nv opam st.opams}), true) | Result (), _ -> Done ((fun st -> st), true) let dev_package st ?working_dir nv = log "update-dev-package %a" (slog OpamPackage.to_string) nv; if OpamSwitchState.is_pinned st nv.name && not (OpamSwitchState.is_version_pinned st nv.name) then pinned_package st ~version:nv.version ?working_dir nv.name else match OpamSwitchState.url st nv with | None -> Done ((fun st -> st), false) | Some url -> if (OpamFile.URL.url url).OpamUrl.backend = `http then Done ((fun st -> st), false) else fetch_dev_package url (OpamSwitchState.source_dir st nv) ?working_dir nv @@| fun result -> (fun st -> st), match result with Result () -> true | _ -> false let dev_packages st ?(working_dir=OpamPackage.Set.empty) packages = log "update-dev-packages"; let command nv = let working_dir = OpamPackage.Set.mem nv working_dir in OpamProcess.Job.ignore_errors ~default:(false, (fun st -> st), OpamPackage.Set.empty) @@ fun () -> dev_package st ~working_dir nv @@| fun (st_update, changed) -> true, st_update, match changed with | true -> OpamPackage.Set.singleton nv | false -> OpamPackage.Set.empty in let merge (ok1, st_update1, set1) (ok2, st_update2, set2) = ok1 && ok2, (fun st -> st_update1 (st_update2 st)), OpamPackage.Set.union set1 set2 in let success, st_update, updated_set = OpamParallel.reduce ~jobs:OpamStateConfig.(!r.dl_jobs) ~command ~merge ~nil:(true, (fun st -> st), OpamPackage.Set.empty) (OpamPackage.Set.elements packages) in let selections0 = OpamSwitchState.selections st in let st = st_update st in let st = OpamSwitchAction.add_to_reinstall st ~unpinned_only:false updated_set in (* The following is needed for pinned packages that may have changed version *) let selections1 = OpamSwitchState.selections st in if selections0 <> selections1 then OpamFile.SwitchSelections.write (OpamPath.Switch.selections st.switch_global.root st.switch) selections1; success, st, updated_set let pinned_packages st ?(working_dir=OpamPackage.Name.Set.empty) names = log "update-pinned-packages"; let command name = let working_dir = OpamPackage.Name.Set.mem name working_dir in OpamProcess.Job.ignore_errors ~default:((fun st -> st), OpamPackage.Name.Set.empty) @@ fun () -> pinned_package st ~working_dir name @@| fun (st_update, changed) -> st_update, match changed with | true -> OpamPackage.Name.Set.singleton name | false -> OpamPackage.Name.Set.empty in let merge (st_update1, set1) (st_update2, set2) = (fun st -> st_update1 (st_update2 st)), OpamPackage.Name.Set.union set1 set2 in let st_update, updates = OpamParallel.reduce ~jobs:(OpamFile.Config.jobs st.switch_global.config) ~command ~merge ~nil:((fun st -> st), OpamPackage.Name.Set.empty) (OpamPackage.Name.Set.elements names) in let st = st_update st in let updates = OpamPackage.Name.Set.fold (fun name acc -> OpamPackage.Set.add (OpamPinned.package st name) acc) updates OpamPackage.Set.empty in OpamSwitchAction.add_to_reinstall st ~unpinned_only:false updates, updates let active_caches st nv = let global_cache = OpamFile.Config.dl_cache st.switch_global.config in let rt = st.switch_repos in let repo_cache = match OpamRepositoryState.find_package_opt rt (OpamSwitchState.repos_list st) nv with | None -> [] | Some (repo, _) -> let repo_def = OpamRepositoryName.Map.find repo rt.repos_definitions in let root_url = match OpamFile.Repo.root_url repo_def with | None -> OpamSystem.internal_error "repo file of unknown origin" | Some u -> u in List.map (fun rel -> if OpamStd.String.contains ~sub:"://" rel then OpamUrl.of_string rel else OpamUrl.Op.(root_url / rel)) (OpamFile.Repo.dl_cache repo_def) in repo_cache @ global_cache let cleanup_source st old_opam_opt new_opam = let open OpamStd.Option.Op in let base_url urlf = let u = OpamFile.URL.url urlf in { u with OpamUrl.hash = None } in let url_remote opam = OpamFile.OPAM.url opam >>| base_url in if url_remote new_opam <> (old_opam_opt >>= url_remote) then OpamFilename.rmdir (OpamSwitchState.source_dir st (OpamFile.OPAM.package new_opam)) let download_package_source st nv dirname = let opam = OpamSwitchState.opam st nv in let cache_dir = OpamRepositoryPath.download_cache st.switch_global.root in let cache_urls = active_caches st nv in let fetch_source_job = match OpamFile.OPAM.url opam with | None -> Done None | Some u -> OpamRepository.pull_tree (OpamPackage.to_string nv) ~cache_dir ~cache_urls dirname (OpamFile.URL.checksum u) (OpamFile.URL.url u :: OpamFile.URL.mirrors u) @@| OpamStd.Option.some in let fetch_extra_source_job (name, u) = function | Some (Not_available _) as err -> Done err | ret -> OpamRepository.pull_file_to_cache (OpamPackage.to_string nv ^"/"^ OpamFilename.Base.to_string name) ~cache_dir ~cache_urls (OpamFile.URL.checksum u) (OpamFile.URL.url u :: OpamFile.URL.mirrors u) @@| function | Not_available _ as na -> Some na | _ -> ret in fetch_source_job @@+ OpamProcess.Job.seq (List.map fetch_extra_source_job (OpamFile.OPAM.extra_sources opam)) opam-2.0.5/src/state/opamFormatUpgrade.mli0000644000175000017500000000533213511367404017510 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** This modules handles the conversion from older repository and package versions to the current one *) open OpamTypes (** Raised when the opam root has been updated to a newer format, and further action (opam init/update) is needed. *) exception Upgrade_done of OpamFile.Config.t (** The latest version of the opam root format, that normal operation of this instance of opam requires *) val latest_version: OpamVersion.t (** Runs the upgrade from its current format to the latest version for the opam root at the given directory. A global write lock must be supplied. If an upgrade has been done, raises [Upgrade_done updated_config]. *) val as_necessary: OpamSystem.lock -> dirname -> OpamFile.Config.t -> unit (** Converts the opam file format, including rewriting availabillity conditions based on OCaml-related variables into dependencies. The filename is used to report errors *) val opam_file_from_1_2_to_2_0: ?filename:OpamFile.OPAM.t OpamFile.t -> OpamFile.OPAM.t -> OpamFile.OPAM.t (** Runs the opam file format from the file's format to current. Supplying [filename] enables additional notification messages *) val opam_file: ?quiet:bool -> ?filename:OpamFile.OPAM.t OpamFile.t -> OpamFile.OPAM.t -> OpamFile.OPAM.t (** Convert the comp file to an opam one, using [OpamFile.Comp.to_package] and applying filter rewriting *) val comp_file: ?package:package -> ?descr:OpamFile.Descr.t -> OpamFile.Comp.t -> OpamFile.OPAM.t (** Runs the opam file format from the file's format to current, and adds data from 'url' and 'descr' files found in the specified dir or the opam file's metadata dir, if not already present in the opam file. If [files] is [true], also adds the names and hashes of files found below 'files/'. Supplying [filename] enables additional notification messages *) val opam_file_with_aux: ?quiet:bool -> ?dir:dirname -> files:bool -> ?filename:OpamFile.OPAM.t OpamFile.t -> OpamFile.OPAM.t -> OpamFile.OPAM.t opam-2.0.5/src/state/opamStateConfig.ml0000644000175000017500000001436013511367404017006 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes type t = { root_dir: OpamFilename.Dir.t; current_switch: OpamSwitch.t option; switch_from: [ `Env | `Command_line | `Default ]; jobs: int Lazy.t; dl_jobs: int; build_test: bool; build_doc: bool; dryrun: bool; makecmd: string Lazy.t; ignore_constraints_on: name_set; unlock_base: bool; no_env_notice: bool; locked: string option; } let default = { root_dir = OpamFilename.( concat_and_resolve (Dir.of_string (OpamStd.Sys.home ())) ".opam" ); current_switch = None; switch_from = `Default; jobs = lazy (max 1 (OpamSystem.cpu_count () - 1)); dl_jobs = 3; build_test = false; build_doc = false; dryrun = false; makecmd = lazy OpamStd.Sys.( match os () with | FreeBSD | OpenBSD | NetBSD | DragonFly -> "gmake" | _ -> "make" ); ignore_constraints_on = OpamPackage.Name.Set.empty; unlock_base = false; no_env_notice = false; locked = None; } type 'a options_fun = ?root_dir:OpamFilename.Dir.t -> ?current_switch:OpamSwitch.t -> ?switch_from:[ `Env | `Command_line | `Default ] -> ?jobs:(int Lazy.t) -> ?dl_jobs:int -> ?build_test:bool -> ?build_doc:bool -> ?dryrun:bool -> ?makecmd:string Lazy.t -> ?ignore_constraints_on:name_set -> ?unlock_base:bool -> ?no_env_notice:bool -> ?locked:string option -> 'a let setk k t ?root_dir ?current_switch ?switch_from ?jobs ?dl_jobs ?build_test ?build_doc ?dryrun ?makecmd ?ignore_constraints_on ?unlock_base ?no_env_notice ?locked = let (+) x opt = match opt with Some x -> x | None -> x in k { root_dir = t.root_dir + root_dir; current_switch = (match current_switch with None -> t.current_switch | s -> s); switch_from = t.switch_from + switch_from; jobs = t.jobs + jobs; dl_jobs = t.dl_jobs + dl_jobs; build_test = t.build_test + build_test; build_doc = t.build_doc + build_doc; dryrun = t.dryrun + dryrun; makecmd = t.makecmd + makecmd; ignore_constraints_on = t.ignore_constraints_on + ignore_constraints_on; unlock_base = t.unlock_base + unlock_base; no_env_notice = t.no_env_notice + no_env_notice; locked = t.locked + locked; } let set t = setk (fun x () -> x) t let r = ref default let update ?noop:_ = setk (fun cfg () -> r := cfg) !r let initk k = let open OpamStd.Config in let open OpamStd.Option.Op in let current_switch, switch_from = match env_string "SWITCH" with | Some "" | None -> None, None | Some s -> Some (OpamSwitch.of_string s), Some `Env in setk (setk (fun c -> r := c; k)) !r ?root_dir:(env_string "ROOT" >>| OpamFilename.Dir.of_string) ?current_switch ?switch_from ?jobs:(env_int "JOBS" >>| fun s -> lazy s) ?dl_jobs:(env_int "DOWNLOADJOBS") ?build_test:(env_bool "WITHTEST" ++ env_bool "BUILDTEST") ?build_doc:(env_bool "WITHDOC" ++ env_bool "BUILDDOC") ?dryrun:(env_bool "DRYRUN") ?makecmd:(env_string "MAKECMD" >>| fun s -> lazy s) ?ignore_constraints_on: (env_string "IGNORECONSTRAINTS" >>| fun s -> OpamStd.String.split s ',' |> List.map OpamPackage.Name.of_string |> OpamPackage.Name.Set.of_list) ?unlock_base:(env_bool "UNLOCKBASE") ?no_env_notice:(env_bool "NOENVNOTICE") ?locked:(env_string "LOCKED" >>| function "" -> None | s -> Some s) let init ?noop:_ = initk (fun () -> ()) let opamroot ?root_dir () = let open OpamStd.Option.Op in (root_dir >>+ fun () -> OpamStd.Env.getopt "OPAMROOT" >>| OpamFilename.Dir.of_string) +! default.root_dir let load opamroot = OpamFile.Config.read_opt (OpamPath.config opamroot) let local_switch_exists root switch = OpamPath.Switch.switch_config root switch |> OpamFile.Switch_config.read_opt |> function | None -> false | Some conf -> conf.OpamFile.Switch_config.opam_root = Some root let resolve_local_switch root s = let switch_root = OpamSwitch.get_root root s in if OpamSwitch.is_external s && OpamFilename.dirname_dir switch_root = root then OpamSwitch.of_string (OpamFilename.remove_prefix_dir root switch_root) else s let get_current_switch_from_cwd root = let open OpamStd.Option.Op in OpamFilename.find_in_parents (fun dir -> OpamSwitch.of_string (OpamFilename.Dir.to_string dir) |> local_switch_exists root) (OpamFilename.cwd ()) >>| OpamSwitch.of_dirname >>| resolve_local_switch root let load_defaults root_dir = let current_switch = match OpamStd.Config.env_string "SWITCH" with | Some "" | None -> get_current_switch_from_cwd root_dir | _ -> (* OPAMSWITCH is set, no need to lookup *) None in match load root_dir with | None -> update ?current_switch (); None | Some conf -> let open OpamStd.Option.Op in OpamRepositoryConfig.update ?download_tool:(OpamFile.Config.dl_tool conf >>| function | (CString c,None)::_ as t when OpamStd.String.ends_with ~suffix:"curl" c -> lazy (t, `Curl) | t -> lazy (t, `Default)) ~validation_hook:(OpamFile.Config.validation_hook conf) (); update ?current_switch:(OpamFile.Config.switch conf) ~switch_from:`Default ~jobs:(lazy (OpamFile.Config.jobs conf)) ~dl_jobs:(OpamFile.Config.dl_jobs conf) (); update ?current_switch (); Some conf let get_switch_opt () = match !r.current_switch with | Some s -> Some (resolve_local_switch !r.root_dir s) | None -> None let get_switch () = match get_switch_opt () with | Some s -> s | None -> OpamConsole.error_and_exit `Configuration_error "No switch is currently set. Please use 'opam switch' to set or install \ a switch" opam-2.0.5/src/state/opamStateConfig.mli0000644000175000017500000000631013511367404017153 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration options for the state lib (record, global reference, setter, initialisation) *) open OpamTypes type t = private { root_dir: OpamFilename.Dir.t; current_switch: OpamSwitch.t option; switch_from: [ `Env | `Command_line | `Default ]; jobs: int Lazy.t; dl_jobs: int; build_test: bool; build_doc: bool; dryrun: bool; makecmd: string Lazy.t; ignore_constraints_on: name_set; unlock_base: bool; no_env_notice: bool; locked: string option; } type 'a options_fun = ?root_dir:OpamFilename.Dir.t -> ?current_switch:OpamSwitch.t -> ?switch_from:[ `Env | `Command_line | `Default ] -> ?jobs:(int Lazy.t) -> ?dl_jobs:int -> ?build_test:bool -> ?build_doc:bool -> ?dryrun:bool -> ?makecmd:string Lazy.t -> ?ignore_constraints_on:name_set -> ?unlock_base:bool -> ?no_env_notice:bool -> ?locked:string option -> 'a include OpamStd.Config.Sig with type t := t and type 'a options_fun := 'a options_fun (** Get the initial opam root value (from default, env or optional argument). This allows one to get it before doing the init, which is useful to get the configuration file used to fill some options to init() *) val opamroot: ?root_dir:dirname -> unit -> dirname (** Loads the global configuration file, protecting against concurrent writes *) val load: dirname -> OpamFile.Config.t option (** Loads the config file from the OPAM root and updates default values for all related OpamXxxConfig modules. Doesn't read the env yet, the [init] functions should still be called afterwards. OpamFormat should be initialised beforehand, as it may impact the config file loading. Returns the config file that was found, if any *) val load_defaults: OpamFilename.Dir.t -> OpamFile.Config.t option (** Returns the current switch, failing with an error message is none is set. *) val get_switch: unit -> switch (** Returns the current switch, if any is set. *) val get_switch_opt: unit -> switch option (** The function used to locate an external switch from parents of the current directory. Takes the opam root as parameter, and rejects any external switch configured with a different root *) val get_current_switch_from_cwd: OpamFilename.Dir.t -> switch option (** Checks if a local switch exists and is configurade for the given root *) val local_switch_exists: OpamFilename.Dir.t -> switch -> bool (** Resolves the switch if it is a link to a global switch in the given root (return unchanged otherwise) *) val resolve_local_switch: OpamFilename.Dir.t -> switch -> switch opam-2.0.5/src/state/shellscripts/0000755000175000017500000000000013511367404016104 5ustar nicoonicooopam-2.0.5/src/state/shellscripts/env_hook.sh0000644000175000017500000000037213511367404020252 0ustar nicoonicoo_opam_env_hook() { local previous_exit_status=$?; eval $(opam env --shell=bash --readonly 2> /dev/null); return $previous_exit_status; }; if ! [[ "$PROMPT_COMMAND" =~ _opam_env_hook ]]; then PROMPT_COMMAND="_opam_env_hook;$PROMPT_COMMAND"; fi opam-2.0.5/src/state/shellscripts/env_hook.csh0000644000175000017500000000006613511367404020415 0ustar nicoonicooalias precmd 'eval `opam env --shell=csh --readonly`' opam-2.0.5/src/state/shellscripts/bwrap.sh0000755000175000017500000000726513511367404017570 0ustar nicoonicoo#!/usr/bin/env bash set -ue if ! command -v bwrap >/dev/null; then echo "The 'bwrap' command was not found. Install 'bubblewrap' on your system, or" >&2 echo "disable sandboxing in ${OPAMROOT:-~/.opam}/config at your own risk." >&2 echo "See https://github.com/projectatomic/bubblewrap for bwrap details." >&2 echo "For 'bwrap' use in opam, see the FAQ:" >&2 echo " https://opam.ocaml.org/doc/2.0/FAQ.html#Why-does-opam-require-bwrap" >&2 exit 10 fi ARGS=(--unshare-net --new-session) ARGS=("${ARGS[@]}" --proc /proc --dev /dev) ARGS=("${ARGS[@]}" --bind "${TMPDIR:-/tmp}" /tmp) ARGS=("${ARGS[@]}" --setenv TMPDIR /tmp --setenv TMP /tmp --setenv TEMPDIR /tmp --setenv TEMP /tmp) ARGS=("${ARGS[@]}" --tmpfs /run) add_mount() { case "$1" in ro) B="--ro-bind";; rw) B="--bind";; sym) B="--symlink";; esac ARGS=("${ARGS[@]}" "$B" "$2" "$3") } add_mounts() { local flag="$1"; shift for dir in "$@"; do if [ -d "$dir" ]; then add_mount "$flag" "$dir" "$dir" fi done } # Mounts the standard system paths. Maintains symlinks, to handle cases # like `/bin` -> `usr/bin`, where `/bin/../foo` resolves to `/usr/foo`, # not `/foo`. We handle symlinks here but not in `add_mounts` because # system paths are pretty much guaranteed not to accidentally escape into # off-limits directories. add_sys_mounts() { for dir in "$@"; do if [ -L "$dir" ]; then local src=$(readlink -f "$dir") add_mount sym "$src" "$dir" else add_mounts ro "$dir" fi done } # remove some unusual paths (/nix/stored and /rw/usrlocal ) # use OPAM_USER_PATH_RO variable to add them # the OPAM_USER_PATH_RO format is the same as PATH # ie: export OPAM_USER_PATH_RO=/nix/store:/rw/usrlocal add_sys_mounts /usr /bin /lib /lib32 /lib64 /etc /opt /home /var # C compilers using `ccache` will write to a shared cache directory # that remain writeable. ccache seems widespread in some Fedora systems. add_ccache_mount() { if command -v ccache > /dev/null; then CCACHE_DIR=$HOME/.ccache ccache_dir_regex='cache_dir = (.*)$' local IFS=$'\n' for f in $(ccache --print-config 2>/dev/null); do if [[ $f =~ $ccache_dir_regex ]]; then CCACHE_DIR=${BASH_REMATCH[1]} fi done add_mounts rw $CCACHE_DIR fi } # This case-switch should remain identical between the different sandbox implems COMMAND="$1"; shift case "$COMMAND" in build) # mount unusual path in ro if [ -n "${OPAM_USER_PATH_RO-}" ]; then add_mounts ro $(echo ${OPAM_USER_PATH_RO} | sed 's|:| |g') fi add_mounts ro "$OPAM_SWITCH_PREFIX" add_mounts rw "$PWD" add_ccache_mount ;; install) # mount unusual path in ro if [ -n "${OPAM_USER_PATH_RO-}" ]; then add_mounts ro $(echo ${OPAM_USER_PATH_RO} | sed 's|:| |g') fi add_mounts rw "$OPAM_SWITCH_PREFIX" add_mounts ro "$OPAM_SWITCH_PREFIX/.opam-switch" add_mounts rw "$PWD" ;; remove) # mount unusual path in ro if [ -n "${OPAM_USER_PATH_RO-}" ]; then add_mounts ro $(echo ${OPAM_USER_PATH_RO} | sed 's|:| |g') fi add_mounts rw "$OPAM_SWITCH_PREFIX" add_mounts ro "$OPAM_SWITCH_PREFIX/.opam-switch" if [ "X${PWD#$OPAM_SWITCH_PREFIX}/.opam-switch/" != "X${PWD}" ]; then add_mounts rw "$PWD" fi ;; *) echo "$0: unknown command $COMMAND, must be one of 'build', 'install' or 'remove'" >&2 exit 2 esac # Note: we assume $1 can be trusted, see https://github.com/projectatomic/bubblewrap/issues/259 exec bwrap "${ARGS[@]}" "$@" opam-2.0.5/src/state/shellscripts/complete.zsh0000644000175000017500000001627413511367404020454 0ustar nicoonicoo#compdef opam if [ -z "$ZSH_VERSION" ]; then return 0; fi _opam_add() { IFS=$'\n' _opam_reply+=("$@") } _opam_add_f() { local cmd cmd=$1; shift _opam_add "$($cmd "$@" 2>/dev/null)" } _opam_flags() { opam "$@" --help=groff 2>/dev/null | \ sed -n \ -e 's%\\-\|\\N'"'45'"'%-%g' \ -e 's%, \\fB%\n\\fB%g' \ -e '/^\\fB-/p' | \ sed -e 's%^\\fB\(-[^\\]*\).*%\1%' } _opam_commands() { opam "$@" --help=groff 2>/dev/null | \ sed -n \ -e 's%\\-\|\\N'"'45'"'%-%g' \ -e '/^\.SH COMMANDS$/,/^\.SH/ s%^\\fB\([^,= ]*\)\\fR.*%\1%p' echo '--help' } _opam_vars() { opam config list --safe 2>/dev/null | \ sed -n \ -e '/^PKG:/d' \ -e 's%^\([^#= ][^ ]*\).*%\1%p' } _opam_argtype() { local cmd flag cmd="$1"; shift flag="$1"; shift case "$flag" in -*) opam "$cmd" --help=groff 2>/dev/null | \ sed -n \ -e 's%\\-\|\\N'"'45'"'%-%g' \ -e 's%.*\\fB'"$flag"'\\fR[= ]\\fI\([^, ]*\)\\fR.*%\1%p' ;; esac } _opam() { local IFS cmd subcmd cur prev compgen_opt COMPREPLY=() cmd=${COMP_WORDS[1]} subcmd=${COMP_WORDS[2]} cur=${COMP_WORDS[COMP_CWORD]} prev=${COMP_WORDS[COMP_CWORD-1]} compgen_opt=() _opam_reply=() if [ $COMP_CWORD -eq 1 ]; then _opam_add_f opam help topics COMPREPLY=( $(compgen -W "${_opam_reply[*]}" -- $cur) ) unset _opam_reply return 0 fi case "$(_opam_argtype $cmd $prev)" in LEVEL|JOBS|RANK) _opam_add 1 2 3 4 5 6 7 8 9;; FILE|FILENAME) compgen_opt+=(-o filenames -f);; DIR|ROOT) compgen_opt+=(-o filenames -d);; MAKE|CMD) compgen_opt+=(-c);; KIND) _opam_add http local git darcs hg;; WHEN) _opam_add always never auto;; SWITCH|SWITCHES) _opam_add_f opam switch list --safe -s;; COLUMNS|FIELDS) _opam_add name version package synopsis synopsis-or-target \ description installed-version pin source-hash \ opam-file all-installed-versions available-versions \ all-versions repository installed-files vc-ref depexts;; PACKAGE|PACKAGES|PKG|PATTERN|PATTERNS) _opam_add_f opam list --safe -A -s;; FLAG) _opam_add light-uninstall verbose plugin compiler conf;; REPOS) _opam_add_f opam repository list --safe -s -a;; SHELL) _opam_add bash sh csh zsh fish;; TAGS) ;; CRITERIA) ;; STRING) ;; URL) compgen_opt+=(-o filenames -d) _opam_add "https://" "http://" "file://" \ "git://" "git+file://" "git+ssh://" "git+https://" \ "hg+file://" "hg+ssh://" "hg+https://" \ "darcs+file://" "darcs+ssh://" "darcs+https://";; "") case "$cmd" in install|show|info|inst|ins|in|i|inf|sh) _opam_add_f opam list --safe -a -s if [ $COMP_CWORD -gt 2 ]; then _opam_add_f _opam_flags "$cmd" fi;; reinstall|remove|uninstall|reinst|remov|uninst|unins) _opam_add_f opam list --safe -i -s if [ $COMP_CWORD -gt 2 ]; then _opam_add_f _opam_flags "$cmd" fi;; upgrade|upg) _opam_add_f opam list --safe -i -s _opam_add_f _opam_flags "$cmd" ;; switch|sw) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd" _opam_add_f opam switch list --safe -s;; 3) case "$subcmd" in create|install) _opam_add_f opam switch list-available --safe -s -a;; set|remove|reinstall) _opam_add_f opam switch list --safe -s;; import|export) compgen_opt+=(-o filenames -f);; *) _opam_add_f _opam_flags "$cmd" esac;; *) _opam_add_f _opam_flags "$cmd" esac;; config|conf|c) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd";; 3) case "$subcmd" in var) _opam_add_f _opam_vars;; exec) compgen_opt+=(-c);; *) _opam_add_f _opam_flags "$cmd" esac;; *) _opam_add_f _opam_flags "$cmd" esac;; repository|remote|repos|repo) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd";; 3) case "$subcmd" in list) _opam_add_f _opam_flags "$cmd";; *) _opam_add_f opam repository list --safe -a -s esac;; *) _opam_add_f _opam_flags "$cmd" case "$subcmd" in set-url|add) compgen_opt+=(-o filenames -f);; set-repos) _opam_add_f opam repository list --safe -a -s;; esac;; esac;; update|upd) _opam_add_f opam repository list --safe -s _opam_add_f opam pin list --safe -s _opam_add_f _opam_flags "$cmd" ;; source|so) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f opam list --safe -A -s else _opam_add_f _opam_flags "$cmd" fi;; pin) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd";; 3) case "$subcmd" in add) compgen_opt+=(-o filenames -d) _opam_add_f opam list --safe -A -s;; remove|edit) _opam_add_f opam pin list --safe -s;; *) _opam_add_f _opam_flags "$cmd" esac;; *) case "$subcmd" in add) compgen_opt+=(-o filenames -d);; *) _opam_add_f _opam_flags "$cmd" esac esac;; unpin) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f opam pin list --safe -s else _opam_add_f _opam_flags "$cmd" fi;; var|v) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f _opam_vars else _opam_add_f _opam_flags "$cmd"; fi;; exec|e) if [ $COMP_CWORD -eq 2 ]; then compgen_opt+=(-c) else _opam_add_f _opam_flags "$cmd"; fi;; lint|build) if [ $COMP_CWORD -eq 2 ]; then compgen_opt+=(-f -X '!*opam' -o plusdirs) else _opam_add_f _opam_flags "$cmd"; fi;; admin) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f _opam_commands "$cmd" else _opam_add_f _opam_flags "$cmd" "$subcmd"; fi;; *) _opam_add_f _opam_commands "$cmd" _opam_add_f _opam_flags "$cmd" esac;; esac COMPREPLY=($(compgen -W "${_opam_reply[*]}" "${compgen_opt[@]}" -- "$cur")) unset _opam_reply return 0 } autoload bashcompinit bashcompinit complete -F _opam opam opam-2.0.5/src/state/shellscripts/prompt.sh0000644000175000017500000000122513511367404017761 0ustar nicoonicoo# This script allows you to see the active opam switch in your prompt. It # should be portable across all shells in common use. # # To enable, change your PS1 to call _opam_ps1 using command substitution. For # example, in bash: # # PS1="$(__opam_ps1 "(%s)")\u@\h:\w\$ " # __opam_ps1() { local exit=$? local printf_format='(%s)' case "$#" in 0|1) printf_format="${1:-$printf_format}" ;; *) return $exit ;; esac local switch_name="$(opam switch show --safe 2>/dev/null)" if [ -z "$switch_name" ]; then return $exit fi printf -- "$printf_format" "$switch_name" return $exit } opam-2.0.5/src/state/shellscripts/env_hook.zsh0000644000175000017500000000031713511367404020443 0ustar nicoonicoo_opam_env_hook() { eval $(opam env --shell=zsh --readonly 2> /dev/null); } typeset -ag precmd_functions; if [[ -z ${precmd_functions[(r)_opam_env_hook]} ]]; then precmd_functions+=_opam_env_hook; fi opam-2.0.5/src/state/shellscripts/complete.sh0000644000175000017500000001621313511367404020253 0ustar nicoonicooif [ -z "$BASH_VERSION" ]; then return 0; fi _opam_add() { IFS=$'\n' _opam_reply+=("$@") } _opam_add_f() { local cmd cmd=$1; shift _opam_add "$($cmd "$@" 2>/dev/null)" } _opam_flags() { opam "$@" --help=groff 2>/dev/null | \ sed -n \ -e 's%\\-\|\\N'"'45'"'%-%g' \ -e 's%, \\fB%\n\\fB%g' \ -e '/^\\fB-/p' | \ sed -e 's%^\\fB\(-[^\\]*\).*%\1%' } _opam_commands() { opam "$@" --help=groff 2>/dev/null | \ sed -n \ -e 's%\\-\|\\N'"'45'"'%-%g' \ -e '/^\.SH COMMANDS$/,/^\.SH/ s%^\\fB\([^,= ]*\)\\fR.*%\1%p' echo '--help' } _opam_vars() { opam config list --safe 2>/dev/null | \ sed -n \ -e '/^PKG:/d' \ -e 's%^\([^#= ][^ ]*\).*%\1%p' } _opam_argtype() { local cmd flag cmd="$1"; shift flag="$1"; shift case "$flag" in -*) opam "$cmd" --help=groff 2>/dev/null | \ sed -n \ -e 's%\\-\|\\N'"'45'"'%-%g' \ -e 's%.*\\fB'"$flag"'\\fR[= ]\\fI\([^, ]*\)\\fR.*%\1%p' ;; esac } _opam() { local IFS cmd subcmd cur prev compgen_opt COMPREPLY=() cmd=${COMP_WORDS[1]} subcmd=${COMP_WORDS[2]} cur=${COMP_WORDS[COMP_CWORD]} prev=${COMP_WORDS[COMP_CWORD-1]} compgen_opt=() _opam_reply=() if [ $COMP_CWORD -eq 1 ]; then _opam_add_f opam help topics COMPREPLY=( $(compgen -W "${_opam_reply[*]}" -- $cur) ) unset _opam_reply return 0 fi case "$(_opam_argtype $cmd $prev)" in LEVEL|JOBS|RANK) _opam_add 1 2 3 4 5 6 7 8 9;; FILE|FILENAME) compgen_opt+=(-o filenames -f);; DIR|ROOT) compgen_opt+=(-o filenames -d);; MAKE|CMD) compgen_opt+=(-c);; KIND) _opam_add http local git darcs hg;; WHEN) _opam_add always never auto;; SWITCH|SWITCHES) _opam_add_f opam switch list --safe -s;; COLUMNS|FIELDS) _opam_add name version package synopsis synopsis-or-target \ description installed-version pin source-hash \ opam-file all-installed-versions available-versions \ all-versions repository installed-files vc-ref depexts;; PACKAGE|PACKAGES|PKG|PATTERN|PATTERNS) _opam_add_f opam list --safe -A -s;; FLAG) _opam_add light-uninstall verbose plugin compiler conf;; REPOS) _opam_add_f opam repository list --safe -s -a;; SHELL) _opam_add bash sh csh zsh fish;; TAGS) ;; CRITERIA) ;; STRING) ;; URL) compgen_opt+=(-o filenames -d) _opam_add "https://" "http://" "file://" \ "git://" "git+file://" "git+ssh://" "git+https://" \ "hg+file://" "hg+ssh://" "hg+https://" \ "darcs+file://" "darcs+ssh://" "darcs+https://";; "") case "$cmd" in install|show|info|inst|ins|in|i|inf|sh) _opam_add_f opam list --safe -a -s if [ $COMP_CWORD -gt 2 ]; then _opam_add_f _opam_flags "$cmd" fi;; reinstall|remove|uninstall|reinst|remov|uninst|unins) _opam_add_f opam list --safe -i -s if [ $COMP_CWORD -gt 2 ]; then _opam_add_f _opam_flags "$cmd" fi;; upgrade|upg) _opam_add_f opam list --safe -i -s _opam_add_f _opam_flags "$cmd" ;; switch|sw) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd" _opam_add_f opam switch list --safe -s;; 3) case "$subcmd" in create|install) _opam_add_f opam switch list-available --safe -s -a;; set|remove|reinstall) _opam_add_f opam switch list --safe -s;; import|export) compgen_opt+=(-o filenames -f);; *) _opam_add_f _opam_flags "$cmd" esac;; *) _opam_add_f _opam_flags "$cmd" esac;; config|conf|c) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd";; 3) case "$subcmd" in var) _opam_add_f _opam_vars;; exec) compgen_opt+=(-c);; *) _opam_add_f _opam_flags "$cmd" esac;; *) _opam_add_f _opam_flags "$cmd" esac;; repository|remote|repos|repo) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd";; 3) case "$subcmd" in list) _opam_add_f _opam_flags "$cmd";; *) _opam_add_f opam repository list --safe -a -s esac;; *) _opam_add_f _opam_flags "$cmd" case "$subcmd" in set-url|add) compgen_opt+=(-o filenames -f);; set-repos) _opam_add_f opam repository list --safe -a -s;; esac;; esac;; update|upd) _opam_add_f opam repository list --safe -s _opam_add_f opam pin list --safe -s _opam_add_f _opam_flags "$cmd" ;; source|so) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f opam list --safe -A -s else _opam_add_f _opam_flags "$cmd" fi;; pin) case $COMP_CWORD in 2) _opam_add_f _opam_commands "$cmd";; 3) case "$subcmd" in add) compgen_opt+=(-o filenames -d) _opam_add_f opam list --safe -A -s;; remove|edit) _opam_add_f opam pin list --safe -s;; *) _opam_add_f _opam_flags "$cmd" esac;; *) case "$subcmd" in add) compgen_opt+=(-o filenames -d);; *) _opam_add_f _opam_flags "$cmd" esac esac;; unpin) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f opam pin list --safe -s else _opam_add_f _opam_flags "$cmd" fi;; var|v) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f _opam_vars else _opam_add_f _opam_flags "$cmd"; fi;; exec|e) if [ $COMP_CWORD -eq 2 ]; then compgen_opt+=(-c) else _opam_add_f _opam_flags "$cmd"; fi;; lint|build) if [ $COMP_CWORD -eq 2 ]; then compgen_opt+=(-f -X '!*opam' -o plusdirs) else _opam_add_f _opam_flags "$cmd"; fi;; admin) if [ $COMP_CWORD -eq 2 ]; then _opam_add_f _opam_commands "$cmd" else _opam_add_f _opam_flags "$cmd" "$subcmd"; fi;; *) _opam_add_f _opam_commands "$cmd" _opam_add_f _opam_flags "$cmd" esac;; esac COMPREPLY=($(compgen -W "${_opam_reply[*]}" "${compgen_opt[@]}" -- "$cur")) unset _opam_reply return 0 } complete -F _opam opam opam-2.0.5/src/state/shellscripts/sandbox_exec.sh0000644000175000017500000000423513511367404021106 0ustar nicoonicoo#!/usr/bin/env bash set -ue POL='(version 1)(allow default)(deny network*)(deny file-write*)' POL="$POL"'(allow network* (remote unix))' POL="$POL"'(allow file-write* (literal "/dev/null") (literal "/dev/dtracehelper"))' add_mounts() { local DIR="$(cd "$2" && pwd -P)" case "$1" in ro) POL="$POL"'(deny file-write* (subpath "'"$DIR"'"))';; rw) POL="$POL"'(allow file-write* (subpath "'"$DIR"'"))';; esac } if [ -z ${TMPDIR+x} ]; then # If $TMPDIR is not set, some applications use /tmp, so # /tmp must be made readable/writable add_mounts rw /tmp # However, others applications obtain the per-user temporary # directory differently; the latter should be made readable/writable # too and getconf seems to be a robust way to get it if [ -z /usr/bin/getconf ]; then TMP=`getconf DARWIN_USER_TEMP_DIR` add_mounts rw $TMP fi else add_mounts rw $TMPDIR fi # C compilers using `ccache` will write to a shared cache directory # that remain writeable. ccache seems widespread in some Fedora systems. add_ccache_mount() { if command -v ccache > /dev/null; then CCACHE_DIR=$HOME/.ccache ccache_dir_regex='cache_dir = (.*)$' local IFS=$'\n' for f in $(ccache --print-config 2>/dev/null); do if [[ $f =~ $ccache_dir_regex ]]; then CCACHE_DIR=${BASH_REMATCH[1]} fi done add_mounts rw $CCACHE_DIR fi } # This case-switch should remain identical between the different sandbox implems COMMAND="$1"; shift case "$COMMAND" in build) add_mounts ro "$OPAM_SWITCH_PREFIX" add_mounts rw "$PWD" add_ccache_mount ;; install) add_mounts rw "$OPAM_SWITCH_PREFIX" add_mounts ro "$OPAM_SWITCH_PREFIX/.opam-switch" add_mounts rw "$PWD" ;; remove) add_mounts rw "$OPAM_SWITCH_PREFIX" add_mounts ro "$OPAM_SWITCH_PREFIX/.opam-switch" if [ "X${PWD#$OPAM_SWITCH_PREFIX/.opam-switch}" != "X${PWD}" ]; then add_mounts rw "$PWD" fi ;; *) echo "$0: unknown command $COMMAND, must be one of 'build', 'install' or 'remove'" >&2 exit 2 esac exec sandbox-exec -p "$POL" "$@" opam-2.0.5/src/state/shellscripts/env_hook.fish0000644000175000017500000000016513511367404020571 0ustar nicoonicoofunction __opam_env_export_eval --on-event fish_prompt; eval (opam env --shell=fish --readonly ^ /dev/null); end opam-2.0.5/src/state/opamGlobalState.ml0000644000175000017500000001552013511367404017000 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStd.Op open OpamFilename.Op open OpamStateTypes let log fmt = OpamConsole.log "GSTATE" fmt let slog = OpamConsole.slog let load_config global_lock root = let config = match OpamStateConfig.load root with | Some c -> c | None -> if OpamFilename.exists (root // "aliases") then OpamFile.Config.(with_opam_version (OpamVersion.of_string "1.1") empty) else OpamConsole.error_and_exit `Configuration_error "%s exists, but does not appear to be a valid opam root. Please \ remove it and use `opam init', or specify a different `--root' \ argument" (OpamFilename.Dir.to_string root) in OpamFormatUpgrade.as_necessary global_lock root config; config let inferred_from_system = "Inferred from system" let load lock_kind = let root = OpamStateConfig.(!r.root_dir) in log "LOAD-GLOBAL-STATE @ %a" (slog OpamFilename.Dir.to_string) root; (* Always take a global read lock, this is only used to prevent concurrent ~/.opam format changes *) let has_root = OpamFilename.exists_dir root in let global_lock = if has_root then OpamFilename.flock `Lock_read (OpamPath.lock root) else OpamSystem.lock_none in (* The global_state lock actually concerns the global config file only (and the consistence thereof with the repository and switch sets, and the currently installed shell init scripts) *) if not has_root then OpamConsole.error_and_exit `Configuration_error "Opam has not been initialised, please run `opam init'"; let config_lock = OpamFilename.flock lock_kind (OpamPath.config_lock root) in let config = load_config global_lock root in let switches = List.filter (fun sw -> not (OpamSwitch.is_external sw) || OpamFilename.exists_dir (OpamSwitch.get_root root sw)) (OpamFile.Config.installed_switches config) in let config = OpamFile.Config.with_installed_switches switches config in let global_variables = List.fold_left (fun acc (v,value) -> OpamVariable.Map.add v (lazy (Some (OpamStd.Option.default (S "unknown") (Lazy.force value))), (* Careful on changing it, it is used to determine user defined variables on `config report`. See [OpamConfigCommand.help]. *) inferred_from_system) acc) OpamVariable.Map.empty (OpamSysPoll.variables) in let global_variables = List.fold_left (fun acc (v,value,doc) -> OpamVariable.Map.add v (lazy (Some value), doc) acc) global_variables (OpamFile.Config.global_variables config) in let eval_variables = OpamFile.Config.eval_variables config in let global_variables = let env = lazy (OpamEnv.get_pure () |> OpamTypesBase.env_array) in List.fold_left (fun acc (v, cmd, doc) -> OpamVariable.Map.update v (fun previous_value -> (lazy (try let ret = OpamSystem.read_command_output ~env:(Lazy.force env) ~allow_stdin:false cmd in Some (S (OpamStd.String.strip (String.concat "\n" ret))) with e -> OpamStd.Exn.fatal e; log "Failed to evaluate global variable %a: %a" (slog OpamVariable.to_string) v (slog Printexc.to_string) e; Lazy.force (fst previous_value))), doc) (lazy None, "") acc) global_variables eval_variables in { global_lock = config_lock; root; config; global_variables; } let switches gt = OpamFile.Config.installed_switches gt.config let fold_switches f gt acc = List.fold_left (fun acc switch -> f switch (OpamFile.SwitchSelections.safe_read (OpamPath.Switch.selections gt.root switch)) acc ) acc (OpamFile.Config.installed_switches gt.config) let switch_exists gt switch = if OpamSwitch.is_external switch then OpamStateConfig.local_switch_exists gt.root switch else List.mem switch (switches gt) let all_installed gt = fold_switches (fun _ sel acc -> OpamPackage.Set.union acc sel.sel_installed) gt OpamPackage.Set.empty let installed_versions gt name = fold_switches (fun switch sel acc -> let installed = OpamPackage.packages_of_name sel.sel_installed name in try let nv = OpamPackage.Set.choose installed in try OpamPackage.Map.add nv (switch::OpamPackage.Map.find nv acc) acc with Not_found -> OpamPackage.Map.add nv [switch] acc with Not_found -> acc) gt OpamPackage.Map.empty let repos_list gt = OpamFile.Config.repositories gt.config let unlock gt = OpamSystem.funlock gt.global_lock; (gt :> unlocked global_state) let with_write_lock ?dontblock gt f = let ret, gt = OpamFilename.with_flock_upgrade `Lock_write ?dontblock gt.global_lock @@ fun _ -> f ({ gt with global_lock = gt.global_lock } : rw global_state) (* We don't actually change the field value, but this makes restricting the phantom lock type possible*) in ret, { gt with global_lock = gt.global_lock } let with_ lock f = let gt = load lock in try let r = f gt in ignore (unlock gt); r with e -> OpamStd.Exn.finalise e (fun () -> ignore (unlock gt)) let write gt = OpamFile.Config.write (OpamPath.config gt.root) gt.config let fix_switch_list gt = let known_switches0 = switches gt in let known_switches = match OpamStateConfig.get_switch_opt () with | None -> known_switches0 | Some sw -> if List.mem sw known_switches0 || not (switch_exists gt sw) then known_switches0 else sw::known_switches0 in let known_switches = List.filter (switch_exists gt) known_switches in if known_switches = known_switches0 then gt else let config = OpamFile.Config.with_installed_switches known_switches gt.config in let gt = { gt with config } in if not OpamCoreConfig.(!r.safe_mode) then try snd @@ with_write_lock ~dontblock:true gt @@ fun gt -> write gt, gt with OpamSystem.Locked -> gt else gt opam-2.0.5/src/state/opamPinned.mli0000644000175000017500000000461613511367404016171 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Specific query and handling of pinned packages *) open OpamTypes open OpamStateTypes (** Returns the version the package is pinned to. @raise Not_found when appropriate *) val version: 'a switch_state -> name -> version (** Returns the package with the pinned-to version from a pinned package name. @raise Not_found when appropriate *) val package: 'a switch_state -> name -> package (** Returns the package with the pinned-to version from a package name, if pinned *) val package_opt: 'a switch_state -> name -> package option (** The set of all pinned packages with their pinning versions *) val packages: 'a switch_state -> package_set (** Looks up an 'opam' file for the given named package in a source directory. This is affected by [OpamStateConfig.(!r.locked)]. *) val find_opam_file_in_source: name -> dirname -> OpamFile.OPAM.t OpamFile.t option (** Finds all package definition files in a given source dir [opam], [pkgname.opam/opam], etc. This is affected by [OpamStateConfig.(!r.locked)] *) val files_in_source: dirname -> (name option * OpamFile.OPAM.t OpamFile.t) list (** From an opam file location, sitting below the given project directory, find the corresponding package name if specified ([.opam] or [.opam/opam]). This function doesn't check the project directory name itself, or the package name that might be specified within the file. *) val name_of_opam_filename: dirname -> filename -> name option (** Finds back the location of the opam file this package definition was loaded from *) val orig_opam_file: OpamPackage.Name.t -> OpamFile.OPAM.t -> OpamFile.OPAM.t OpamFile.t option opam-2.0.5/src/state/opamPackageVar.ml0000644000175000017500000003012613511367404016602 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamStd.Op open OpamTypes open OpamStateTypes (* Lists of defined variables, for documentation *) let global_variable_names = [ "opam-version", "The currently running opam version"; "switch", "The identifier of the current switch"; "jobs", "The number of parallel jobs set up in opam \ configuration"; "root", "The current opam root directory"; "make", "The 'make' command to use"; ] let package_variable_names = [ "name", "Name of the package"; "version", "Version of the package"; "depends", "Resolved direct dependencies of the package"; "installed", "Whether the package is installed"; "enable", "Takes the value \"enable\" or \"disable\" depending on whether \ the package is installed"; "pinned", "Whether the package is pinned"; "bin", "Binary directory for this package"; "sbin", "System binary directory for this package"; "lib", "Library directory for this package"; "man", "Man directory for this package"; "doc", "Doc directory for this package"; "share", "Share directory for this package"; "etc", "Etc directory for this package"; "build", "Directory where the package was built"; "hash", "Hash of the package archive"; "dev", "True if this is a development package"; "build-id", "A hash identifying the precise package version with all its \ dependencies"; ] let predefined_depends_variables = List.map OpamVariable.Full.of_string [ "build"; "post"; "with-test"; "with-doc"; "dev"; ] let resolve_global gt full_var = let module V = OpamVariable in if V.Full.(scope full_var <> Global) then None else let var = V.Full.variable full_var in match V.Full.read_from_env full_var with | Some _ as c -> c | None -> match OpamVariable.Map.find_opt var gt.global_variables with | Some (lazy (Some _ as some), _) -> some | _ -> match V.to_string var with | "opam-version" -> Some (V.string OpamVersion.(to_string current)) | "jobs" -> Some (V.int (OpamStateConfig.(Lazy.force !r.jobs))) | "root" -> Some (V.string (OpamFilename.Dir.to_string gt.root)) | "make" -> Some (V.string OpamStateConfig.(Lazy.force !r.makecmd)) | _ -> None (** Resolve switch-global variables only, as allowed by the 'available:' field *) let resolve_switch_raw ?package gt switch switch_config full_var = let module V = OpamVariable in let var = V.Full.variable full_var in let allowed_package_variables = match V.Full.scope full_var, package with | _, None -> None | V.Full.Package n, Some nv when n <> nv.name -> None | _, Some nv -> match V.to_string var with | "name" -> Some (S (OpamPackage.Name.to_string nv.name)) | "version" -> Some (S (OpamPackage.Version.to_string nv.version)) | _ -> None in if allowed_package_variables <> None then allowed_package_variables else if V.Full.scope full_var <> V.Full.Global then None else match V.Full.read_from_env full_var with | Some _ as c -> c | None -> try let stdpath = OpamTypesBase.std_path_of_string (V.to_string var) in let dir = OpamPath.Switch.get_stdpath gt.root switch switch_config stdpath in Some (V.string (OpamFilename.Dir.to_string dir)) with Failure _ -> match OpamFile.Switch_config.variable switch_config var with | Some _ as c -> c | None -> match resolve_global gt full_var with | Some _ as c -> c | None -> match V.to_string var with | "switch" -> Some (V.string (OpamSwitch.to_string switch)) | _ -> None let resolve_switch ?package st full_var = resolve_switch_raw ?package st.switch_global st.switch st.switch_config full_var open OpamVariable let is_dev_package st opam = match OpamFile.OPAM.url opam with | None -> false | Some urlf -> match OpamFile.URL.(url urlf, checksum urlf) with | { OpamUrl.backend = `http; _ }, _ when not (OpamPackage.Set.mem (OpamFile.OPAM.package opam) st.pinned) -> false | _, _::_ -> false | _, [] -> true let filter_depends_formula ?(build=true) ?(post=false) ?(test=OpamStateConfig.(!r.build_test)) ?(doc=OpamStateConfig.(!r.build_doc)) ?(dev=false) ?default ~env ff = ff |> OpamFilter.partial_filter_formula (fun v -> if List.mem v predefined_depends_variables then None else env v) |> OpamFilter.filter_deps ~build ~post ~test ~doc ~dev ?default let all_depends ?build ?post ?test ?doc ?dev ?(filter_default=false) ?(depopts=true) st opam = let dev = match dev with None -> is_dev_package st opam | Some d -> d in let deps = OpamFormula.ands (OpamFile.OPAM.depends opam :: if depopts then [OpamFile.OPAM.depopts opam] else []) in filter_depends_formula ?build ?post ?test ?doc ~dev ~default:filter_default ~env:(resolve_switch ~package:(OpamFile.OPAM.package opam) st) deps let all_installed_deps st opam = let deps = OpamFormula.atoms (all_depends ~post:false st opam) in OpamStd.List.filter_map (fun (n,cstr) -> try let nv = OpamPackage.Set.find (fun nv -> nv.name = n) st.installed in let version = nv.version in match cstr with | None -> Some nv | Some (op,v) when OpamFormula.eval_relop op version v -> Some nv | Some _ -> None with Not_found -> None) deps let build_id st opam = let kind = `SHA256 in let rec aux hash_map nv opam = try hash_map, OpamPackage.Map.find nv hash_map with Not_found -> match OpamFile.OPAM.url opam with | Some urlf when OpamFile.URL.checksum urlf = [] -> (* no fixed source: build-id undefined *) raise Exit | _ -> let hash_map, deps_hashes = List.fold_left (fun (hash_map, hashes) nv -> let hash_map, hash = aux hash_map nv (OpamPackage.Map.find nv st.opams) in hash_map, hash::hashes) (hash_map, []) (List.sort (fun a b -> - OpamPackage.compare a b) (all_installed_deps st opam)) in let opam_hash = OpamHash.compute_from_string ~kind (OpamFile.OPAM.write_to_string (OpamFile.OPAM.effective_part opam)) in let hash = OpamHash.compute_from_string ~kind (OpamStd.List.concat_map " " OpamHash.contents (opam_hash :: deps_hashes)) in OpamPackage.Map.add nv hash hash_map, hash in try let _hash_map, hash = aux OpamPackage.Map.empty (OpamFile.OPAM.package opam) opam in Some (OpamHash.contents hash) with Exit -> None (* filter handling *) let resolve st ?opam:opam_arg ?(local=OpamVariable.Map.empty) v = let dirname dir = string (OpamFilename.Dir.to_string dir) in let pkgname = OpamStd.Option.map OpamFile.OPAM.name opam_arg in let read_package_var v = let get name = try let cfg = OpamPackage.Map.find (OpamPackage.package_of_name st.installed name) st.conf_files in OpamFile.Dot_config.variable cfg (OpamVariable.Full.variable v) with Not_found -> None in match OpamVariable.Full.scope v with | OpamVariable.Full.Global -> None | OpamVariable.Full.Package n -> get n | OpamVariable.Full.Self -> OpamStd.Option.Op.(pkgname >>= get) in let get_local_var v = match OpamVariable.Full.package v with | Some _ -> None | None -> let var = OpamVariable.Full.variable v in try match OpamVariable.Map.find var local with | None -> raise Exit (* Variable explicitly undefined *) | some -> some with Not_found -> None in let get_package_var v = if OpamVariable.Full.is_global v then None else let var_str = OpamVariable.to_string (OpamVariable.Full.variable v) in let name = match OpamVariable.Full.scope v with | OpamVariable.Full.Global -> assert false | OpamVariable.Full.Package n -> n | OpamVariable.Full.Self -> match pkgname with Some n -> n | None -> raise Exit in let opam = (* ensure opam, if not None, corresponds to name *) match opam_arg with | Some o when OpamFile.OPAM.name o = name -> opam_arg | _ -> try let nv = OpamPackage.package_of_name st.installed name in Some (OpamPackage.Map.find nv st.opams) with Not_found -> None in let get_nv opam = OpamPackage.create name (OpamFile.OPAM.version opam) in let root = st.switch_global.root in match var_str, opam with | "installed", Some _ -> Some (bool (OpamPackage.has_name st.installed name)) | "installed", None -> Some (bool false) | "pinned", _ -> Some (bool (OpamPackage.has_name st.pinned name)) | "name", _ -> if OpamPackage.has_name st.packages name then Some (string (OpamPackage.Name.to_string name)) else None | _, None -> None | "bin", _ -> Some (dirname (OpamPath.Switch.bin root st.switch st.switch_config)) | "sbin", _ -> Some (dirname (OpamPath.Switch.sbin root st.switch st.switch_config)) | "lib", _ -> Some (dirname (OpamPath.Switch.lib root st.switch st.switch_config name)) | "man", _ -> Some (dirname (OpamPath.Switch.man_dir root st.switch st.switch_config)) | "doc", _ -> Some (dirname (OpamPath.Switch.doc root st.switch st.switch_config name)) | "share", _ -> Some (dirname (OpamPath.Switch.share root st.switch st.switch_config name)) | "etc", _ -> Some (dirname (OpamPath.Switch.etc root st.switch st.switch_config name)) | "build", Some opam -> Some (dirname (OpamPath.Switch.build root st.switch (get_nv opam))) | "version", Some opam -> Some (string (OpamPackage.Version.to_string (OpamFile.OPAM.version opam))) | "depends", Some opam -> let installed_deps = all_installed_deps st opam in let str_deps = OpamStd.List.concat_map " " OpamPackage.to_string installed_deps in Some (string str_deps) | "hash", Some opam -> (try let nv = get_nv opam in let f = OpamPath.archive root nv in if OpamFilename.exists f then Some (string (OpamHash.to_string (OpamHash.compute ~kind:`MD5 (OpamFilename.to_string f)))) else Some (string "") with Not_found -> Some (string "")) | "dev", Some opam -> Some (bool (is_dev_package st opam)) | "build-id", Some opam -> OpamStd.Option.map string (build_id st opam) | _, _ -> None in let make_package_local v = (* [var] within the opam file of [pkg] is tried as [pkg:var] *) match OpamVariable.Full.is_global v, pkgname with | true, Some name -> OpamVariable.Full.create name (OpamVariable.Full.variable v) | _ -> v in let skip _ = None in let v' = make_package_local v in let contents = try List.fold_left (function None -> (fun (f,v) -> f v) | r -> (fun _ -> r)) None [ get_local_var, v; Full.read_from_env, v; (if v' <> v then Full.read_from_env else skip), v'; read_package_var, v; resolve_switch st, v; (if v' <> v then read_package_var else skip), v'; get_package_var, v'; ] with Exit -> None in contents opam-2.0.5/src/state/opamSwitchAction.mli0000644000175000017500000000655713511367404017361 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Switch-related actions and changes *) open OpamTypes open OpamStateTypes (** Initialises a new switch with the given name in the given opam root, registers it in the global config and returns the updated global state *) val create_empty_switch: rw global_state -> ?synopsis:string -> ?repos:repository_name list -> switch -> rw global_state (** Writes the current state file to disk (installed, pinned, root packages etc.). Unless [OpamStateConfig.(!r.dryrun)] *) val write_selections: rw switch_state -> unit (** Updates the defined default switch and loads its state; fails and exits with a message if the switch is external *) val set_current_switch: 'a lock -> rw global_state -> ?rt:'b repos_state -> switch -> 'a switch_state (** Create the default global_config structure for a switch, including default prefix *) val gen_switch_config: dirname -> ?synopsis:string -> ?repos:repository_name list -> switch -> OpamFile.Switch_config.t (** (Re-)install the configuration for a given root and switch *) val install_switch_config: dirname -> switch -> OpamFile.Switch_config.t -> unit (** Add the package metadata to the switch-local cache of installed packages *) val install_metadata: rw switch_state -> package -> unit (** Remove the metadata of the package from the switch-local cache of installed packages *) val remove_metadata: rw switch_state -> package_set -> unit (** Update the on-disk set of packages marked to reinstall on the current switch (excepting compiler packages, and pinned packages if [unpinned_only] is set) *) val add_to_reinstall: rw switch_state -> unpinned_only:bool -> package_set -> rw switch_state (** Updates the package selections and switch config to take into account the given newly installed package. The updated state is written to disk unless [OpamStateConfig.(!r.dry_run)] and returned. *) val add_to_installed: rw switch_state -> ?root:bool -> package -> rw switch_state (** Updates the package selections and switch config to take into account the removed package. The updated state is written to disk unless [OpamStateConfig.(!r.dry_run)], and returned. If [keep_as_root], the package isn't removed from the switch state [installed_roots] set. *) val remove_from_installed: ?keep_as_root:bool -> rw switch_state -> package -> rw switch_state (** Update the switch selections with the supplied optional arguments. Changes are written to disk and returned *) val update_switch_state: ?installed: package_set -> ?installed_roots: package_set -> ?reinstall: package_set -> ?pinned: package_set -> rw switch_state -> rw switch_state opam-2.0.5/src/state/opamScript.mli0000644000175000017500000000202313511367404016206 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** (generated) Shell config scripts as OCaml strings *) val complete : string val complete_zsh : string val prompt : string val bwrap : string val sandbox_exec : string val env_hook : string val env_hook_zsh : string val env_hook_csh : string val env_hook_fish : string opam-2.0.5/src/state/opamSysPoll.mli0000644000175000017500000000275713511367404016365 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** This module polls various aspects of the host, to define the [arch], [os], etc. variables *) val arch: unit -> string option val os: unit -> string option val os_distribution: unit -> string option val os_version: unit -> string option val os_family: unit -> string option val variables: (OpamVariable.t * OpamTypes.variable_contents option Lazy.t) list (** The function used internally to get our canonical names for architectures (returns its input lowercased if not a recognised arch). This is typically called on the output of [uname -m] *) val normalise_arch: string -> string (** The function used internally to get our canonical names for OSes (returns its input lowercased if not a recognised OS). This is typically called on the output of [uname -s] *) val normalise_os: string -> string opam-2.0.5/src/state/opamGlobalState.mli0000644000175000017500000000560513511367404017154 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Loading and handling of the global state of an opam root *) open OpamTypes open OpamStateTypes (** Loads the global state (from the opam root obtained through [OpamStateConfig.(!r.root)]) *) val load: 'a lock -> 'a global_state (** Loads the global state as [load], and calls the given function while keeping it locked (as per the [lock] argument), releasing the lock afterwards *) val with_: 'a lock -> ('a global_state -> 'b) -> 'b (** The set of all installed packages, in any switch *) val all_installed: 'a global_state -> package_set val switches: 'a global_state -> switch list val fold_switches: (switch -> switch_selections -> 'a -> 'a) -> 'b global_state -> 'a -> 'a (** Checks a switch for existence: either configured in the opam root, or an existing local switch with a configuration file pointing to the current root *) val switch_exists: 'a global_state -> switch -> bool (** Returns the map of installed instances of the package name towards the list of switches they are installed in *) val installed_versions: 'a global_state -> name -> switch list package_map (** Default list of repositories to get packages from, ordered by decreasing priority. This can be overridden by switch-specific selections, and does not have to include all configured repositories. *) val repos_list: 'a global_state -> repository_name list (** Releases any locks on the given global_state *) val unlock: 'a global_state -> unlocked global_state (** Calls the provided function, ensuring a temporary write lock on the given global state *) val with_write_lock: ?dontblock:bool -> 'a global_state -> (rw global_state -> 'b * 'c global_state) -> 'b * 'a global_state (** Writes back the global configuration file ~/.opam/config *) val write: rw global_state -> unit (** Updates the configured list of switches, making sure the current switch is registered if it is set and exists, and removing any non-existing switches. Writes back to disk if possible (ie lock is available) *) val fix_switch_list: 'a global_state -> 'a global_state (** Description used for system inferred variables *) val inferred_from_system: string opam-2.0.5/src/state/opamStateTypes.mli0000644000175000017500000001273513511367404017062 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Defines the types holding global, repository and switch states *) open OpamTypes (** Client state *) (** Phantom types to indicate the locking state of a state, and allow or not on-disk operations. Note that each state load is itself locking enough to return a consistent state: a read lock is only needed when the consistency of the actions depend on the fact that the given state doesn't change during the run (e.g. an update that depends on it). In particular, all query commands don't need a read lock. Subtyping is by guarantees given on the operations allowed, [rw] giving the most and being the smallest type, so that it is safe to coerce [(rw t :> ro t)]. *) (** Phantom type for readwrite-locked state (ensures that there are no concurrent reads or writes) *) type rw = [ `Lock_write ] (** Type for read-locked state (ensures that there are no concurrent writes) *) type ro = [ `Lock_read | rw ] (** Type for unlocked state (single file reads should still be ok) *) type unlocked = [ `Lock_none | ro ] (** The super-type for all lock types *) type +'a lock = [< unlocked > `Lock_write ] as 'a (** Global state corresponding to an opam root and its configuration *) type +'lock global_state = { global_lock: OpamSystem.lock; root: OpamPath.t; (** The global OPAM root path (caution: this is stored here but some code may rely on OpamStateConfig.root_dir ; in other words, multiple root handling isn't really supported at the moment) *) config: OpamFile.Config.t; (** The main configuration file. A note of caution: this corresponds to the configuration as loaded from the file: to get the current options, which may be overridden through the command-line or environment, see OpamStateConfig *) global_variables: (variable_contents option Lazy.t * string) OpamVariable.Map.t; (** A map of variables that have been defined globally, e.g. through `.opam/config`. They may need evaluation so are stored as lazy values. The extra string is the supplied variable documentation *) } constraint 'lock = 'lock lock (** State corresponding to the repo/ subdir: all available packages and metadata, for each repository. *) type +'lock repos_state = { repos_lock: OpamSystem.lock; repos_global: unlocked global_state; repositories: repository repository_name_map; (** The list of repositories *) repos_definitions: OpamFile.Repo.t repository_name_map; (** The contents of each repo's [repo] file *) repo_opams: OpamFile.OPAM.t package_map repository_name_map; (** All opam files that can be found in the configured repositories *) } constraint 'lock = 'lock lock (** State of a given switch: options, available and installed packages, etc.*) type +'lock switch_state = { switch_lock: OpamSystem.lock; switch_global: unlocked global_state; switch_repos: unlocked repos_state; switch: switch; (** The current active switch *) compiler_packages: package_set; (** The packages that form the base of the current compiler *) switch_config: OpamFile.Switch_config.t; (** The configuration file for this switch *) repos_package_index: OpamFile.OPAM.t package_map; (** Metadata of all packages that could be found in the configured repositories (ignoring installed or pinned packages) *) opams: OpamFile.OPAM.t package_map; (** The metadata of all packages, gathered from repo, local cache and pinning overlays. This includes URL and descr data (even if they were originally in separate files), as well as the original metadata directory (that can be used to retrieve the files/ subdir) *) conf_files: OpamFile.Dot_config.t package_map; (** The opam-config of installed packages (from ".opam-switch/config/pkgname.config") *) packages: package_set; (** The set of all known packages *) available_packages: package_set Lazy.t; (** The set of available packages, filtered by their [available:] field *) pinned: package_set; (** The set of pinned packages (their metadata, including pinning target, is in [opams]) *) installed: package_set; (** The set of all installed packages *) installed_opams: OpamFile.OPAM.t package_map; (** The cached metadata of installed packages (may differ from the metadata that is in [opams] for updated packages) *) installed_roots: package_set; (** The set of packages explicitly installed by the user. Some of them may happen not to be installed at some point, but this indicates that the user would like them installed. *) reinstall: package_set; (** The set of packages which needs to be reinstalled *) (* Missing: a cache for - switch-global and package variables - the solver universe? *) } constraint 'lock = 'lock lock opam-2.0.5/src/state/opamSwitchAction.ml0000644000175000017500000002220413511367404017173 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamPackage.Set.Op let log fmt = OpamConsole.log "SWACT" fmt let slog = OpamConsole.slog let gen_switch_config root ?(synopsis="") ?repos _switch = let vars = List.map (fun (s,p) -> OpamVariable.of_string s, S p) [ ("user" , try (Unix.getpwuid (Unix.getuid ())).Unix.pw_name with Not_found -> "user"); ("group", try (Unix.getgrgid (Unix.getgid ())).Unix.gr_name with Not_found -> "group"); ] in { OpamFile.Switch_config. opam_version = OpamVersion.current_nopatch; synopsis; variables = vars; paths = []; opam_root = Some root; repos; wrappers = OpamFile.Wrappers.empty; env = []; } let install_switch_config root switch config = log "install_switch_config switch=%a" (slog OpamSwitch.to_string) switch; OpamFile.Switch_config.write (OpamPath.Switch.switch_config root switch) config let create_empty_switch gt ?synopsis ?repos switch = log "create_empty_switch at %a" (slog OpamSwitch.to_string) switch; let root = gt.root in let switch_dir = OpamPath.Switch.root root switch in (* Do some clean-up if necessary *) if OpamFilename.exists_dir switch_dir then failwith (Printf.sprintf "Directory %s already exists" (OpamFilename.Dir.to_string switch_dir)); try (* Create base directories *) OpamFilename.mkdir switch_dir; let config = gen_switch_config root ?synopsis ?repos switch in OpamFilename.mkdir (OpamPath.Switch.lib_dir root switch config); OpamFilename.mkdir (OpamPath.Switch.stublibs root switch config); OpamFilename.mkdir (OpamPath.Switch.toplevel root switch config); OpamFilename.mkdir (OpamPath.Switch.build_dir root switch); OpamFilename.mkdir (OpamPath.Switch.bin root switch config); OpamFilename.mkdir (OpamPath.Switch.sbin root switch config); OpamFilename.mkdir (OpamPath.Switch.doc_dir root switch config); OpamFilename.mkdir (OpamPath.Switch.man_dir root switch config); OpamFilename.mkdir (OpamPath.Switch.install_dir root switch); OpamFilename.mkdir (OpamPath.Switch.config_dir root switch); List.iter (fun num -> OpamFilename.mkdir (OpamPath.Switch.man_dir ~num root switch config) ) ["1";"1M";"2";"3";"4";"5";"6";"7";"9"]; install_switch_config root switch config; let root_config = OpamFile.Config.with_installed_switches (switch::OpamFile.Config.installed_switches gt.config) gt.config in let gt = { gt with config = root_config } in OpamGlobalState.write gt; gt with e -> if not (OpamConsole.debug ()) then OpamFilename.rmdir switch_dir; raise e let write_selections st = if not OpamStateConfig.(!r.dryrun) then let f = OpamPath.Switch.selections st.switch_global.root st.switch in let env = OpamPath.Switch.environment st.switch_global.root st.switch in OpamFile.SwitchSelections.write f (OpamSwitchState.selections st); OpamFile.Environment.write env (OpamEnv.compute_updates st) let add_to_reinstall st ~unpinned_only packages = log "add-to-reinstall unpinned_only:%b packages:%a" unpinned_only (slog OpamPackage.Set.to_string) packages; let root = st.switch_global.root in let packages = if unpinned_only then OpamPackage.Set.filter (fun nv -> not (OpamPackage.has_name st.pinned nv.name)) packages else packages in let reinstall_file = OpamPath.Switch.reinstall root st.switch in let current_reinstall = OpamFile.PkgList.safe_read reinstall_file in let add_reinst_packages = OpamPackage.packages_of_names st.installed (OpamPackage.names_of_packages packages) in let reinstall = current_reinstall ++ add_reinst_packages in if OpamPackage.Set.equal current_reinstall reinstall then () else if OpamPackage.Set.is_empty reinstall then OpamFilename.remove (OpamFile.filename reinstall_file) else OpamFile.PkgList.write reinstall_file reinstall; { st with reinstall = st.reinstall ++ add_reinst_packages } let set_current_switch lock gt ?rt switch = if OpamSwitch.is_external switch then OpamConsole.error_and_exit `Bad_arguments "Can not set external switch '%s' globally. To set it in the current \ shell use:\n %s" (OpamSwitch.to_string switch) (OpamEnv.eval_string gt ~set_opamswitch:true (Some switch)); let config = OpamFile.Config.with_switch switch gt.config in let gt = { gt with config } in OpamGlobalState.write gt; let rt = match rt with | Some rt -> { rt with repos_global = gt } | None -> OpamRepositoryState.load `Lock_none gt in let st = OpamSwitchState.load lock gt rt switch in OpamEnv.write_dynamic_init_scripts st; st let install_metadata st nv = let opam = OpamSwitchState.opam st nv in OpamFile.OPAM.write (OpamPath.Switch.installed_opam st.switch_global.root st.switch nv) opam; List.iter (fun (f, rel_path, _hash) -> let dst = OpamFilename.create (OpamPath.Switch.installed_opam_files_dir st.switch_global.root st.switch nv) rel_path in OpamFilename.mkdir (OpamFilename.dirname dst); OpamFilename.copy ~src:f ~dst) (OpamFile.OPAM.get_extra_files opam) let remove_metadata st packages = OpamPackage.Set.iter (fun nv -> OpamFilename.rmdir (OpamPath.Switch.installed_package_dir st.switch_global.root st.switch nv)) packages let update_switch_state ?installed ?installed_roots ?reinstall ?pinned st = let open OpamStd.Option.Op in let open OpamPackage.Set.Op in let installed = installed +! st.installed in let reinstall0 = st.reinstall in let reinstall = (reinstall +! reinstall0) %% installed in let compiler_packages = if OpamPackage.Set.is_empty (st.compiler_packages -- installed) then st.compiler_packages else (* adjust version of installed compiler packages *) let names = OpamPackage.names_of_packages st.compiler_packages in let installed_base = OpamPackage.packages_of_names installed names in installed_base ++ (* keep version of uninstalled compiler packages *) OpamPackage.packages_of_names st.compiler_packages (OpamPackage.Name.Set.diff names (OpamPackage.names_of_packages installed_base)) in let old_selections = OpamSwitchState.selections st in let st = { st with installed; installed_roots = installed_roots +! st.installed_roots; reinstall; pinned = pinned +! st.pinned; compiler_packages; } in if not OpamStateConfig.(!r.dryrun) then ( if OpamSwitchState.selections st <> old_selections then write_selections st; if not (OpamPackage.Set.equal reinstall0 reinstall) then OpamFile.PkgList.write (OpamPath.Switch.reinstall st.switch_global.root st.switch) (OpamPackage.Set.filter (OpamSwitchState.is_dev_package st) reinstall) ); st let add_to_installed st ?(root=false) nv = let st = update_switch_state st ~installed:(OpamPackage.Set.add nv st.installed) ~reinstall:(OpamPackage.Set.remove nv st.reinstall) ~installed_roots: (let roots = OpamPackage.Set.filter (fun nv1 -> nv1.name <> nv.name) st.installed_roots in if root then OpamPackage.Set.add nv roots else st.installed_roots) in let opam = OpamSwitchState.opam st nv in let conf = OpamFile.Dot_config.safe_read (OpamPath.Switch.config st.switch_global.root st.switch nv.name) in let st = { st with conf_files = OpamPackage.Map.add nv conf st.conf_files } in if not OpamStateConfig.(!r.dryrun) then ( install_metadata st nv; if OpamFile.OPAM.env opam <> [] && OpamSwitchState.is_switch_globally_set st then OpamEnv.write_dynamic_init_scripts st; ); st let remove_from_installed ?(keep_as_root=false) st nv = let rm = OpamPackage.Set.remove nv in let st = update_switch_state st ~installed:(rm st.installed) ?installed_roots:(if keep_as_root then None else Some (rm st.installed_roots)) ~reinstall:(rm st.reinstall) in let has_setenv = match OpamStd.Option.map OpamFile.OPAM.env (OpamSwitchState.opam_opt st nv) with Some (_::_) -> true | _ -> false in if not OpamStateConfig.(!r.dryrun) && has_setenv && OpamSwitchState.is_switch_globally_set st then (* note: don't remove_metadata just yet *) OpamEnv.write_dynamic_init_scripts st; { st with conf_files = OpamPackage.Map.remove nv st.conf_files } opam-2.0.5/src/state/opamSwitchState.mli0000644000175000017500000002203413511367404017210 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Loading and querying a switch state *) open OpamTypes open OpamStateTypes val load: 'a lock -> 'b global_state -> 'c repos_state -> switch -> 'a switch_state (** Loads the switch state and calls the given function on it, releasing the lock afterwards. The repository state is automatically loaded if not provided. The switch is selected, if not set, using [OpamStateConfig.get_switch] -- which can fail if no switch is configured. Additionally, in case of a write lock, a backup is saved and a message is printed on restoring if [f] raised an exception and there were changes. *) val with_: 'a lock -> ?rt:([< unlocked ] repos_state) -> ?switch:switch -> [< unlocked ] global_state -> ('a switch_state -> 'b) -> 'b (** Creates a virtual state with all package available and nothing installed. Useful for querying and simulating actions when no switch is yet configured, or querying packages directly from the repos *) val load_virtual: ?repos_list: repository_name list -> 'a global_state -> 'b repos_state -> unlocked switch_state (** Load the switch's state file, without constructing the package maps: much faster than loading the full switch state *) val load_selections: 'a global_state -> switch -> switch_selections (** Raw function to compute the availability of all packages, in [opams], given the switch configuration and the set of pinned packages. (The result is precomputed in global_state.available_packages once the state is loaded) *) val compute_available_packages: 'a global_state -> switch -> OpamFile.Switch_config.t -> pinned:package_set -> opams:OpamFile.OPAM.t package_map -> package_set (** Releases any locks on the given switch_state *) val unlock: 'a switch_state -> unlocked switch_state (** Calls the provided function, ensuring a temporary write lock on the given switch state *) val with_write_lock: ?dontblock:bool -> 'a switch_state -> (rw switch_state -> 'b * rw switch_state) -> 'b * 'a switch_state (** {2 Helpers to access state data} *) (** Returns the repositories configured in the current switch or, if none, the globally set default. highest priority first. *) val repos_list: 'a switch_state -> repository_name list val selections: 'a switch_state -> switch_selections (** Return the OPAM file for the given package. @raise Not_found when appropriate *) val opam: 'a switch_state -> package -> OpamFile.OPAM.t (** Return the OPAM file, including URL and descr, for the given package, if any *) val opam_opt: 'a switch_state -> package -> OpamFile.OPAM.t option (** Return the URL file for the given package *) val url: 'a switch_state -> package -> OpamFile.URL.t option (** Returns the primary URL from the URL file of the given package *) val primary_url: 'a switch_state -> package -> url option (** Return the Descr file for the given package (or an empty descr if none) *) val descr: 'a switch_state -> package -> OpamFile.Descr.t (** Return the Descr file for the given package *) val descr_opt: 'a switch_state -> package -> OpamFile.Descr.t option (** Returns the full paths of overlay files under the files/ directory *) val files: 'a switch_state -> package -> filename list (** Return the installed package's local configuration *) val package_config: 'a switch_state -> name -> OpamFile.Dot_config.t (** Check whether a package name is installed *) val is_name_installed: 'a switch_state -> name -> bool (** Return the installed package with the right name @raise Not_found when appropriate *) val find_installed_package_by_name: 'a switch_state -> name -> package (** Return all packages satisfying one of the given atoms from a state *) val packages_of_atoms: 'a switch_state -> atom list -> package_set (** Gets the current version of package [name]: pinned version, installed version, max available version or max existing version, tried in this order. @raise Not_found only if there is no package by this name *) val get_package: 'a switch_state -> name -> package (** "dev packages" are any package with an upstream that isn't the usual HTTP, and without an archive checksum. These need to be updated from upstream independently when installed. It's generally only the case of source-pinned packages, but no rule enforces it in opam itself. *) val is_dev_package: 'a switch_state -> package -> bool (** Checks if the given package name is pinned *) val is_pinned: 'a switch_state -> name -> bool (** Checks if the given package is version-pinned, i.e. pinned without overlay metadata, and relying on the repo's data *) val is_version_pinned: 'a switch_state -> name -> bool (** The set of all "dev packages" (see [is_dev_package] for a definition) *) val dev_packages: 'a switch_state -> package_set (** Returns the local source mirror for the given package ([OpamPath.Switch.sources] or [OpamPath.Switch.pinned_package], depending on wether it's pinned). *) val source_dir: 'a switch_state -> package -> dirname (** Returns the set of active external dependencies for the package, computed from the values of the system-specific variables *) val depexts: 'a switch_state -> package -> OpamStd.String.Set.t (** [conflicts_with st subset pkgs] returns all packages declared in conflict with at least one element of [subset] within [pkgs], through forward or backward conflict definition or common conflict-class. Packages in [subset] (all their versions) are excluded from the result. *) val conflicts_with: 'a switch_state -> package_set -> package_set -> package_set (** Put the package data in a form suitable for the solver, pre-computing some maps and sets. Packages in the [requested] set are the ones that will get affected by the global [build_test] and [build_doc] flags. [test] and [doc], if unspecified, are taken from [OpamStateConfig.r]. [reinstall] marks package not considered current in the universe, and that should therefore be reinstalled. If unspecified, it is the packages marked in [switch_state.reinstall] that are present in [requested]. *) val universe: 'a switch_state -> ?test:bool -> ?doc:bool -> ?force_dev_deps:bool -> ?reinstall:package_set -> requested:name_set -> user_action -> universe (** Dumps the current switch state in PEF format, for interaction with Dose tools *) val dump_pef_state: 'a switch_state -> out_channel -> unit (** {2 Updating} *) (** Sets the given opam file for the given package, updating the other related fields along the way *) val update_package_metadata: package -> OpamFile.OPAM.t -> 'a switch_state -> 'a switch_state (** Removes the metadata associated to the given package, also updating the packages and available sets. *) val remove_package_metadata: package -> 'a switch_state -> 'a switch_state (** Like [update_package_metadata], but also ensures the package is pinned to the given version. The version specified in the opam file, if any, takes precedence over the version of [package]. Also marks it for reinstall if changed. *) val update_pin: package -> OpamFile.OPAM.t -> 'a switch_state -> 'a switch_state (** Updates the selected repositories in the given switch (does not load the full switch state, but takes a transient write lock on the switch, so make sure not to hold other locks to avoid deadlocks). Sets the switch repositories in any case, even if unchanged from the defaults. *) val update_repositories: 'a global_state -> (repository_name list -> repository_name list) -> switch -> unit (** {2 User interaction and reporting } *) (** Returns [true] if the switch of the state is the one set in [$OPAMROOT/config], [false] otherwise. This doesn't imply that the switch is current w.r.t. either the process or the shell, for that you need to check [OpamStateConfig.(!r.switch_from)] *) val is_switch_globally_set: 'a switch_state -> bool (** Returns a message about a package or version that couldn't be found *) val not_found_message: 'a switch_state -> atom -> string (** Returns a printable explanation why a package is not currently available (pinned to an incompatible version, unmet [available:] constraints...). [default] is returned if no reason why it wouldn't be available was found (empty string if unspecified). *) val unavailable_reason: 'a switch_state -> ?default:string -> name * OpamFormula.version_formula -> string opam-2.0.5/src/state/opamSwitchState.ml0000644000175000017500000007262313511367404017050 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStd.Op open OpamPackage.Set.Op let log fmt = OpamConsole.log "STATE" fmt let slog = OpamConsole.slog open OpamStateTypes let load_selections gt switch = OpamFile.SwitchSelections.safe_read (OpamPath.Switch.selections gt.root switch) let load_switch_config gt switch = let f = OpamPath.Switch.switch_config gt.root switch in match OpamFile.Switch_config.read_opt f with | Some c -> c | None -> OpamConsole.error "No config file found for switch %s. Switch broken?" (OpamSwitch.to_string switch); OpamFile.Switch_config.empty let compute_available_packages gt switch switch_config ~pinned ~opams = (* remove all versions of pinned packages, but the pinned-to version *) let pinned_names = OpamPackage.names_of_packages pinned in let opams = OpamPackage.Map.filter (fun nv _ -> not (OpamPackage.Name.Set.mem nv.name pinned_names) || OpamPackage.Set.mem nv pinned) opams in let avail_map = OpamPackage.Map.filter (fun package opam -> OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_switch_raw ~package gt switch switch_config) (OpamFile.OPAM.available opam)) opams in OpamPackage.keys avail_map let repos_list_raw rt switch_config = let global, repos = match switch_config.OpamFile.Switch_config.repos with | None -> true, OpamGlobalState.repos_list rt.repos_global | Some repos -> false, repos in let found, notfound = List.partition (fun r -> OpamRepositoryName.Map.mem r rt.repositories) repos in List.iter (fun r -> log "Ignoring %s-selected repository %S, no configured repository by \ this name found" (if global then "globally" else "switch") (OpamRepositoryName.to_string r)) notfound; found let repos_list st = repos_list_raw st.switch_repos st.switch_config let load lock_kind gt rt switch = let chrono = OpamConsole.timer () in log "LOAD-SWITCH-STATE @ %a" (slog OpamSwitch.to_string) switch; if not (OpamGlobalState.switch_exists gt switch) then (log "The switch %a does not appear to be installed according to %a" (slog OpamSwitch.to_string) switch (slog @@ OpamFile.to_string @* OpamPath.config) gt.root; OpamConsole.error_and_exit (if OpamStateConfig.(!r.switch_from = `Command_line) then `Bad_arguments else `Configuration_error) "The selected switch %s is not installed.%s" (OpamSwitch.to_string switch) @@ match OpamStateConfig.(!r.switch_from) with | `Command_line -> "" | `Default -> " Please choose a different one using 'opam switch ', or use the \ '--switch ' flag." | `Env -> " Please fix the value of the OPAMSWITCH environment variable, or use \ the '--switch ' flag") else let gt = OpamGlobalState.fix_switch_list gt in let lock = OpamFilename.flock lock_kind (OpamPath.Switch.lock gt.root switch) in let switch_config = load_switch_config gt switch in if OpamVersion.compare (OpamVersion.nopatch (switch_config.OpamFile.Switch_config.opam_version)) (OpamVersion.nopatch OpamFormatUpgrade.latest_version) <> 0 then OpamConsole.error_and_exit `Configuration_error "Could not load opam switch %s: it reports version %s while %s was \ expected" (OpamSwitch.to_string switch) (OpamVersion.to_string (switch_config.OpamFile.Switch_config.opam_version)) (OpamVersion.to_string OpamFormatUpgrade.latest_version); let { sel_installed = installed; sel_roots = installed_roots; sel_pinned = pinned; sel_compiler = compiler_packages; } = load_selections gt switch in let pinned, pinned_opams = OpamPackage.Set.fold (fun nv (pinned,opams) -> let overlay_dir = OpamPath.Switch.Overlay.package gt.root switch nv.name in match OpamFileTools.read_opam overlay_dir with | None -> (* No overlay => just pinned to a version *) OpamPackage.Set.add nv pinned, opams | Some o -> let version = match OpamFile.OPAM.version_opt o with | Some v when v <> nv.version -> log "warn: %s has conflicting pinning versions between \ switch-state (%s) and overlay (%s). Using %s." (OpamPackage.Name.to_string nv.name) (OpamPackage.Version.to_string nv.version) (OpamPackage.Version.to_string v) (OpamPackage.Version.to_string v); v | _ -> nv.version in let nv = OpamPackage.create nv.name version in let o = OpamFile.OPAM.with_version version o in OpamPackage.Set.add nv pinned, OpamPackage.Map.add nv o opams ) pinned (OpamPackage.Set.empty, OpamPackage.Map.empty) in let installed_opams = OpamPackage.Set.fold (fun nv opams -> OpamStd.Option.Op.( (OpamFile.OPAM.read_opt (OpamPath.Switch.installed_opam gt.root switch nv) >>| fun opam -> OpamPackage.Map.add nv opam opams) +! opams)) installed OpamPackage.Map.empty in let repos_package_index = OpamRepositoryState.build_index rt (repos_list_raw rt switch_config) in let opams = OpamPackage.Map.union (fun _ x -> x) repos_package_index pinned_opams in let packages = OpamPackage.keys opams in let available_packages = lazy (compute_available_packages gt switch switch_config ~pinned ~opams) in let opams = (* Keep definitions of installed packages, but lowest priority, and after computing availability *) OpamPackage.Map.union (fun _ x -> x) installed_opams opams in let installed_without_def = OpamPackage.Set.fold (fun nv nodef -> if OpamPackage.Map.mem nv installed_opams then nodef else try let o = OpamPackage.Map.find nv opams in if lock_kind = `Lock_write then (* auto-repair *) (log "Definition missing for installed package %s, \ copying from repo" (OpamPackage.to_string nv); OpamFile.OPAM.write (OpamPath.Switch.installed_opam gt.root switch nv) o); nodef with Not_found -> OpamPackage.Set.add nv nodef) installed OpamPackage.Set.empty in if not (OpamPackage.Set.is_empty installed_without_def) then OpamConsole.error "No definition found for the following installed packages: %s\n\ This switch may need to be reinstalled" (OpamPackage.Set.to_string installed_without_def); let changed = (* Note: This doesn't detect changed _dev_ packages, since it's based on the metadata or the archive hash changing and they don't have an archive hash. Therefore, dev package update needs to add to the reinstall file *) OpamPackage.Map.merge (fun _ opam_new opam_installed -> match opam_new, opam_installed with | Some r, Some i when not (OpamFile.OPAM.effectively_equal i r) -> Some () | _ -> None) opams installed_opams |> OpamPackage.keys in let changed = changed -- OpamPackage.Set.filter (fun nv -> not (OpamPackage.has_name pinned nv.name)) compiler_packages in log "Detected changed packages (marked for reinstall): %a" (slog OpamPackage.Set.to_string) changed; (* Detect and initialise missing switch description *) let switch_config = if switch_config <> OpamFile.Switch_config.empty && switch_config.OpamFile.Switch_config.synopsis = "" then let synopsis = match OpamPackage.Set.elements (compiler_packages %% installed_roots) with | [] -> OpamSwitch.to_string switch | [nv] -> let open OpamStd.Option.Op in (OpamPackage.Map.find_opt nv opams >>= OpamFile.OPAM.synopsis) +! OpamPackage.to_string nv | pkgs -> OpamStd.List.concat_map " " OpamPackage.to_string pkgs in let conf = { switch_config with OpamFile.Switch_config.synopsis } in if lock_kind = `Lock_write then (* auto-repair *) OpamFile.Switch_config.write (OpamPath.Switch.switch_config gt.root switch) conf; conf else switch_config in let conf_files = OpamPackage.Set.fold (fun nv acc -> OpamPackage.Map.add nv (OpamFile.Dot_config.safe_read (OpamPath.Switch.config gt.root switch nv.name)) acc) installed OpamPackage.Map.empty in let ext_files_changed = OpamPackage.Map.fold (fun nv conf acc -> if List.exists (fun (file, hash) -> let exists = OpamFilename.exists file in let should_exist = let count_not_zero c = function '0' -> c | _ -> succ c in OpamStd.String.fold_left count_not_zero 0 (OpamHash.contents hash) <> 0 in let changed = exists <> should_exist || exists && not (OpamHash.check_file (OpamFilename.to_string file) hash) in (* /!\ fixme: the package removal instructions won't actually ever be called in this case *) if not exists && should_exist then OpamConsole.error "System file %s, which package %s depends upon, \ no longer exists.\n\ The package has been marked as removed, and opam will \ try to reinstall it if necessary, but you should reinstall \ its system dependencies first." (OpamFilename.to_string file) (OpamPackage.to_string nv) else if changed then OpamConsole.warning "File %s, which package %s depends upon, \ was changed on your system. \ %s has been marked as removed, and will be reinstalled if \ necessary." (OpamFilename.to_string file) (OpamPackage.to_string nv) (OpamPackage.name_to_string nv); changed) (OpamFile.Dot_config.file_depends conf) then OpamPackage.Set.add nv acc else acc) conf_files OpamPackage.Set.empty in let installed = installed -- ext_files_changed in let reinstall = OpamFile.PkgList.safe_read (OpamPath.Switch.reinstall gt.root switch) ++ changed in let st = { switch_global = (gt :> unlocked global_state); switch_repos = (rt :> unlocked repos_state); switch_lock = lock; switch; compiler_packages; switch_config; repos_package_index; installed_opams; installed; pinned; installed_roots; opams; conf_files; packages; available_packages; reinstall; } in log "Switch state loaded in %.3fs" (chrono ()); st let load_virtual ?repos_list gt rt = let repos_list = match repos_list with | Some rl -> rl | None -> OpamGlobalState.repos_list gt in let opams = OpamRepositoryState.build_index rt repos_list in let packages = OpamPackage.keys opams in { switch_global = (gt :> unlocked global_state); switch_repos = (rt :> unlocked repos_state); switch_lock = OpamSystem.lock_none; switch = OpamSwitch.unset; compiler_packages = OpamPackage.Set.empty; switch_config = { OpamFile.Switch_config.empty with OpamFile.Switch_config.repos = Some repos_list; }; installed = OpamPackage.Set.empty; installed_opams = OpamPackage.Map.empty; pinned = OpamPackage.Set.empty; installed_roots = OpamPackage.Set.empty; repos_package_index = opams; opams; conf_files = OpamPackage.Map.empty; packages; available_packages = lazy packages; reinstall = OpamPackage.Set.empty; } let selections st = { sel_installed = st.installed; sel_roots = st.installed_roots; sel_compiler = st.compiler_packages; sel_pinned = st.pinned; } let unlock st = OpamSystem.funlock st.switch_lock; (st :> unlocked switch_state) let with_write_lock ?dontblock st f = let ret, st = OpamFilename.with_flock_upgrade `Lock_write ?dontblock st.switch_lock @@ fun _ -> f ({ st with switch_lock = st.switch_lock } : rw switch_state) (* We don't actually change the field value, but this makes restricting the phantom lock type possible*) in ret, { st with switch_lock = st.switch_lock } let opam st nv = OpamPackage.Map.find nv st.opams let opam_opt st nv = try Some (opam st nv) with Not_found -> None let descr_opt st nv = OpamStd.Option.Op.(opam_opt st nv >>= OpamFile.OPAM.descr) let descr st nv = OpamStd.Option.Op.(descr_opt st nv +! OpamFile.Descr.empty) let url st nv = OpamStd.Option.Op.(opam_opt st nv >>= OpamFile.OPAM.url) let primary_url st nv = OpamStd.Option.Op.(url st nv >>| OpamFile.URL.url) let files st nv = match opam_opt st nv with | None -> [] | Some opam -> List.map (fun (file,_base,_hash) -> file) (OpamFile.OPAM.get_extra_files opam) let package_config st name = OpamPackage.Map.find (OpamPackage.package_of_name st.installed name) st.conf_files let is_name_installed st name = OpamPackage.has_name st.installed name let find_installed_package_by_name st name = OpamPackage.package_of_name st.installed name let packages_of_atoms st atoms = OpamFormula.packages_of_atoms st.packages atoms let get_package st name = try OpamPinned.package st name with Not_found -> try find_installed_package_by_name st name with Not_found -> try OpamPackage.max_version (Lazy.force st.available_packages) name with Not_found -> OpamPackage.max_version st.packages name let is_dev_package st nv = match opam_opt st nv with | Some opam -> OpamPackageVar.is_dev_package st opam | None -> false let is_pinned st name = OpamPackage.has_name st.pinned name let is_version_pinned st name = match OpamPackage.package_of_name_opt st.pinned name with | None -> false | Some nv -> match opam_opt st nv with | Some opam -> OpamPackage.Map.find_opt nv st.repos_package_index = Some opam | None -> false let source_dir st nv = if OpamPackage.Set.mem nv st.pinned then OpamPath.Switch.pinned_package st.switch_global.root st.switch nv.name else OpamPath.Switch.sources st.switch_global.root st.switch nv let depexts st nv = let env v = OpamPackageVar.resolve_switch ~package:nv st v in match opam_opt st nv with | None -> OpamStd.String.Set.empty | Some opam -> List.fold_left (fun depexts (names, filter) -> if OpamFilter.eval_to_bool ~default:false env filter then List.fold_left (fun depexts n -> OpamStd.String.Set.add n depexts) depexts names else depexts) OpamStd.String.Set.empty (OpamFile.OPAM.depexts opam) let dev_packages st = OpamPackage.Set.filter (is_dev_package st) (st.installed ++ OpamPinned.packages st) let conflicts_with st subset = let forward_conflicts, conflict_classes = OpamPackage.Set.fold (fun nv (cf,cfc) -> try let opam = OpamPackage.Map.find nv st.opams in let conflicts = OpamFilter.filter_formula ~default:false (OpamPackageVar.resolve_switch ~package:nv st) (OpamFile.OPAM.conflicts opam) in OpamFormula.ors [cf; conflicts], List.fold_right OpamPackage.Name.Set.add (OpamFile.OPAM.conflict_class opam) cfc with Not_found -> cf, cfc) subset (OpamFormula.Empty, OpamPackage.Name.Set.empty) in OpamPackage.Set.filter (fun nv -> not (OpamPackage.has_name subset nv.name) && (OpamFormula.verifies forward_conflicts nv || let opam = OpamPackage.Map.find nv st.opams in List.exists (fun cl -> OpamPackage.Name.Set.mem cl conflict_classes) (OpamFile.OPAM.conflict_class opam) || let backwards_conflicts = OpamFilter.filter_formula ~default:false (OpamPackageVar.resolve_switch ~package:nv st) (OpamFile.OPAM.conflicts opam) in OpamPackage.Set.exists (OpamFormula.verifies backwards_conflicts) subset)) let remove_conflicts st subset pkgs = pkgs -- conflicts_with st subset pkgs let get_conflicts st packages opams_map = let conflict_classes = OpamPackage.Map.fold (fun nv opam acc -> List.fold_left (fun acc cc -> OpamPackage.Name.Map.update cc (OpamPackage.Set.add nv) OpamPackage.Set.empty acc) acc (OpamFile.OPAM.conflict_class opam)) opams_map OpamPackage.Name.Map.empty in let conflict_class_formulas = OpamPackage.Name.Map.map (fun pkgs -> OpamPackage.to_map pkgs |> OpamPackage.Name.Map.mapi (fun name versions -> let all_versions = OpamPackage.versions_of_name packages name in if OpamPackage.Version.Set.equal versions all_versions then Empty else (* OpamFormula.simplify_version_set all_versions (*a possible optimisation?*) *) (OpamFormula.ors (List.map (fun v -> Atom (`Eq, v)) (OpamPackage.Version.Set.elements versions))))) conflict_classes in OpamPackage.Map.fold (fun nv opam acc -> let conflicts = OpamFilter.filter_formula ~default:false (OpamPackageVar.resolve_switch ~package:nv st) (OpamFile.OPAM.conflicts opam) in let conflicts = List.fold_left (fun acc cl -> let cmap = OpamPackage.Name.Map.find cl conflict_class_formulas |> OpamPackage.Name.Map.remove nv.name in OpamPackage.Name.Map.fold (fun name vformula acc -> OpamFormula.ors [acc; Atom (name, vformula)]) cmap acc) conflicts (OpamFile.OPAM.conflict_class opam) in OpamPackage.Map.add nv conflicts acc) opams_map OpamPackage.Map.empty let universe st ?(test=OpamStateConfig.(!r.build_test)) ?(doc=OpamStateConfig.(!r.build_doc)) ?(force_dev_deps=false) ?reinstall ~requested user_action = let requested_allpkgs = OpamPackage.packages_of_names st.packages requested in let env nv v = if List.mem v OpamPackageVar.predefined_depends_variables then match OpamVariable.Full.to_string v with | "dev" -> Some (B (force_dev_deps || is_dev_package st nv)) | "with-test" -> Some (B (test && OpamPackage.Set.mem nv requested_allpkgs)) | "with-doc" -> Some (B (doc && OpamPackage.Set.mem nv requested_allpkgs)) | _ -> None (* Computation delayed to the solver *) else let r = OpamPackageVar.resolve_switch ~package:nv st v in if r = None then (if OpamFormatConfig.(!r.strict) then OpamConsole.error_and_exit `File_error "undefined filter variable in dependencies of %s: %s" else log "ERR: undefined filter variable in dependencies of %s: %s") (OpamPackage.to_string nv) (OpamVariable.Full.to_string v); r in let get_deps f opams = OpamPackage.Map.mapi (fun nv opam -> OpamFilter.partial_filter_formula (env nv) (f opam) ) opams in let u_depends = let depend = let ignored = OpamStateConfig.(!r.ignore_constraints_on) in if OpamPackage.Name.Set.is_empty ignored then OpamFile.OPAM.depends else fun opam -> OpamFormula.map (fun (name, cstr as atom) -> if OpamPackage.Name.Set.mem name ignored then let cstr = OpamFormula.map (function Constraint _ -> Empty | Filter _ as f -> Atom f) cstr in Atom (name, cstr) else Atom atom) (OpamFile.OPAM.depends opam) in get_deps depend st.opams in let u_conflicts = get_conflicts st st.packages st.opams in let base = if OpamStateConfig.(!r.unlock_base) then OpamPackage.Set.empty else st.compiler_packages in let u_available = remove_conflicts st base (Lazy.force st.available_packages) in let u_reinstall = match reinstall with | Some set -> set | None -> OpamPackage.Set.filter (fun nv -> OpamPackage.Name.Set.mem nv.name requested) st.reinstall in let u = { u_packages = st.packages; u_action = user_action; u_installed = st.installed; u_available; u_depends; u_depopts = get_deps OpamFile.OPAM.depopts st.opams; u_conflicts; u_installed_roots = st.installed_roots; u_pinned = OpamPinned.packages st; u_base = base; u_reinstall; u_attrs = ["opam-query", requested_allpkgs]; } in u let dump_pef_state st oc = let conflicts = get_conflicts st st.packages st.opams in let print_def nv opam = Printf.fprintf oc "package: %s\n" (OpamPackage.name_to_string nv); Printf.fprintf oc "version: %s\n" (OpamPackage.version_to_string nv); let installed = OpamPackage.Set.mem nv st.installed in (* let root = OpamPackage.Set.mem nv st.installed_roots in *) let base = OpamPackage.Set.mem nv st.compiler_packages in let pinned = OpamPackage.Set.mem nv st.pinned in let available = OpamPackage.Set.mem nv (Lazy.force st.available_packages) in let reinstall = OpamPackage.Set.mem nv st.reinstall in let dev = OpamPackageVar.is_dev_package st opam in (* current state *) Printf.fprintf oc "available: %b\n" available; if installed then output_string oc "installed: true\n"; if pinned then output_string oc "pinned: true\n"; if base then output_string oc "base: true\n"; if reinstall then output_string oc "reinstall: true\n"; (* metadata (resolved for the current switch) *) OpamStd.List.concat_map ~left:"maintainer: " ~right:"\n" ~nil:"" " , " String.escaped (OpamFile.OPAM.maintainer opam) |> output_string oc; OpamFile.OPAM.depends opam |> OpamPackageVar.filter_depends_formula ~default:false ~dev ~env:(OpamPackageVar.resolve_switch ~package:nv st) |> OpamFormula.to_cnf |> OpamStd.List.concat_map ~left:"depends: " ~right:"\n" ~nil:"" " , " (OpamStd.List.concat_map " | " OpamFormula.string_of_atom) |> output_string oc; OpamFile.OPAM.depopts opam |> OpamPackageVar.filter_depends_formula ~default:false ~dev ~env:(OpamPackageVar.resolve_switch ~package:nv st) |> OpamFormula.to_cnf |> OpamStd.List.concat_map ~left:"recommends: " ~right:"\n" ~nil:"" " , " (OpamStd.List.concat_map " | " OpamFormula.string_of_atom) |> output_string oc; OpamFormula.ors [Atom (nv.name, Empty); OpamPackage.Map.find nv conflicts] |> OpamFormula.set_to_disjunction st.packages |> OpamStd.List.concat_map ~left:"conflicts: " ~right:"\n" ~nil:"" " , " OpamFormula.string_of_atom |> output_string oc; output_string oc "\n"; in OpamPackage.Map.iter print_def st.opams (* User-directed helpers *) let is_switch_globally_set st = OpamFile.Config.switch st.switch_global.config = Some st.switch let not_found_message st (name, cstr) = match cstr with | Some (relop,v) when OpamPackage.has_name st.packages name -> Printf.sprintf "Package %s has no version %s%s." (OpamPackage.Name.to_string name) (match relop with `Eq -> "" | r -> OpamPrinter.relop r) (OpamPackage.Version.to_string v) | _ -> Printf.sprintf "No package named %s found." (OpamPackage.Name.to_string name) (* Display a meaningful error for an unavailable package *) let unavailable_reason st ?(default="") (name, vformula) = let candidates = OpamPackage.packages_of_name st.packages name in let candidates = OpamPackage.Set.filter (fun nv -> OpamFormula.check_version_formula vformula nv.version) candidates in if OpamPackage.Set.is_empty candidates then (if OpamPackage.has_name st.packages name then "no matching version" else "unknown package") else let nv = try OpamPinned.package st name with Not_found -> match vformula with | Atom (_, v) when OpamPackage.Set.mem (OpamPackage.create name v) candidates -> OpamPackage.create name v | _ -> OpamPackage.max_version candidates name in match opam_opt st nv with | None -> "no package definition found" | Some opam -> let avail = OpamFile.OPAM.available opam in if not (OpamPackage.Set.mem nv candidates) then Printf.sprintf "not available because the package is pinned to version %s" (OpamPackage.version_to_string nv) else if not (OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_switch ~package:nv st) avail) then Printf.sprintf "unmet availability conditions%s%s" (if OpamPackage.Set.cardinal candidates = 1 then ": " else ", e.g. ") (OpamFilter.to_string avail) else if OpamPackage.has_name (Lazy.force st.available_packages -- remove_conflicts st st.compiler_packages (Lazy.force st.available_packages)) name then "conflict with the base packages of this switch" else if OpamPackage.has_name st.compiler_packages name && not OpamStateConfig.(!r.unlock_base) then "base of this switch (use `--unlock-base' to force)" else default let update_package_metadata nv opam st = { st with opams = OpamPackage.Map.add nv opam st.opams; packages = OpamPackage.Set.add nv st.packages; available_packages = lazy ( if OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_switch_raw ~package:nv st.switch_global st.switch st.switch_config) (OpamFile.OPAM.available opam) then OpamPackage.Set.add nv (Lazy.force st.available_packages) else OpamPackage.Set.remove nv (Lazy.force st.available_packages) ); reinstall = (match OpamPackage.Map.find_opt nv st.installed_opams with | Some inst -> if OpamFile.OPAM.effectively_equal inst opam then OpamPackage.Set.remove nv (st.reinstall) else OpamPackage.Set.add nv (st.reinstall) | _ -> st.reinstall); } let remove_package_metadata nv st = { st with opams = OpamPackage.Map.remove nv st.opams; packages = OpamPackage.Set.remove nv st.packages; available_packages = lazy (OpamPackage.Set.remove nv (Lazy.force st.available_packages)); } let update_pin nv opam st = let version = OpamStd.Option.default nv.version (OpamFile.OPAM.version_opt opam) in let nv = OpamPackage.create nv.name version in update_package_metadata nv opam @@ { st with pinned = OpamPackage.Set.add nv (OpamPackage.filter_name_out st.pinned nv.name); available_packages = lazy ( OpamPackage.filter_name_out (Lazy.force st.available_packages) nv.name ); } let do_backup lock st = match lock with | `Lock_write -> let file = OpamPath.Switch.backup st.switch_global.root st.switch in let previous_selections = selections st in OpamFile.SwitchSelections.write file previous_selections; (function | true -> OpamFilename.remove (OpamFile.filename file) | false -> (* Reload, in order to skip the message if there were no changes *) let new_selections = load_selections st.switch_global st.switch in if new_selections.sel_installed = previous_selections.sel_installed then OpamFilename.remove (OpamFile.filename file) else OpamConsole.errmsg "%s" (OpamStd.Format.reformat (Printf.sprintf "\nThe former state can be restored with:\n\ \ %s switch import %S\n" Sys.argv.(0) (OpamFile.to_string file) ^ if OpamPackage.Set.is_empty (new_selections.sel_roots -- new_selections.sel_installed) then "" else Printf.sprintf "Or you can retry to install your package selection with:\n\ \ %s install --restore\n" Sys.argv.(0)))) | _ -> fun _ -> () let with_ lock ?rt ?(switch=OpamStateConfig.get_switch ()) gt f = (match rt with | Some rt -> fun f -> f (rt :> unlocked repos_state) | None -> OpamRepositoryState.with_ `Lock_none gt) @@ fun rt -> let st = load lock gt rt switch in let cleanup_backup = do_backup lock st in try let r = f st in ignore (unlock st); cleanup_backup true; r with e -> OpamStd.Exn.finalise e @@ fun () -> ignore (unlock st); if not OpamCoreConfig.(!r.keep_log_dir) then cleanup_backup false let update_repositories gt update_fun switch = OpamFilename.with_flock `Lock_write (OpamPath.Switch.lock gt.root switch) @@ fun _ -> let conf = load_switch_config gt switch in let repos = match conf.OpamFile.Switch_config.repos with | None -> OpamGlobalState.repos_list gt | Some repos -> repos in let conf = { conf with OpamFile.Switch_config.repos = Some (update_fun repos) } in OpamFile.Switch_config.write (OpamPath.Switch.switch_config gt.root switch) conf opam-2.0.5/src/state/opamUpdate.mli0000644000175000017500000001020413511367404016164 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Synchronisation and downloading of repositories and package sources *) open OpamTypes open OpamStateTypes (* (** Update the given repository from its upstream. Returns a concurrency-safe state update function *) val repository: rw repos_state -> repository -> ('a repos_state -> 'a repos_state) OpamProcess.job *) (** Update the given repositories from their upstream, and returns the updated state. This also saves the updated cached state, and the updated repository config (it may be changed by e.g. redirects). The returned list is the list of repositories for which the update failed. *) val repositories: rw repos_state -> repository list -> repository list * rw repos_state (** [update_dev_packages t] checks for upstream changes for packages first in the switch cache and then in the global cache. Return the packages whose contents have changed upstream. Packages that are members of the [working_dir] and are bound to a local directory under version control are synchronised with its working state, bypassing version control. Side-effect: update the reinstall file, adding installed changed packages to the current switch to-reinstall set. The returned boolean is true if all updates were successful. *) val dev_packages: rw switch_state -> ?working_dir:package_set -> package_set -> bool * rw switch_state * package_set (** Updates a single dev or pinned package from its upstream. If [working_dir] is set, and the package is bound to a local, version-controlled dir, use the working dir state instead of what has been committed to version control. Returns true if changed, false otherwise, and a switch_state update function, applying possible changes in packages metadata *) val dev_package: rw switch_state -> ?working_dir:bool -> package -> ((rw switch_state -> rw switch_state) * bool) OpamProcess.job (** A subset of update_dev_packages that only takes packages names and only works on pinned packages. Also updates the reinstall file of the current switch *) val pinned_packages: rw switch_state -> ?working_dir:name_set -> name_set -> rw switch_state * package_set (** Updates a dev pinned package from its upstream; returns true if changed, false otherwise, and a switch_state update function that applies possible changes in packages metadata. Updates the on-disk overlay *) val pinned_package: rw switch_state -> ?version:version -> ?working_dir:bool -> name -> ((rw switch_state -> rw switch_state) * bool) OpamProcess.job (** Download or synchronise the upstream source for the given package into the given directory. Also places all of the package extra files (that have a known hash) into the cache. For non-VC remotes, verifies the checksum if any *) val download_package_source: 'a switch_state -> package -> dirname -> unit download option OpamProcess.job (** [cleanup_source old_opam_option new_opam] checks if the remote URL has changed between [old_opam_option] and [new_opam], and, depending on that, cleans up the source directory of the package ([OpamPath.Switch.sources]) if needed. *) val cleanup_source: 'a switch_state -> OpamFile.OPAM.t option -> OpamFile.OPAM.t -> unit (** Low-level function to retrieve the package source into its local cache *) val fetch_dev_package: OpamFile.URL.t -> dirname -> ?working_dir:bool -> package -> unit download OpamProcess.job opam-2.0.5/src/state/opamEnv.mli0000644000175000017500000001306313511367404015500 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Process environment setup and handling, shell configuration *) open OpamTypes open OpamStateTypes (** {2 Environment handling} *) (** Get the current environment with OPAM specific additions. If [force_path], the PATH is modified to ensure opam dirs are leading. [set_opamroot] and [set_opamswitch] can be additionally used to set the [OPAMROOT] and [OPAMSWITCH] variables. *) val get_full: ?set_opamroot:bool -> ?set_opamswitch:bool -> force_path:bool -> ?updates:env_update list -> 'a switch_state -> env (** Get only environment modified by OPAM. If [force_path], the PATH is modified to ensure opam dirs are leading. [set_opamroot] and [set_opamswitch] can be additionally used to set the [OPAMROOT] and [OPAMSWITCH] variables. *) val get_opam: ?set_opamroot:bool -> ?set_opamswitch:bool -> force_path:bool -> 'a switch_state -> env (** Like [get_opam], but reads the cache file from the given opam root and switch instead of computing the environment from a switch state *) val get_opam_raw: ?set_opamroot:bool -> ?set_opamswitch:bool -> force_path:bool -> dirname -> switch -> env (** Returns the running environment, with any opam modifications cleaned out, and optionally the given updates *) val get_pure: ?updates:env_update list -> unit -> env (** Update an environment, including reverting opam changes that could have been previously applied (therefore, don't apply to an already updated env as returned by e.g. [get_full]!) *) val add: env -> env_update list -> env (** Like [get_opam] computes environment modification by OPAM , but returns these [updates] instead of the new environment. *) val updates: ?set_opamroot:bool -> ?set_opamswitch:bool -> ?force_path:bool -> 'a switch_state -> env_update list (** Check if the shell environment is in sync with the current OPAM switch (or if OPAMNOENVNOTICE has been set, in which case we just assume it's up to date) *) val is_up_to_date: 'a switch_state -> bool (** Check if the shell environment is in sync with the given opam root and switch (or if OPAMNOENVNOTICE has been set, in which case we just assume it's up to date) *) val is_up_to_date_switch: dirname -> switch -> bool (** Returns the current environment updates to configure the current switch with its set of installed packages *) val compute_updates: ?force_path:bool -> 'a switch_state -> env_update list (** The shell command to run by the user to set his OPAM environment, adapted to the current shell (as returned by [eval `opam config env`]) *) val eval_string: 'a global_state -> ?set_opamswitch:bool -> switch option -> string (** Returns the updated contents of the PATH variable for the given opam root and switch (set [force_path] to ensure the opam path is leading) *) val path: force_path:bool -> dirname -> switch -> string (** Returns the full environment with only the PATH variable updated, as per [path] *) val full_with_path: force_path:bool -> ?updates:env_update list -> dirname -> switch -> env (** {2 Shell and initialisation support} *) (** Sets the opam configuration in the user shell, after detailing the process and asking the user if either [update_config] or [shell_hook] are unset *) val setup: dirname -> interactive:bool -> ?dot_profile:filename -> ?update_config:bool -> ?env_hook:bool -> ?completion:bool -> shell -> unit (* (\** Display the global and user configuration for OPAM. *\) * val display_setup: dirname -> dot_profile:filename -> shell -> unit *) (** Update the user configuration in $HOME for good opam integration. *) val update_user_setup: dirname -> ?dot_profile:filename -> shell -> unit (** Write the generic scripts in ~/.opam/opam-init needed to import state for various shells. If specified, completion and env_hook files can also be written or removed (the default is to keep them as they are) *) val write_static_init_scripts: dirname -> ?completion:bool -> ?env_hook:bool -> unit -> unit (** Write into [OpamPath.hooks_dir] the given custom scripts (listed as (filename, content)), normally provided by opamrc ([OpamFile.InitConfig]) *) val write_custom_init_scripts: dirname -> (string * string) list -> unit (** Update the shell scripts containing the current switch configuration in ~/.opam/opam-init ; prints a warning and skips if a write lock on the global state can't be acquired (note: it would be better to acquire a write lock beforehand, but only when working on the switch selected in ~/.opam/config) *) val write_dynamic_init_scripts: 'a switch_state -> unit (** Removes the dynamic init scripts setting the variables for any given switch. *) val clear_dynamic_init_scripts: rw global_state -> unit (** Print a warning if the environment is not set-up properly. (General message) *) val check_and_print_env_warning: 'a switch_state -> unit opam-2.0.5/src/state/opamRepositoryState.ml0000644000175000017500000002267013511367404017763 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamStd.Op open OpamStateTypes let log fmt = OpamConsole.log "RSTATE" fmt let slog = OpamConsole.slog module Cache = struct type t = { cached_repofiles: (repository_name * OpamFile.Repo.t) list; cached_opams: (repository_name * (package * OpamFile.OPAM.t) list) list; } let check_marshaled_file fd = try let ic = Unix.in_channel_of_descr fd in let this_magic = OpamVersion.magic () in let magic_len = String.length this_magic in let file_magic = let b = Bytes.create magic_len in really_input ic b 0 magic_len; Bytes.to_string b in if not OpamCoreConfig.developer && file_magic <> this_magic then ( log "Bad cache: incompatible magic string %S (expected %S)." file_magic this_magic; None ) else let header = Bytes.create Marshal.header_size in really_input ic header 0 Marshal.header_size; let expected_size = magic_len + Marshal.total_size header 0 in let current_size = in_channel_length ic in if expected_size <> current_size then ( log "Bad cache: wrong length %d (advertised %d)." current_size expected_size; None ) else ( seek_in ic magic_len; Some ic ) with e -> OpamStd.Exn.fatal e; log "Bad cache: %s" (Printexc.to_string e); None let marshal_from_file file fd = let chrono = OpamConsole.timer () in let f ic = let (cache: t) = Marshal.from_channel ic in log "Loaded %a in %.3fs" (slog OpamFilename.to_string) file (chrono ()); let repofiles_map = OpamRepositoryName.Map.of_list cache.cached_repofiles in let repo_opams_map = OpamRepositoryName.Map.map OpamPackage.Map.of_list (OpamRepositoryName.Map.of_list cache.cached_opams) in (repofiles_map, repo_opams_map) in OpamStd.Option.map f (check_marshaled_file fd) let load root = match OpamFilename.opt_file (OpamPath.state_cache root) with | Some file -> let r = OpamFilename.with_flock `Lock_read file @@ fun fd -> marshal_from_file file fd in if r = None then begin log "Invalid cache, removing"; OpamFilename.remove file end; r | None -> None let save rt = if OpamCoreConfig.(!r.safe_mode) then log "Running in safe mode, not upgrading the repository cache" else let chrono = OpamConsole.timer () in let file = OpamPath.state_cache rt.repos_global.root in OpamFilename.with_flock `Lock_write file @@ fun fd -> log "Writing the cache of repository metadata to %s ...\n" (OpamFilename.prettify file); let oc = Unix.out_channel_of_descr fd in output_string oc (OpamVersion.magic ()); (* Repository without remote are not cached, they are intended to be manually edited *) let filter_out_nourl repos_map = OpamRepositoryName.Map.filter (fun name _ -> try (OpamRepositoryName.Map.find name rt.repositories).repo_url <> OpamUrl.empty with Not_found -> false) repos_map in Marshal.to_channel oc { cached_repofiles = OpamRepositoryName.Map.bindings (filter_out_nourl rt.repos_definitions); cached_opams = OpamRepositoryName.Map.bindings (OpamRepositoryName.Map.map OpamPackage.Map.bindings (filter_out_nourl rt.repo_opams)); } [Marshal.No_sharing]; flush oc; log "%a written in %.3fs" (slog OpamFilename.prettify) file (chrono ()) let remove () = let root = OpamStateConfig.(!r.root_dir) in let file = OpamPath.state_cache root in OpamFilename.remove file end let load_repo_opams repo = let t = OpamConsole.timer () in let rec aux r dir = if OpamFilename.exists_dir dir then let fnames = Sys.readdir (OpamFilename.Dir.to_string dir) in if Array.fold_left (fun a f -> a || f = "opam") false fnames then match OpamFileTools.read_opam dir with | Some opam -> (try let nv = OpamPackage.of_string OpamFilename.(Base.to_string (basename_dir dir)) in OpamPackage.Map.add nv opam r with Failure _ -> log "ERR: directory name not a valid package: ignored %s" OpamFilename.(to_string Op.(dir // "opam")); r) | None -> log "ERR: Could not load %s, ignored" OpamFilename.(to_string Op.(dir // "opam")); r else Array.fold_left (fun r name -> aux r OpamFilename.Op.(dir / name)) r fnames else r in let r = aux OpamPackage.Map.empty (OpamRepositoryPath.packages_dir repo.repo_root) in log "loaded opam files from repo %s in %.3fs" (OpamRepositoryName.to_string repo.repo_name) (t ()); r let load lock_kind gt = log "LOAD-REPOSITORY-STATE @ %a" (slog OpamFilename.Dir.to_string) gt.root; let lock = OpamFilename.flock lock_kind (OpamPath.repos_lock gt.root) in let repos_map = OpamFile.Repos_config.safe_read (OpamPath.repos_config gt.root) in let mk_repo name url_opt = { repo_root = OpamRepositoryPath.create gt.root name; repo_name = name; repo_url = OpamStd.Option.Op.((url_opt >>| fst) +! OpamUrl.empty); repo_trust = OpamStd.Option.Op.((url_opt >>= snd)); } in let uncached = (* Don't cache repositories without remote, as they should be editable in-place *) OpamRepositoryName.Map.filter (fun _ url -> url = None) repos_map in let repositories = OpamRepositoryName.Map.mapi mk_repo repos_map in let load_repos_definitions repositories = OpamRepositoryName.Map.map (fun r -> OpamFile.Repo.safe_read OpamRepositoryPath.(repo (create gt.root r.repo_name)) |> OpamFile.Repo.with_root_url r.repo_url) repositories in let make_rt repos_definitions opams = { repos_global = (gt :> unlocked global_state); repos_lock = lock; repositories; repos_definitions; repo_opams = opams; } in match Cache.load gt.root with | Some (repofiles, opams) when OpamRepositoryName.Map.is_empty uncached -> log "Cache found"; make_rt repofiles opams | Some (repofiles, opams) -> log "Cache found, loading repositories without remote only"; OpamFilename.with_flock_upgrade `Lock_read lock @@ fun _ -> let uncached_repos = OpamRepositoryName.Map.mapi mk_repo uncached in let uncached_repofiles = load_repos_definitions uncached_repos in let uncached_opams = OpamRepositoryName.Map.map load_repo_opams uncached_repos in make_rt (OpamRepositoryName.Map.union (fun _ x -> x) repofiles uncached_repofiles) (OpamRepositoryName.Map.union (fun _ x -> x) opams uncached_opams) | None -> log "No cache found"; OpamFilename.with_flock_upgrade `Lock_read lock @@ fun _ -> let repos = OpamRepositoryName.Map.mapi mk_repo repos_map in let rt = make_rt (load_repos_definitions repos) (OpamRepositoryName.Map.map load_repo_opams repos) in Cache.save rt; rt let find_package_opt rt repo_list nv = List.fold_left (function | None -> fun repo_name -> OpamStd.Option.Op.( OpamRepositoryName.Map.find_opt repo_name rt.repo_opams >>= OpamPackage.Map.find_opt nv >>| fun opam -> repo_name, opam ) | some -> fun _ -> some) None repo_list let build_index rt repo_list = List.fold_left (fun acc repo_name -> try let repo_opams = OpamRepositoryName.Map.find repo_name rt.repo_opams in OpamPackage.Map.union (fun a _ -> a) acc repo_opams with Not_found -> (* A repo is unavailable, error should have been already reported *) acc) OpamPackage.Map.empty repo_list let get_repo rt name = OpamRepositoryName.Map.find name rt.repositories let unlock rt = OpamSystem.funlock rt.repos_lock; (rt :> unlocked repos_state) let with_write_lock ?dontblock rt f = let ret, rt = OpamFilename.with_flock_upgrade `Lock_write ?dontblock rt.repos_lock @@ fun _ -> f ({ rt with repos_lock = rt.repos_lock } : rw repos_state) (* We don't actually change the field value, but this makes restricting the phantom lock type possible *) in ret, { rt with repos_lock = rt.repos_lock } let with_ lock gt f = let rt = load lock gt in try let r = f rt in ignore (unlock rt); r with e -> OpamStd.Exn.finalise e (fun () -> ignore (unlock rt)) let write_config rt = OpamFile.Repos_config.write (OpamPath.repos_config rt.repos_global.root) (OpamRepositoryName.Map.map (fun r -> if r.repo_url = OpamUrl.empty then None else Some (r.repo_url, r.repo_trust)) rt.repositories) opam-2.0.5/src/state/opamRepositoryState.mli0000644000175000017500000000533313511367404020131 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** loading and handling of the repository state of an opam root (i.e. what is in ~/.opam/repo) *) open OpamTypes open OpamStateTypes (** Caching of repository loading (marshall of all parsed opam files) *) module Cache: sig val save: [< rw] repos_state -> unit val load: dirname -> (OpamFile.Repo.t repository_name_map * OpamFile.OPAM.t package_map repository_name_map) option val remove: unit -> unit end val load: 'a lock -> [< unlocked ] global_state -> 'a repos_state (** Loads the repository state as [load], and calls the given function while keeping it locked (as per the [lock] argument), releasing the lock afterwards *) val with_: 'a lock -> [< unlocked ] global_state -> ('a repos_state -> 'b) -> 'b (** Returns the repo of origin and metadata corresponding to a package, if found, from a sorted list of repositories (highest priority first) *) val find_package_opt: 'a repos_state -> repository_name list -> package -> (repository_name * OpamFile.OPAM.t) option (** Given the repos state, and a list of repos to use (highest priority first), build a map of all existing package definitions *) val build_index: 'a repos_state -> repository_name list -> OpamFile.OPAM.t OpamPackage.Map.t (** Finds a package repository definition from its name (assuming it's in ROOT/repos/) *) val get_repo: 'a repos_state -> repository_name -> repository (** Load all the metadata within the local mirror of the given repository, without cache *) val load_repo_opams: repository -> OpamFile.OPAM.t OpamPackage.Map.t (** Releases any locks on the given repos_state *) val unlock: 'a repos_state -> unlocked repos_state (** Calls the provided function, ensuring a temporary write lock on the given repository state*) val with_write_lock: ?dontblock:bool -> 'a repos_state -> (rw repos_state -> 'b * rw repos_state) -> 'b * 'a repos_state (** Writes the repositories config file back to disk *) val write_config: rw repos_state -> unit opam-2.0.5/src/client/0000755000175000017500000000000013511367404013523 5ustar nicoonicooopam-2.0.5/src/client/opam-mingw.xmlf0000644000175000017500000000053213511367404016466 0ustar nicoonicoo OCaml Package Manager opam-2.0.5/src/client/opamArg.mli0000644000175000017500000001614013511367404015616 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Command-line argument parsers and helpers *) open OpamTypes open Cmdliner (** {2 Helpers and argument constructors} *) val mk_flag: ?section:string -> string list -> string -> bool Term.t val mk_opt: ?section:string -> ?vopt:'a -> string list -> string -> string -> 'a Arg.converter -> 'a -> 'a Term.t val mk_opt_all: ?section:string -> ?vopt:'a -> ?default:'a list -> string list -> string -> string -> 'a Arg.converter -> 'a list Term.t (** {2 Flags} *) (** --short *) val print_short_flag: bool Term.t (** --installed-root *) val installed_roots_flag: bool Term.t (** --shell *) val shell_opt: shell option Term.t (** --dot-profile *) val dot_profile_flag: filename option Term.t (** --http/ --git/ --local *) val repo_kind_flag: OpamUrl.backend option Term.t (** --jobs *) val jobs_flag: int option Term.t (** package names *) val name_list: name list Term.t (** parameters *) val param_list: string list Term.t (** package list with optional constraints *) val atom_list: OpamFormula.atom list Term.t (** package list with optional constraints *) val nonempty_atom_list: OpamFormula.atom list Term.t val atom_or_local_list: [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list Term.t val atom_or_dir_list: [ `Atom of atom | `Dirname of dirname ] list Term.t (** Generic argument list builder *) val arg_list: string -> string -> 'a Arg.converter -> 'a list Term.t (** Generic argument list builder *) val nonempty_arg_list: string -> string -> 'a Arg.converter -> 'a list Term.t (** {3 Global options} *) (** Type for global options *) type global_options = { debug_level: int option; verbose: int; quiet : bool; color : [ `Always | `Never | `Auto ] option; opt_switch : string option; yes : bool; strict : bool; opt_root : dirname option; git_version : bool; external_solver : string option; use_internal_solver : bool; cudf_file : string option; solver_preferences : string option; best_effort: bool; safe_mode : bool; json : string option; no_auto_upgrade : bool; working_dir : bool; ignore_pin_depends : bool; } (** Global options *) val global_options: global_options Term.t (** Apply global options *) val apply_global_options: global_options -> unit (** {3 Build options} *) (** Abstract type for build options *) type build_options val build_option_section: string (** Build options *) val build_options: build_options Term.t (** Instal and reinstall options *) val assume_built: bool Term.t (** Applly build options *) val apply_build_options: build_options -> unit (** {3 Package listing and filtering options} *) (** Man section name *) val package_selection_section: string (** Build a package selection filter *) val package_selection: OpamListCommand.selector list Term.t (** Man section name *) val package_listing_section: string (** Package selection filter based on the current state of packages (installed, available, etc.) *) val package_listing: (force_all_versions:bool -> OpamListCommand.package_listing_format) Term.t (** {3 Converters} *) (** Repository name converter *) val repository_name: repository_name Arg.converter (** URL converter *) val url: url Arg.converter (** Filename converter *) val filename: filename Arg.converter (** Filename converter also accepting "-" for stdin/stdout *) val existing_filename_or_dash: filename option Arg.converter (** Dirnam converter *) val dirname: dirname Arg.converter val existing_filename_dirname_or_dash: OpamFilename.generic_file option Arg.converter val positive_integer: int Arg.converter (** Package name converter *) val package_name: name Arg.converter (** [name{.version}] (or [name=version]) *) val package: (name * version option) Arg.converter (** [name.version] (or [name=version]) *) val package_with_version: package Arg.converter (** [name{(.|=|!=|>|<|>=|<=)version}] converter*) val atom: atom Arg.converter (** Accepts [atom] but also (explicit) file and directory names *) val atom_or_local: [ `Atom of atom | `Filename of filename | `Dirname of dirname ] Arg.converter val atom_or_dir: [ `Atom of atom | `Dirname of dirname ] Arg.converter (** [var=value,...] argument *) val variable_bindings: (OpamVariable.t * string) list Arg.converter (** Warnings string ["+3..10-4"] *) val warn_selector: (int * bool) list Arg.converter type 'a default = [> `default of string] as 'a (** Enumeration with a default command *) val enum_with_default: (string * 'a default) list -> 'a Arg.converter val opamlist_columns: OpamListCommand.output_format list Arg.converter (** {2 Subcommands} *) type 'a subcommand = string * 'a * string list * string (** A subcommand [cmds, v, args, doc] is the subcommand [cmd], using the documentation [doc] and the list of documentation parameters [args]. If the subcommand is selected, return [v]. *) type 'a subcommands = 'a subcommand list val mk_subcommands: 'a subcommands -> 'a option Term.t * string list Term.t (** [subcommands cmds] are the terms [cmd] and [params]. [cmd] parses which sub-commands in [cmds] is selected and [params] parses the remaining of the command-line parameters as a list of strings. *) val mk_subcommands_with_default: 'a default subcommands -> 'a option Term.t * string list Term.t (** Same as {!mk_subcommand} but use the default value if no sub-command is selected. *) val make_command_alias: 'a Term.t * Term.info -> ?options:string -> string -> 'a Term.t * Term.info (** Create an alias for an existing command. [options] can be used to add extra options after the original command in the doc (eg like `unpin` is an alias for `pin remove`). *) val bad_subcommand: 'a default subcommands -> (string * 'a option * string list) -> 'b Term.ret (** [bad_subcommand cmds cmd] is a command return value denoting a parsing error of sub-commands. *) val mk_subdoc : ?defaults:(string * string) list -> 'a subcommands -> Manpage.block list (** [mk_subdoc cmds] is the documentation block for [cmds]. *) (** {2 Misc} *) val deprecated_option: 'a -> 'a -> string -> string option -> unit (** [deprecated_option option default name instead] displays a message if [option] if set to its non [default] value. [instead], if present, is the new option/command to launch *) (** {2 Documentation} *) val global_option_section: string val help_sections: Manpage.block list val term_info: string -> doc:string -> man:Manpage.block list -> Term.info opam-2.0.5/src/client/opamClientConfig.ml0000644000175000017500000001273513511367404017306 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type t = { print_stats: bool; pin_kind_auto: bool; autoremove: bool; editor: string; keep_build_dir: bool; reuse_build_dir: bool; inplace_build: bool; working_dir: bool; ignore_pin_depends: bool; show: bool; fake: bool; skip_dev_update: bool; json_out: string option; root_is_ok: bool; no_auto_upgrade: bool; } let default = { print_stats = false; pin_kind_auto = true; autoremove = false; editor = "nano"; keep_build_dir = false; reuse_build_dir = false; inplace_build = false; working_dir = false; ignore_pin_depends = false; show = false; fake = false; skip_dev_update = false; json_out = None; root_is_ok = false; no_auto_upgrade = false; } type 'a options_fun = ?print_stats:bool -> ?pin_kind_auto:bool -> ?autoremove:bool -> ?editor:string -> ?keep_build_dir:bool -> ?reuse_build_dir:bool -> ?inplace_build:bool -> ?working_dir:bool -> ?ignore_pin_depends:bool -> ?show:bool -> ?fake:bool -> ?skip_dev_update:bool -> ?json_out:string option -> ?root_is_ok:bool -> ?no_auto_upgrade:bool -> 'a let setk k t ?print_stats ?pin_kind_auto ?autoremove ?editor ?keep_build_dir ?reuse_build_dir ?inplace_build ?working_dir ?ignore_pin_depends ?show ?fake ?skip_dev_update ?json_out ?root_is_ok ?no_auto_upgrade = let (+) x opt = match opt with Some x -> x | None -> x in k { print_stats = t.print_stats + print_stats; pin_kind_auto = t.pin_kind_auto + pin_kind_auto; autoremove = t.autoremove + autoremove; editor = t.editor + editor; keep_build_dir = t.keep_build_dir + keep_build_dir; reuse_build_dir = t.reuse_build_dir + reuse_build_dir; inplace_build = t.inplace_build + inplace_build; working_dir = t.working_dir + working_dir; ignore_pin_depends = t.ignore_pin_depends + ignore_pin_depends; show = t.show + show; fake = t.fake + fake; skip_dev_update = t.skip_dev_update + skip_dev_update; json_out = t.json_out + json_out; root_is_ok = t.root_is_ok + root_is_ok; no_auto_upgrade = t.no_auto_upgrade + no_auto_upgrade; } let set t = setk (fun x () -> x) t let r = ref default let update ?noop:_ = setk (fun cfg () -> r := cfg) !r let initk k = let open OpamStd.Config in let open OpamStd.Option.Op in let editor = env_string "EDITOR" ++ OpamStd.Env.(getopt "VISUAL" ++ getopt "EDITOR") in setk (setk (fun c -> r := c; k)) !r ?print_stats:(env_bool "STATS") ?pin_kind_auto:(env_bool "PINKINDAUTO") ?autoremove:(env_bool "AUTOREMOVE") ?editor ?keep_build_dir:(env_bool "KEEPBUILDDIR") ?reuse_build_dir:(env_bool "REUSEBUILDDIR") ?inplace_build:(env_bool "INPLACEBUILD") ?working_dir:(env_bool "WORKINGDIR") ?ignore_pin_depends:(env_bool "IGNOREPINDEPENDS") ?show:(env_bool "SHOW") ?fake:(env_bool "FAKE") ?skip_dev_update:(env_bool "SKIPUPDATE") ?json_out:(env_string "JSON" >>| function "" -> None | s -> Some s) ?root_is_ok:(env_bool "ROOTISOK") ?no_auto_upgrade:(env_bool "NOAUTOUPGRADE") let init ?noop:_ = initk (fun () -> ()) let search_files = ["findlib"] open OpamStd.Op let opam_init ?root_dir ?strict = let open OpamStd.Option.Op in (* (i) get root dir *) let root = OpamStateConfig.opamroot ?root_dir () in (* (ii) load conf file and set defaults *) (* the init for OpamFormat is done in advance since (a) it has an effect on loading the global config (b) the global config has no effect on it *) OpamFormatConfig.initk ?strict @@ fun ?log_dir -> let config = OpamStateConfig.load_defaults root in let initialised = config <> None in (* !X fixme: don't drop the loaded config file to reload it afterwards (when loading the global_state) like that... *) begin match config with | None -> () | Some conf -> let criteria kind = let c = OpamFile.Config.criteria conf in try Some (List.assoc kind c) with Not_found -> None in OpamSolverConfig.update ?solver:(OpamFile.Config.solver conf >>| fun s -> lazy(OpamCudfSolver.custom_solver s)) ?solver_preferences_default:(criteria `Default >>| fun s-> lazy(Some s)) ?solver_preferences_upgrade:(criteria `Upgrade >>| fun s-> lazy(Some s)) ?solver_preferences_fixup:(criteria `Fixup >>| fun s -> lazy (Some s)) ?solver_preferences_best_effort_prefix: (OpamFile.Config.best_effort_prefix conf >>| fun s -> lazy (Some s)) () end; (* (iii) load from env and options using OpamXxxConfig.init *) let log_dir = if log_dir = None && initialised then Some OpamFilename.(Dir.to_string (OpamPath.log root)) else None in (fun () -> ()) |> OpamStd.Config.initk ?log_dir |> OpamRepositoryConfig.initk |> OpamSolverConfig.initk |> OpamStateConfig.initk ~root_dir:root |> initk opam-2.0.5/src/client/opamAdminRepoUpgrade.mli0000644000175000017500000000154413511367404020275 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) val clear_cache: unit -> unit val upgradeto_version: OpamVersion.t val do_upgrade: OpamTypes.dirname -> unit val do_upgrade_mirror: OpamTypes.dirname -> OpamUrl.t -> unit opam-2.0.5/src/client/opamAuxCommands.mli0000644000175000017500000001074313511367404017327 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Some command helpers, and auxiliary opam management functions used by the CLI *) open OpamTypes open OpamStateTypes (** Gets the file changes done in the installation of the given packages in the given switch, and copies the corresponding files to the same relative paths below the given prefix ; files that are not current according to the recorded package changes print warnings and aren't copied. *) val copy_files_to_destdir: 'a switch_state -> dirname -> package_set -> unit (** Removes all files that may have been installed by [copy_files_to_destdir]; it's more aggressive than [OpamDirTrack.revert] and doesn't check if the files are current. *) val remove_files_from_destdir: 'a switch_state -> dirname -> package_set -> unit (** If the URL points to a local, version-controlled directory, qualify it by suffixing `#current-branch` if no branch/tag/hash was specified. *) val url_with_local_branch: url -> url (** From an in-source opam file, return the corresponding package name if it can be found, and the corresponding source directory *) val name_and_dir_of_opam_file: filename -> name option * dirname (** Resolves the opam files and directories in the list to package name and location, and returns the corresponding pinnings and atoms. May fail and exit if package names for provided [`Filename] could not be inferred, or if the same package name appears multiple times. *) val resolve_locals: ?quiet:bool -> [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> (name * OpamUrl.t * OpamFile.OPAM.t OpamFile.t) list * atom list (** Resolves the opam files and directories in the list to package name and location, according to what is currently pinned, and returns the corresponding list of atoms. Prints warnings for directories where nothing is pinned, or opam files corresponding to no pinned package. *) val resolve_locals_pinned: 'a switch_state -> [ `Atom of atom | `Dirname of dirname ] list -> atom list (** Resolves the opam files in the list to package name and location, pins the corresponding packages accordingly if necessary, otherwise updates them, and returns the resolved atom list. With [simulate], don't do the pinnings but return the switch state with the package definitions that would have been obtained if pinning. Also synchronises the specified directories, that is, unpins any package pinned there but not current (no more corresponding opam file). This also handles [pin-depends:] of the local packages. That part is done even if [simulate] is [true]. *) val autopin: rw switch_state -> ?simulate:bool -> ?quiet:bool -> [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> rw switch_state * atom list (** The read-only version of [autopin ~simulate:true]: this doesn't require a write-locked switch, and doesn't update the local packages. [for_view] will result in the switch state containing more accurate information to be displayed to the user, but should never be flushed to disk because ; without that option, the state can safely be worked with and will just contain the proper package definitions *) val simulate_autopin: 'a switch_state -> ?quiet:bool -> ?for_view:bool -> [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> 'a switch_state * atom list (** Scans for package definition files in a directory, and selects a compiler that is compatible with them from the configured default compiler list, or that is unambiguously selected by the package definitions. Returns the corresponding atoms. If no compiler matches, prints a warning, and returns the empty list after user confirmation. *) val get_compatible_compiler: ?repos:repository_name list -> 'a repos_state -> dirname -> atom list * bool opam-2.0.5/src/client/dune0000644000175000017500000000300413511367404014376 0ustar nicoonicoo(library (name opam_client) (public_name opam-client) (synopsis "OCaml Package Manager client and CLI library") (modules (:standard \ opamMain opamManifest get-git-version)) (libraries opam-state opam-solver re cmdliner) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (wrapped false)) (executable (name opamMain) (public_name opam) (package opam) (modules opamMain opamManifest) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp) (:include linking.sexp))) (link_flags (:include manifest.sexp)) (libraries opam-client)) (rule (targets manifest.sexp) (deps (:script ../../shell/subst_var.ml) ../../config.status (:input manifest.sexp.in)) (action (with-stdout-to %{targets} (run ocaml %{script} CONF_MANIFEST_O "" %{input})))) (include opamManifest.inc) (include manifest.inc) (rule (targets git-sha) (deps (universe)) (action (ignore-stderr (with-stdout-to %{targets} (system "git rev-parse --quiet --verify HEAD || echo ."))))) (rule (with-stdout-to get-git-version.ml (echo "print_string @@ let v = \"%{read-lines:git-sha}\" in if v = \".\" then \"let version = None\" else \"let version = Some \\\"\" ^ v ^ \"\\\"\""))) (rule (with-stdout-to opamGitVersion.ml (run ocaml %{dep:get-git-version.ml}))) (rule (with-stdout-to linking.sexp (run echo "()"))) opam-2.0.5/src/client/opamAction.mli0000644000175000017500000000622313511367404016323 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Handles concrete actions on packages, like installations and removals *) open OpamTypes open OpamStateTypes (** [download t pkg] downloads the source of the package [pkg] into its locally cached source dir. Returns [Some (short_errmsg option, long_errmsg)] on error, [None] on success. See {!OpamTypes.Not_available}. This doesn't update dev packages that already have a locally cached source. *) val download_package: rw switch_state -> package -> (string option * string) option OpamProcess.job (** [prepare_package_source t pkg dir] updates the given source [dir] with the extra downloads, overlays and patches from the package's metadata applied. *) val prepare_package_source: rw switch_state -> package -> dirname -> exn option OpamProcess.job (** [build_package t build_dir pkg] builds the package [pkg] within [build_dir]. Returns [None] on success, [Some exn] on error. See {!download_package} and {!prepare_package_source} for the previous steps. *) val build_package: rw switch_state -> ?test:bool -> ?doc:bool -> dirname -> package -> exn option OpamProcess.job (** [install_package t pkg] installs an already built package. Returns [None] on success, [Some exn] on error. Do not update OPAM's metadata. See {!build_package} to build the package. *) val install_package: rw switch_state -> ?test:bool -> ?doc:bool -> ?build_dir:dirname -> package -> exn option OpamProcess.job (** Find out if the package source is needed for uninstall *) val removal_needs_download: 'a switch_state -> package -> bool (** Removes a package. If [changes] is unspecified, it is read from the package's change file. if [force] is specified, remove files marked as added in [changes] even if the files have been modified since. *) val remove_package: rw switch_state -> ?silent:bool -> ?changes:OpamDirTrack.t -> ?force:bool -> ?build_dir:dirname -> package -> unit OpamProcess.job (** Returns [true] whenever [remove_package] is a no-op. *) val noop_remove_package: rw switch_state -> package -> bool (** Removes auxiliary files related to a package, after checking that they're not needed *) val cleanup_package_artefacts: rw switch_state -> package -> unit (** Compute the set of packages which will need to be downloaded to apply a solution. Takes a graph of atomic actions. *) val sources_needed: 'a switch_state -> OpamSolver.ActionGraph.t -> package_set opam-2.0.5/src/client/opam-mingw64.xmlf0000644000175000017500000000054013511367404016637 0ustar nicoonicoo OCaml Package Manager opam-2.0.5/src/client/opamAdminCheck.mli0000644000175000017500000000335013511367404017072 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017-2018 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes (** Analyses a given package universe, and returns [uninstallable_roots,uninstallable]. The first is a subset of the second, where internal dependents have been removed. *) val installability_check: universe -> package_set * package_set (** Analyses a universe for dependency cycles. Returns the set of packages involved, and the cycles (reduced to formula lists) *) val cycle_check: universe -> package_set * formula list list (** Runs checks on the repository at the given repository. Returns [all_packages], [uninstallable_roots], [uninstallable], [cycle_packages], [obsolete_packages]. If the corresponding option was disabled, the returned sets are empty. *) val check: quiet:bool -> installability:bool -> cycles:bool -> obsolete:bool -> ignore_test:bool -> dirname -> package_set * package_set * package_set * package_set * package_set (** Returns a subset of "obsolete" packages, i.e. packages for which a strictly better version exists *) val get_obsolete: universe -> OpamFile.OPAM.t package_map -> package_set opam-2.0.5/src/client/opamClient.ml0000644000175000017500000015056213511367404016161 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamStd.Op open OpamPackage.Set.Op let log fmt = OpamConsole.log "CLIENT" fmt let slog = OpamConsole.slog (* When packages are removed from upstream, they normally disappear from the 'available' packages set and can't be seen by the solver anymore. This is a problem for several reasons, so we compute the set of orphan packages here: - they are checked for conflicts with the user request - they are re-added to the universe if (transitively) unrelated to the request (the [changes] parameter) - they are otherwise put in [wish_remove] in case we use the internal solver This function separates full orphans (no version of the package available anymore) from orphan versions, because they have a different impact on the request (needs version change VS needs uninstall). See also preprocess_request and check_conflicts *) let orphans ?changes ?(transitive=false) t = let all = t.packages ++ t.installed in let allnames = OpamPackage.names_of_packages all in let universe = OpamSwitchState.universe t ~requested:OpamPackage.Name.Set.empty Reinstall in (* Basic definition of orphan packages *) let orphans = t.installed -- Lazy.force t.available_packages in (* Restriction to the request-related packages *) let changes = match changes with | None -> None | Some ch -> Some (OpamPackage.Name.Set.fold (fun name ch -> try OpamPackage.Set.add (OpamPackage.package_of_name t.installed name) ch with Not_found -> ch) (OpamPackage.names_of_packages ch) ch) in let orphans = match changes with | None -> orphans | Some ch -> if OpamPackage.Set.is_empty orphans then orphans else let recompile_cone = OpamPackage.Set.of_list @@ OpamSolver.reverse_dependencies ~depopts:true ~installed:true ~unavailable:true ~build:true ~post:false universe ch in orphans %% recompile_cone in (* Pinned versions of packages remain always available *) let orphans = orphans -- OpamPinned.packages t in (* Splits between full orphans (no version left) and partial ones *) let full_partition orphans = let orphan_names = (* names for which there is no version left *) OpamPackage.Name.Set.diff allnames (OpamPackage.names_of_packages (all -- orphans)) in OpamPackage.Set.partition (fun nv -> OpamPackage.Name.Set.mem nv.name orphan_names) orphans in let full_orphans, orphan_versions = full_partition orphans in (* Closure *) let full_orphans, orphan_versions = if not transitive then full_orphans, orphan_versions else let rec add_trans full_orphans orphan_versions = (* fixpoint to check all packages with no available version *) let new_orphans = OpamPackage.Set.of_list @@ OpamSolver.reverse_dependencies ~depopts:false ~installed:false ~unavailable:true ~build:true ~post:false universe full_orphans in let full, versions = full_partition (new_orphans++orphan_versions) in if OpamPackage.Set.equal full_orphans full then full, versions else add_trans full versions in add_trans full_orphans orphan_versions in (* Installed packages outside the set of changes are otherwise safe: re-add them to the universe *) let t = if changes = None then t else let available_packages = lazy (Lazy.force t.available_packages ++ (t.installed -- orphans)) in { t with available_packages } in log "Orphans: (changes: %a, transitive: %b) -> full %a, versions %a" (slog @@ OpamStd.Option.to_string OpamPackage.Set.to_string) changes transitive (slog @@ OpamPackage.Name.Set.to_string @* OpamPackage.names_of_packages) full_orphans (slog OpamPackage.Set.to_string) orphan_versions; t, full_orphans, orphan_versions (* Splits a list of atoms into the installed and uninstalled ones*) let get_installed_atoms t atoms = List.fold_left (fun (packages, not_installed) atom -> try let nv = OpamPackage.Set.find (OpamFormula.check atom) t.installed in nv :: packages, not_installed with Not_found -> packages, atom :: not_installed) ([],[]) atoms (* Check atoms for pinned packages, and update them. Returns the state that may have been reloaded if there were changes *) let update_dev_packages_t atoms t = (* Check last update of the repo *) let last_update = (Unix.stat (OpamFilename.to_string (OpamPath.state_cache (OpamStateConfig.(!r.root_dir))))).Unix.st_mtime in let too_old = float_of_int (3600*24*21) in if (Unix.time () -. last_update) > too_old then OpamConsole.note "It seems you have not updated your repositories \ for a while. Consider updating them with:\n%s\n" (OpamConsole.colorise `bold "opam update"); if OpamClientConfig.(!r.skip_dev_update) then t else let working_dir = OpamClientConfig.(!r.working_dir) in let to_update = List.fold_left (fun to_update (name,_) -> try let nv = OpamPackage.package_of_name t.pinned name in if OpamSwitchState.is_dev_package t nv then OpamPackage.Set.add nv to_update else to_update with Not_found -> to_update) OpamPackage.Set.empty atoms in if OpamPackage.Set.is_empty to_update then t else ( OpamConsole.header_msg "Synchronising pinned packages"; try let working_dir = if working_dir then Some (OpamSwitchState.packages_of_atoms t atoms) else None in let _success, t, _pkgs = OpamUpdate.dev_packages t ?working_dir to_update in OpamConsole.msg "\n"; t with e -> OpamStd.Exn.fatal e; OpamConsole.msg "\n"; t ) let compute_upgrade_t ?(strict_upgrade=true) ?(auto_install=false) ~all atoms t = let names = OpamPackage.Name.Set.of_list (List.rev_map fst atoms) in let atoms = List.map (function | (n,None) when strict_upgrade -> (* force strict upgrade for unchanged, non dev or pinned packages (strict update makes no sense for pinned packages which have a fixed version) *) (try let nv = OpamSwitchState.find_installed_package_by_name t n in if OpamSwitchState.is_dev_package t nv || OpamPackage.has_name t.pinned n || OpamPackage.Set.mem nv t.reinstall then (n, None) else let atom = (n, Some (`Gt, nv.version)) in if OpamPackage.Set.exists (OpamFormula.check atom) (Lazy.force t.available_packages) then atom else (n, None) with Not_found -> (n,None)) | atom -> atom ) atoms in let requested_installed, not_installed = List.fold_left (fun (packages, not_installed) (n,_ as atom) -> try let nv = OpamPackage.Set.find (fun nv -> nv.name = n) t.installed in OpamPackage.Set.add nv packages, not_installed with Not_found -> packages, atom :: not_installed) (OpamPackage.Set.empty,[]) atoms in let to_install = if not_installed = [] then [] else if auto_install || OpamConsole.confirm "%s %s not installed. Install %s?" (OpamStd.Format.pretty_list (List.rev_map OpamFormula.short_string_of_atom not_installed)) (match not_installed with [_] -> "is" | _ -> "are") (match not_installed with [_] -> "it" | _ -> "them") then not_installed else [] in if all then let t, full_orphans, orphan_versions = orphans ~transitive:true t in let to_upgrade = t.installed -- full_orphans in names, OpamSolution.resolve t Upgrade ~orphans:(full_orphans ++ orphan_versions) ~requested:names ~reinstall:t.reinstall (OpamSolver.request ~install:to_install ~upgrade:(OpamSolution.atoms_of_packages to_upgrade) ~criteria:`Upgrade ()) else let changes = requested_installed ++ OpamSwitchState.packages_of_atoms t to_install in let t, full_orphans, orphan_versions = orphans ~changes t in let to_remove = requested_installed %% full_orphans in let to_upgrade = requested_installed -- full_orphans in let upgrade_atoms = (* packages corresponds to the currently installed versions. Not what we are interested in, recover the original atom constraints *) List.map (fun nv -> let name = nv.name in try name, List.assoc name atoms with Not_found -> name, None) (OpamPackage.Set.elements to_upgrade) in names, OpamSolution.resolve t Upgrade ~orphans:(full_orphans ++ orphan_versions) ~requested:names (OpamSolver.request ~install:to_install ~remove:(OpamSolution.atoms_of_packages to_remove) ~upgrade:upgrade_atoms ()) let upgrade_t ?strict_upgrade ?auto_install ?ask ?(check=false) ?(terse=false) ~all atoms t = log "UPGRADE %a" (slog @@ function [] -> "" | a -> OpamFormula.string_of_atoms a) atoms; match compute_upgrade_t ?strict_upgrade ?auto_install ~all atoms t with | requested, Conflicts cs -> log "conflict!"; if not (OpamPackage.Name.Set.is_empty requested) then (OpamConsole.msg "%s" (OpamCudf.string_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs); OpamStd.Sys.exit_because `No_solution); let reasons, chains, cycles = OpamCudf.strings_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs in if cycles <> [] then begin OpamConsole.error "Dependency errors in the upgrade actions. Please update, and \ report the following to the package maintainers if the error \ persists:"; OpamConsole.errmsg "%s\n%s\n" (OpamStd.Format.itemize (fun x -> x) cycles) "You may try upgrading packages individually to work around this." end else begin OpamConsole.warning "Upgrade is not possible because of conflicts or packages that \ are no longer available:"; OpamConsole.errmsg "%s" (OpamStd.Format.itemize (fun x -> x) reasons); if chains <> [] then OpamConsole.errmsg "The following dependencies are the cause:\n%s" (OpamStd.Format.itemize (fun x -> x) chains); OpamConsole.errmsg "\nYou may run \"opam upgrade --fixup\" to let opam fix the \ current state.\n" end; OpamStd.Sys.exit_because `No_solution | requested, Success solution -> if check then OpamStd.Sys.exit_because (if OpamSolver.solution_is_empty solution then `False else `Success) else let t, result = OpamSolution.apply ?ask t Upgrade ~requested solution in if result = Nothing_to_do then ( let to_check = if OpamPackage.Name.Set.is_empty requested then t.installed else OpamPackage.packages_of_names t.installed requested in let latest = OpamPackage.Name.Set.fold (fun name acc -> OpamPackage.Set.add (OpamPackage.max_version t.packages name) acc) (OpamPackage.names_of_packages to_check) OpamPackage.Set.empty in let notuptodate = latest -- to_check in if OpamPackage.Set.is_empty notuptodate then OpamConsole.msg "Already up-to-date.\n" else if terse then OpamConsole.msg "No package build needed.\n" else (let hdmsg = "Everything as up-to-date as possible" in let unav = notuptodate -- Lazy.force t.available_packages in let unopt = notuptodate %% Lazy.force t.available_packages in let base = OpamPackage.packages_of_names unopt (OpamPackage.names_of_packages t.compiler_packages) in let unopt = unopt -- base in let conflicts = let get_formula pkg = OpamStd.Option.map (fun opam -> OpamFilter.filter_formula ~default:false (OpamPackageVar.resolve_switch ~package:pkg t) (OpamFile.OPAM.conflicts opam)) (OpamSwitchState.opam_opt t pkg) in OpamPackage.Set.fold (fun unopt_pkg map -> let set = OpamSwitchState.conflicts_with t (OpamPackage.Set.singleton unopt_pkg) latest in OpamPackage.Set.fold (fun installed_pkg map -> match get_formula installed_pkg with | None -> map | Some conflicts_formula -> OpamFormula.fold_left (fun map (n,formula) -> if OpamPackage.name unopt_pkg = n && OpamFormula.check_version_formula formula (OpamPackage.version unopt_pkg) then OpamPackage.Map.update unopt_pkg (OpamStd.List.cons (installed_pkg, formula)) [] map else map ) map conflicts_formula ) set map ) unopt OpamPackage.Map.empty in (* First, folding on [latest] packages: for each one, check if a [unopt] package does not verify [latest] package dependency formula *) let incompatibilities = let get_formula pkg = OpamStd.Option.map (OpamPackageVar.all_depends t) (OpamSwitchState.opam_opt t pkg) in OpamPackage.Set.fold (fun latest_pkg map -> match get_formula latest_pkg with | None -> map | Some depends_formula -> OpamPackage.Set.fold (fun unopt_pkg map -> OpamFormula.fold_left (fun map (n, formula) -> if OpamPackage.name unopt_pkg = n && formula <> OpamFormula.Empty && not (OpamFormula.check_version_formula formula (OpamPackage.version unopt_pkg)) then OpamPackage.Map.update unopt_pkg (OpamStd.List.cons (latest_pkg, formula)) [] map else map ) map depends_formula ) unopt map ) latest OpamPackage.Map.empty in if (OpamConsole.verbose ()) && not (OpamPackage.Set.is_empty unav) then (OpamConsole.formatted_msg "%s.\n\ The following newer versions couldn't be installed:\n" hdmsg; OpamConsole.msg "%s" (OpamStd.Format.itemize (fun p -> Printf.sprintf "%s.%s: %s" (OpamConsole.colorise `bold (OpamPackage.name_to_string p)) (OpamPackage.version_to_string p) (OpamSwitchState.unavailable_reason t ~default:"unavailable for unknown reasons (this may \ be a bug in opam)" (OpamPackage.name p, Atom (`Eq, OpamPackage.version p)))) (OpamPackage.Set.elements unav))) else OpamConsole.formatted_msg "%s (run with --verbose to show unavailable upgrades).\n" hdmsg; if not (OpamPackage.Set.is_empty unopt) then (let bullet = OpamConsole.(colorise `red (utf8_symbol Symbols.asterisk_operator "--")) ^ " " in let string_dep pkg map reason = List.fold_right (fun (p, f) acc -> Printf.sprintf "%s\n%s%s is installed and %s %s" acc bullet (OpamPackage.to_string p) reason (OpamFormula.to_string (Atom (pkg.name, f))) ) (OpamStd.Option.default [] (OpamPackage.Map.find_opt pkg map)) "" in OpamConsole.formatted_msg "\nThe following packages are not being upgraded because the new \ versions conflict with other installed packages:\n"; OpamConsole.msg "%s" (OpamStd.Format.itemize (fun pkg -> Printf.sprintf "%s.%s%s%s" (OpamConsole.colorise `bold (OpamPackage.name_to_string pkg)) (OpamPackage.version_to_string pkg) (string_dep pkg incompatibilities "requires") (string_dep pkg conflicts "conflicts with") ) (OpamPackage.Set.elements unopt)) ); OpamConsole.formatted_msg "However, you may \"opam upgrade\" these packages explicitly, \ which will ask permission to downgrade or uninstall the \ conflicting packages.\n"; ) ); OpamSolution.check_solution t result; t let upgrade t ?check ~all names = let atoms = OpamSolution.sanitize_atom_list t names in let t = update_dev_packages_t atoms t in upgrade_t ?check ~strict_upgrade:(not all) ~all atoms t let fixup t = log "FIXUP"; let t, full_orphans, orphan_versions = orphans ~transitive:true t in let all_orphans = full_orphans ++ orphan_versions in let resolve pkgs = pkgs, OpamSolution.resolve t Upgrade ~orphans:all_orphans ~requested:(OpamPackage.names_of_packages pkgs) (OpamSolver.request ~install:(OpamSolution.atoms_of_packages pkgs) ~criteria:`Fixup ()) in let is_success = function | _, Success _ -> true | _, Conflicts cs -> log "conflict: %a" (slog (OpamCudf.string_of_conflict t.packages @@ OpamSwitchState.unavailable_reason t)) cs; false in let requested, solution = let s = log "fixup-1/ keep installed packages with orphaned versions and roots"; resolve (t.installed_roots %% t.installed -- full_orphans ++ orphan_versions) in if is_success s then s else let s = log "fixup-2/ keep just roots"; resolve (t.installed_roots %% t.installed -- full_orphans) in if is_success s then s else let s = log "fixup-3/ keep packages with orphaned versions"; resolve orphan_versions in if is_success s then s else let s = log "fixup-4/ last resort: no constraints. This should never fail"; resolve OpamPackage.Set.empty in s (* Could still fail with uninstallable base packages actually, but we can only fix so far *) in let t, result = match solution with | Conflicts cs -> (* ouch... *) OpamConsole.error "It appears that the base packages for this switch are no longer \ available. Either fix their prerequisites or change them through \ 'opam list --base' and 'opam switch set-base'."; OpamConsole.errmsg "%s" (OpamCudf.string_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs); t, No_solution | Success solution -> let _, req_rm, _ = orphans ~transitive:false t in OpamSolution.apply ~ask:true t Upgrade ~requested:(OpamPackage.names_of_packages (requested ++ req_rm)) solution in OpamSolution.check_solution t result; t let update gt ~repos_only ~dev_only ?(all=false) names = log "UPDATE %a" (slog @@ String.concat ", ") names; let rt = OpamRepositoryState.load `Lock_none gt in let st, repos_only = match OpamStateConfig.get_switch_opt () with | None -> OpamSwitchState.load_virtual gt rt, true | Some sw -> OpamSwitchState.load `Lock_none gt rt sw, repos_only in let repo_names = let all_repos = OpamRepositoryName.Map.keys rt.repositories in if dev_only then [] else if names <> [] then List.filter (fun r -> List.mem (OpamRepositoryName.to_string r) names) all_repos else if all then all_repos else OpamSwitchState.repos_list st in let packages, ignore_packages = if repos_only then OpamPackage.Set.empty, OpamPackage.Set.empty else let packages = st.installed ++ st.pinned in let packages = if names = [] then packages else OpamPackage.Set.filter (fun nv -> let name = OpamPackage.Name.to_string nv.name in let pkg = OpamPackage.to_string nv in List.exists (fun s -> s = name || s = pkg) names && let pinned = OpamPinned.package_opt st nv.name in pinned = None || pinned = Some nv ) packages in let dev_packages, nondev_packages = OpamPackage.Set.partition (OpamSwitchState.is_dev_package st) packages in let dev_packages = dev_packages -- (st.compiler_packages -- st.pinned) in let nondev_packages = if names = [] || OpamPackage.Set.is_empty nondev_packages then OpamPackage.Set.empty else (OpamConsole.warning "The following are not development packages (no dynamic or version \ controlled upstream) and can't be updated individually: %s\n\ You may want to update your repositories with just %s or to \ upgrade your package%s with %s %s" (OpamStd.List.concat_map ", " ~last_sep:"and" OpamPackage.to_string (OpamPackage.Set.elements nondev_packages)) (OpamConsole.colorise `bold "opam update") (if OpamPackage.Set.is_singleton nondev_packages then "" else "s") (OpamConsole.colorise `bold "opam upgrade") (OpamConsole.colorise `bold (OpamStd.List.concat_map " " OpamPackage.name_to_string (OpamPackage.Set.elements nondev_packages))); nondev_packages) in let dirty_dev_packages, dev_packages = if names <> [] then OpamPackage.Set.empty, dev_packages else OpamPackage.Set.partition (fun nv -> let src_cache = OpamSwitchState.source_dir st nv in let cache_url = OpamUrl.of_string (OpamFilename.Dir.to_string src_cache) in match OpamSwitchState.primary_url st nv with | Some { OpamUrl.backend = #OpamUrl.version_control as vc; _ } -> OpamProcess.Job.run @@ OpamRepository.is_dirty { cache_url with OpamUrl.backend = vc } | _ -> false) dev_packages in OpamPackage.Set.iter (fun nv -> OpamConsole.note "%s has previously been updated with --working-dir, \ not resetting unless explicitly selected" (OpamPackage.to_string nv)) dirty_dev_packages; dev_packages, nondev_packages in let remaining = let ps = packages ++ ignore_packages in List.filter (fun n -> not ( List.mem (OpamRepositoryName.of_string n) repo_names || (try OpamPackage.has_name ps (OpamPackage.Name.of_string n) with Failure _ -> false) || (try OpamPackage.Set.mem (OpamPackage.of_string n) ps with Failure _ -> false) )) names in if remaining <> [] then OpamConsole.error "Unknown repositories or installed packages: %s" (String.concat ", " remaining); (* Do the updates *) let rt_before = rt in let repo_update_failure, rt = if repo_names = [] then [], rt else OpamRepositoryState.with_write_lock rt @@ fun rt -> OpamConsole.header_msg "Updating package repositories"; OpamRepositoryCommand.update_with_auto_upgrade rt repo_names in let repo_changed = not (OpamRepositoryName.Map.equal (OpamPackage.Map.equal (OpamFile.OPAM.effectively_equal)) rt_before.repo_opams rt.repo_opams) in (* st is still based on the old rt, it's not a problem at this point, but don't return it *) let (dev_update_success, dev_changed), _st = if OpamPackage.Set.is_empty packages then (true, false), st else OpamSwitchState.with_write_lock st @@ fun st -> OpamConsole.header_msg "Synchronising development packages"; let success, st, updates = OpamUpdate.dev_packages st packages in if OpamClientConfig.(!r.json_out <> None) then OpamJson.append "dev-packages-updates" (OpamPackage.Set.to_json updates); (success, not (OpamPackage.Set.is_empty updates)), st in repo_update_failure = [] && dev_update_success && remaining = [] && OpamPackage.Set.is_empty ignore_packages, repo_changed || dev_changed, rt let init_checks ?(hard_fail_exn=true) init_config = (* Check for the external dependencies *) let check_external_dep name = OpamSystem.resolve_command name <> None in OpamConsole.msg "Checking for available remotes: "; let repo_types = ["rsync", "rsync and local"; "git", "git"; "hg", "mercurial"; "darcs", "darcs"] in let available_repos, unavailable_repos = List.partition (check_external_dep @* fst) repo_types in OpamConsole.msg "%s.%s\n" (match available_repos with | [] -> "none" | r -> String.concat ", " (List.map snd r)) (if unavailable_repos = [] then " Perfect!" else "\n" ^ OpamStd.Format.itemize (fun (cmd,msg) -> Printf.sprintf "you won't be able to use %s repositories unless you \ install the %s command on your system." msg (OpamConsole.colorise `bold cmd)) unavailable_repos); let soft_fail = if OpamCudfSolver.has_builtin_solver () then false else let external_solvers = ["aspcud"; "packup"; "mccs"] in if not (List.exists check_external_dep external_solvers) then (OpamConsole.error "No external solver found. You should get one of %s, or use a \ version of opam compiled with a built-in solver (see \ http://opam.ocaml.org/doc/External_solvers.html for \ details)" (OpamStd.Format.pretty_list ~last:"or" (List.map (OpamConsole.colorise `bold) external_solvers)); true) else false in let env v = let vs = OpamVariable.Full.variable v in OpamStd.Option.Op.(OpamStd.Option.of_Not_found (List.assoc vs) OpamSysPoll.variables >>= Lazy.force) in let filter_tools = OpamStd.List.filter_map (fun (cmd,str,oflt) -> match oflt with | None -> Some (cmd,str) | Some flt -> if (OpamFilter.eval_to_bool env flt) then Some (cmd,str) else None) in let check_tool logf tools = match List.filter (not @* (List.exists check_external_dep) @* fst) tools with | [] -> false | missing -> (logf (OpamStd.Format.itemize (fun (miss,msg) -> Printf.sprintf "%s%s" (OpamStd.List.concat_map " or " (OpamConsole.colorise `bold) miss) (match msg with | None -> "" | Some m -> ": "^m)) missing); true) in let advised_deps = filter_tools (OpamFile.InitConfig.recommended_tools init_config) in let _ = check_tool (fun s -> OpamConsole.warning "Recommended dependencies -- most packages rely on these:"; OpamConsole.errmsg "%s" s) advised_deps in let required_deps = filter_tools (OpamFile.InitConfig.required_tools init_config) in let hard_fail = let msg = if hard_fail_exn then OpamConsole.error else OpamConsole.warning in check_tool (fun s -> msg "Missing dependencies -- \ the following commands are required for opam to operate:"; OpamConsole.errmsg "%s" s) required_deps in if hard_fail && hard_fail_exn then OpamStd.Sys.exit_because `Configuration_error else not (soft_fail || hard_fail) let update_with_init_config ?(overwrite=false) config init_config = let module I = OpamFile.InitConfig in let module C = OpamFile.Config in let setifnew getter setter v conf = if overwrite then setter v conf else if getter conf = getter C.empty then setter v conf else conf in config |> setifnew C.jobs C.with_jobs (match I.jobs init_config with | Some j -> j | None -> Lazy.force OpamStateConfig.(default.jobs)) |> setifnew C.dl_tool C.with_dl_tool_opt (I.dl_tool init_config) |> setifnew C.dl_jobs C.with_dl_jobs (OpamStd.Option.default OpamStateConfig.(default.dl_jobs) (I.dl_jobs init_config)) |> setifnew C.criteria C.with_criteria (I.solver_criteria init_config) |> setifnew C.solver C.with_solver_opt (I.solver init_config) |> setifnew C.wrappers C.with_wrappers (I.wrappers init_config) |> setifnew C.global_variables C.with_global_variables (I.global_variables init_config) |> setifnew C.eval_variables C.with_eval_variables (I.eval_variables init_config) |> setifnew C.default_compiler C.with_default_compiler (I.default_compiler init_config) let reinit ?(init_config=OpamInitDefaults.init_config()) ~interactive ?dot_profile ?update_config ?env_hook ?completion config shell = let root = OpamStateConfig.(!r.root_dir) in let config = update_with_init_config config init_config in let _all_ok = init_checks ~hard_fail_exn:false init_config in OpamFile.Config.write (OpamPath.config root) config; let custom_init_scripts = let env v = let vs = OpamVariable.Full.variable v in OpamStd.Option.Op.(OpamStd.Option.of_Not_found (List.assoc vs) OpamSysPoll.variables >>= Lazy.force) in OpamStd.List.filter_map (fun ((nam,scr),oflt) -> match oflt with | None -> Some (nam,scr) | Some flt -> if OpamFilter.eval_to_bool env flt then Some (nam,scr) else None) (OpamFile.InitConfig.init_scripts init_config) in OpamEnv.write_custom_init_scripts root custom_init_scripts; OpamEnv.setup root ~interactive ?dot_profile ?update_config ?env_hook ?completion shell; let gt = OpamGlobalState.load `Lock_write in let rt = OpamRepositoryState.load `Lock_write gt in OpamConsole.header_msg "Updating repositories"; let _failed, rt = OpamRepositoryCommand.update_with_auto_upgrade rt (OpamRepositoryName.Map.keys rt.repos_definitions) in let _rt = OpamRepositoryState.unlock rt in () let init ~init_config ~interactive ?repo ?(bypass_checks=false) ?dot_profile ?update_config ?env_hook ?(completion=true) shell = log "INIT %a" (slog @@ OpamStd.Option.to_string OpamRepositoryBackend.to_string) repo; let root = OpamStateConfig.(!r.root_dir) in let config_f = OpamPath.config root in let root_empty = not (OpamFilename.exists_dir root) || OpamFilename.dir_is_empty root in let gt, rt, default_compiler = if OpamFile.exists config_f then ( OpamConsole.msg "Opam has already been initialized.\n"; let gt = OpamGlobalState.load `Lock_write in gt, OpamRepositoryState.load `Lock_none gt, OpamFormula.Empty ) else ( if not root_empty then ( OpamConsole.warning "%s exists and is not empty" (OpamFilename.Dir.to_string root); if not (OpamConsole.confirm "Proceed?") then OpamStd.Sys.exit_because `Aborted); try (* Create the content of ~/.opam/config *) let repos = match repo with | Some r -> [r.repo_name, (r.repo_url, r.repo_trust)] | None -> OpamFile.InitConfig.repositories init_config in let config = update_with_init_config OpamFile.Config.empty init_config |> OpamFile.Config.with_repositories (List.map fst repos) in OpamFile.Config.write config_f config; let dontswitch = if bypass_checks then false else let all_ok = init_checks init_config in if not all_ok && not (OpamConsole.confirm "Continue initialisation anyway ?") then OpamStd.Sys.exit_because `Configuration_error else not all_ok in let custom_scripts = let env v = let vs = OpamVariable.Full.variable v in OpamStd.Option.Op.(OpamStd.Option.of_Not_found (List.assoc vs) OpamSysPoll.variables >>= Lazy.force) in let scripts = OpamFile.InitConfig.init_scripts init_config in OpamStd.List.filter_map (fun ((nam,scr),oflt) -> match oflt with | None -> Some (nam,scr) | Some flt -> if OpamFilter.eval_to_bool env flt then Some (nam,scr) else None) scripts in OpamEnv.write_custom_init_scripts root custom_scripts; let repos_config = OpamRepositoryName.Map.of_list repos |> OpamRepositoryName.Map.map OpamStd.Option.some in OpamFile.Repos_config.write (OpamPath.repos_config root) repos_config; log "updating repository state"; let gt = OpamGlobalState.load `Lock_write in let rt = OpamRepositoryState.load `Lock_write gt in OpamConsole.header_msg "Fetching repository information"; let failed, rt = OpamRepositoryCommand.update_with_auto_upgrade rt (List.map fst repos) in if failed <> [] then OpamConsole.error_and_exit `Sync_error "Initial download of repository failed"; gt, OpamRepositoryState.unlock rt, (if dontswitch then OpamFormula.Empty else OpamFile.InitConfig.default_compiler init_config) with e -> OpamStd.Exn.finalise e @@ fun () -> if not (OpamConsole.debug ()) && root_empty then begin OpamSystem.release_all_locks (); OpamFilename.rmdir root end) in OpamEnv.setup root ~interactive ?dot_profile ?update_config ?env_hook ~completion shell; gt, rt, default_compiler (* Checks a request for [atoms] for conflicts with the orphan packages *) let check_conflicts t atoms = let changes = OpamSwitchState.packages_of_atoms t atoms in let t, full_orphans, orphan_versions = orphans ~changes t in let available_changes = changes %% Lazy.force t.available_packages in (* packages which still have local data are OK for install/reinstall *) let has_no_local_data nv = not (OpamFile.exists (OpamPath.Switch.installed_opam t.switch_global.root t.switch nv)) in let full_orphans, full_orphans_with_local_data = OpamPackage.Set.partition has_no_local_data full_orphans in let orphan_versions, orphan_versions_with_local_data = OpamPackage.Set.partition (fun nv -> has_no_local_data nv || OpamPackage.has_name available_changes nv.name) orphan_versions in let available = lazy (t.packages -- full_orphans -- orphan_versions) in let orphans = full_orphans ++ orphan_versions in let conflict_atoms = List.filter (fun (name,_ as a) -> not (OpamPackage.has_name t.pinned name) && OpamPackage.Set.exists (OpamFormula.check a) orphans && (*optim*) not (OpamPackage.Set.exists (OpamFormula.check a) (* real check *) (Lazy.force available))) atoms in if conflict_atoms <> [] then OpamConsole.error_and_exit `Not_found "Sorry, these packages are no longer available \ from the repositories: %s" (OpamStd.Format.pretty_list (List.map OpamFormula.string_of_atom conflict_atoms)) else {t with available_packages = lazy (Lazy.force t.available_packages ++ full_orphans_with_local_data ++ orphan_versions_with_local_data )}, full_orphans, orphan_versions let assume_built_restrictions t atoms = let installed_fixed, not_installed_fixed = let rec all_deps set pkgs = let universe = OpamSwitchState.universe t ~requested:(OpamPackage.names_of_packages pkgs) Install in let deps = OpamPackage.Set.of_list (OpamSolver.dependencies ~build:false ~post:true ~depopts:false ~installed:false ~unavailable:true universe pkgs) in let deps = deps -- pkgs in if OpamPackage.Set.is_empty deps then set else all_deps (set ++ deps) deps in let pkg_of_atoms = OpamPackage.Set.filter (fun p -> List.exists (fun a -> OpamFormula.check a p) atoms) t.packages in let all_fixed = all_deps OpamPackage.Set.empty pkg_of_atoms in OpamSolution.eq_atoms_of_packages all_fixed |> get_installed_atoms t in let atoms = atoms @ OpamSolution.eq_atoms_of_packages (OpamPackage.Set.of_list installed_fixed) in let t = let avp = OpamPackage.Set.filter (fun p -> not (List.exists (fun a -> OpamFormula.check a p) not_installed_fixed)) (Lazy.force t.available_packages) in { t with available_packages = lazy avp} in t, atoms let filter_unpinned_locally t atoms f = OpamStd.List.filter_map (fun at -> let n,_ = at in if OpamSwitchState.is_pinned t n && OpamStd.Option.Op.(OpamPinned.package_opt t n >>= OpamSwitchState.primary_url t >>= OpamUrl.local_dir) <> None then Some (f at) else (log "Package %a is not pinned locally and assume built \ option is set, skipping" (slog OpamPackage.Name.to_string) n; None)) atoms let install_t t ?ask atoms add_to_roots ~deps_only ~assume_built = log "INSTALL %a" (slog OpamFormula.string_of_atoms) atoms; let names = OpamPackage.Name.Set.of_list (List.rev_map fst atoms) in let t, full_orphans, orphan_versions = check_conflicts t atoms in let atoms = let compl = function | (_, Some _) as at -> at | (name, None) as at -> match OpamPinned.package_opt t name with | Some nv -> OpamSolution.eq_atom_of_package nv | None -> at in if assume_built then filter_unpinned_locally t atoms compl else List.map compl atoms in let pkg_skip, pkg_new = get_installed_atoms t atoms in let pkg_reinstall = if assume_built then OpamPackage.Set.of_list pkg_skip else t.reinstall %% OpamPackage.Set.of_list pkg_skip in (* Add the packages to the list of package roots and display a warning for already installed package roots. *) let current_roots = t.installed_roots in let t = if deps_only then t else List.fold_left (fun t nv -> if OpamPackage.Set.mem nv t.installed then match add_to_roots with | None -> if not (OpamPackage.Set.mem nv pkg_reinstall) then OpamConsole.note "Package %s is already installed (current version is %s)." (OpamPackage.Name.to_string nv.name) (OpamPackage.Version.to_string nv.version); t | Some true -> if OpamPackage.Set.mem nv t.installed_roots then OpamConsole.note "Package %s is already installed as a root." (OpamPackage.Name.to_string nv.name); { t with installed_roots = OpamPackage.Set.add nv t.installed_roots } | Some false -> if OpamPackage.Set.mem nv t.compiler_packages then (OpamConsole.note "Package %s is part of the compiler base and can't be set \ as 'installed automatically'" (OpamPackage.name_to_string nv); t) else if OpamPackage.Set.mem nv t.installed_roots then { t with installed_roots = OpamPackage.Set.remove nv t.installed_roots } else (OpamConsole.note "Package %s is already marked as 'installed automatically'." (OpamPackage.Name.to_string nv.name); t) else t ) t pkg_skip in if t.installed_roots <> current_roots then ( let diff = t.installed_roots -- current_roots in if not (OpamPackage.Set.is_empty diff) then let diff = OpamPackage.Set.elements diff in let diff = List.rev (List.rev_map OpamPackage.to_string diff) in OpamConsole.msg "Adding %s to the list of installed roots.\n" (OpamStd.Format.pretty_list diff) else ( let diff = current_roots -- t.installed_roots in let diff = OpamPackage.Set.elements diff in let diff = List.rev (List.rev_map OpamPackage.to_string diff) in OpamConsole.msg "Removing %s from the list of installed roots.\n" (OpamStd.Format.pretty_list diff) ); OpamSwitchAction.write_selections t ); let available_packages = Lazy.force t.available_packages in let available_packages = if deps_only then (* Assume the named packages are available *) List.fold_left (fun avail (name, _ as atom) -> if OpamPackage.Set.exists (OpamFormula.check atom) avail then avail else match OpamPinned.package_opt t name with | Some nv when OpamFormula.check atom nv -> OpamPackage.Set.add nv avail | _ -> avail ++ OpamPackage.Set.filter (OpamFormula.check atom) t.packages) available_packages atoms else (OpamSolution.check_availability t available_packages atoms; available_packages) in let t = {t with available_packages = lazy available_packages} in if pkg_new = [] && OpamPackage.Set.is_empty pkg_reinstall then t else let t, atoms = if assume_built then assume_built_restrictions t atoms else t, atoms in let request = OpamSolver.request ~install:atoms () in let solution = let reinstall = if assume_built then Some pkg_reinstall else None in OpamSolution.resolve t Install ~orphans:(full_orphans ++ orphan_versions) ~requested:names ?reinstall request in let t, solution = match solution with | Conflicts cs -> log "conflict!"; OpamConsole.msg "%s" (OpamCudf.string_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs); t, No_solution | Success solution -> let solution = if deps_only then OpamSolver.filter_solution (fun nv -> not (OpamPackage.Name.Set.mem nv.name names)) solution else solution in let add_roots = OpamStd.Option.map (function | true -> names | false -> OpamPackage.Name.Set.empty) add_to_roots in OpamSolution.apply ?ask t Install ~requested:names ?add_roots ~assume_built solution in OpamSolution.check_solution t solution; t let install t ?autoupdate ?add_to_roots ?(deps_only=false) ?(assume_built=false) names = let atoms = OpamSolution.sanitize_atom_list ~permissive:true t names in let autoupdate_atoms = match autoupdate with | None -> atoms | Some a -> OpamSolution.sanitize_atom_list ~permissive:true t a in let t = update_dev_packages_t autoupdate_atoms t in install_t t atoms add_to_roots ~deps_only ~assume_built let remove_t ?ask ~autoremove ~force atoms t = log "REMOVE autoremove:%b %a" autoremove (slog OpamFormula.string_of_atoms) atoms; let t, full_orphans, orphan_versions = let changes = if autoremove then None else Some (OpamSwitchState.packages_of_atoms t atoms) in orphans ?changes t in let nothing_to_do = ref true in let packages, not_installed = get_installed_atoms t atoms in if not_installed <> [] then ( if force then let force_remove atom = let candidates = OpamPackage.Set.filter (OpamFormula.check atom) t.packages in try let nv = OpamPackage.max_version candidates (fst atom) in OpamConsole.note "Forcing removal of (uninstalled) %s" (OpamPackage.to_string nv); OpamProcess.Job.run (OpamAction.remove_package t nv); OpamAction.cleanup_package_artefacts t nv; nothing_to_do := false with Not_found -> OpamConsole.error "No package %s found for (forced) removal.\n" (OpamFormula.short_string_of_atom atom) in List.iter force_remove not_installed else OpamConsole.note "%s %s not installed.\n" (OpamStd.Format.pretty_list (List.map OpamFormula.short_string_of_atom not_installed)) (match not_installed with [_] -> "is" | _ -> "are") ); if autoremove || packages <> [] then ( let packages = OpamPackage.Set.of_list packages in let universe = OpamSwitchState.universe t ~requested:(OpamPackage.names_of_packages packages) Remove in let to_remove = OpamPackage.Set.of_list (OpamSolver.reverse_dependencies ~build:true ~post:true ~depopts:false ~installed:true universe packages) in let to_keep = (if autoremove then t.installed_roots %% t.installed else t.installed) ++ universe.u_base -- to_remove -- full_orphans -- orphan_versions in let to_keep = OpamPackage.Set.of_list (OpamSolver.dependencies ~build:true ~post:true ~depopts:true ~installed:true universe to_keep) in (* to_keep includes the depopts, because we don't want to autoremove them. But that may re-include packages that we wanted removed, so we need to remove them again *) let to_keep = to_keep -- to_remove in let requested = OpamPackage.names_of_packages packages in let to_remove = if autoremove then let to_remove = t.installed -- to_keep in if atoms = [] then to_remove else (* restrict to the dependency cone of removed pkgs *) to_remove %% (OpamPackage.Set.of_list (OpamSolver.dependencies ~build:true ~post:true ~depopts:true ~installed:true universe to_remove)) else to_remove in let t, solution = OpamSolution.resolve_and_apply ?ask t Remove ~requested ~orphans:(full_orphans ++ orphan_versions) (OpamSolver.request ~install:(OpamSolution.eq_atoms_of_packages to_keep) ~remove:(OpamSolution.atoms_of_packages to_remove) ()) in OpamSolution.check_solution t solution; t ) else if !nothing_to_do then ( OpamConsole.msg "Nothing to do.\n"; t ) else t let remove t ~autoremove ~force names = let atoms = OpamSolution.sanitize_atom_list t names in remove_t ~autoremove ~force atoms t let reinstall_t t ?ask ?(force=false) ~assume_built atoms = log "reinstall %a" (slog OpamFormula.string_of_atoms) atoms; let atoms = if assume_built then filter_unpinned_locally t atoms (fun x -> x) else atoms in let reinstall, not_installed = get_installed_atoms t atoms in let to_install = if not_installed <> [] then if force || assume_built || OpamConsole.confirm "%s %s not installed. Install %s?" (OpamStd.Format.pretty_list (List.rev_map OpamFormula.short_string_of_atom not_installed)) (match not_installed with [_] -> "is" | _ -> "are") (match not_installed with [_] -> "it" | _ -> "them") then not_installed else OpamStd.Sys.exit_because `Aborted else [] in let reinstall = OpamPackage.Set.of_list reinstall in let atoms = to_install @ OpamSolution.eq_atoms_of_packages reinstall in let t, full_orphans, orphan_versions = check_conflicts t atoms in let requested = OpamPackage.Name.Set.of_list (List.rev_map fst atoms) in let t, atoms = if assume_built then assume_built_restrictions t atoms else t, atoms in let request = OpamSolver.request ~install:atoms ~criteria:`Fixup () in let t, solution = OpamSolution.resolve_and_apply ?ask t Reinstall ~orphans:(full_orphans ++ orphan_versions) ~reinstall:(OpamPackage.packages_of_names t.installed requested) ~requested ~assume_built request in OpamSolution.check_solution t solution; t let reinstall t ?(assume_built=false) names = let atoms = OpamSolution.sanitize_atom_list t names in let t = update_dev_packages_t atoms t in reinstall_t t ~assume_built atoms module PIN = struct open OpamPinCommand let post_pin_action st was_pinned names = let names = OpamPackage.Set.Op.(st.pinned -- was_pinned) |> OpamPackage.names_of_packages |> (fun s -> List.fold_left (fun s p -> OpamPackage.Name.Set.add p s) s names) |> OpamPackage.Name.Set.elements in try upgrade_t ~strict_upgrade:false ~auto_install:true ~ask:true ~terse:true ~all:false (List.map (fun name -> name, None) names) st with e -> OpamConsole.note "Pinning command successful, but your installed packages \ may be out of sync."; raise e let get_upstream t name = try match OpamStd.Option.Op.( OpamSwitchState.get_package t name |> OpamSwitchState.opam_opt t >>= OpamFile.OPAM.dev_repo ) with | None -> OpamConsole.error_and_exit `Not_found "\"dev-repo\" field missing in %s metadata, you'll need to specify \ the pinning location" (OpamPackage.Name.to_string name) | Some url -> url with Not_found -> OpamConsole.error_and_exit `Not_found "No package named %S found" (OpamPackage.Name.to_string name) let pin st name ?(edit=false) ?version ?(action=true) target = try let pinned = st.pinned in let st = match target with | `Source url -> source_pin st name ?version ~edit (Some url) | `Version v -> let st = version_pin st name v in if edit then OpamPinCommand.edit st name else st | `Dev_upstream -> source_pin st name ?version ~edit (Some (get_upstream st name)) | `None -> source_pin st name ?version ~edit None in if action then (OpamConsole.msg "\n"; post_pin_action st pinned [name]) else st with | OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted | OpamPinCommand.Nothing_to_do -> st let edit st ?(action=true) ?version name = let pinned = st.pinned in let st = if OpamPackage.has_name st.pinned name then edit st ?version name else let pin_nv = match version with | Some v -> let nv = OpamPackage.create name v in if OpamPackage.Set.mem nv st.packages then Some nv else None | None -> OpamStd.Option.of_Not_found (OpamSwitchState.get_package st) name in match pin_nv with | Some nv -> if OpamConsole.confirm "Package %s is not pinned. Edit as a new pinning to version %s?" (OpamPackage.Name.to_string name) (OpamPackage.version_to_string nv) then let target = OpamStd.Option.Op.(OpamSwitchState.url st nv >>| OpamFile.URL.url) in let opam = OpamPackage.Map.find_opt nv st.repos_package_index in try source_pin st name ~edit:true ?version ?opam target with OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted | OpamPinCommand.Nothing_to_do -> st else OpamStd.Sys.exit_because `Aborted | None -> OpamConsole.error_and_exit `Not_found "Package is not pinned, and no existing version was supplied." in if action then post_pin_action st pinned [name] else st let unpin st ?(action=true) names = let pinned_before = st.pinned in let st = unpin st names in let available = Lazy.force st.available_packages in let installed_unpinned = (pinned_before -- st.pinned) %% st.installed in if action && not (OpamPackage.Set.is_empty installed_unpinned) then let atoms = OpamPackage.Set.fold (fun nv acc -> if OpamPackage.Set.mem nv available then (nv.name, Some (`Eq, nv.version)) :: acc else (nv.name, None) :: acc) installed_unpinned [] in upgrade_t ~strict_upgrade:false ~auto_install:true ~ask:true ~all:false ~terse:true atoms st else st let list = list end opam-2.0.5/src/client/manifest.inc.in0000644000175000017500000000206613511367404016435 0ustar nicoonicoo(rule (targets opam-manifest.o) (deps (:rc opam.rc)) (action (run @TOOL_ARCH@-w64-mingw32-windres %{rc} %{targets}))) (rule (with-stdout-to opam.exe.manifest (progn (echo "\n") (echo "\n") (cat opam-@SYSTEM@.xmlf) (cat default-manifest.xmlf) (echo "")))) (rule (targets opam.rc) (deps (:manifest opam.exe.manifest)) (action (with-stdout-to %{targets} (echo "#include \nCREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST %{manifest}")))) (install (section bin) (files (Opam.Runtime.@MANIFEST_ARCH@.manifest as Opam.Runtime.@MANIFEST_ARCH@\Opam.Runtime.@MANIFEST_ARCH@.manifest) (libstdc++-6.dll as Opam.Runtime.@MANIFEST_ARCH@\libstdc++-6.dll) (libwinpthread-1.dll as Opam.Runtime.@MANIFEST_ARCH@\libwinpthread-1.dll) (@RUNTIME_GCC_S@.dll as Opam.Runtime.@MANIFEST_ARCH@\@RUNTIME_GCC_S@.dll)) (package opam)) opam-2.0.5/src/client/opamSwitchCommand.ml0000644000175000017500000006320413511367404017477 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamPackage.Set.Op open OpamStd.Op module S = OpamFile.SwitchSelections let log fmt = OpamConsole.log "SWITCH" fmt let slog = OpamConsole.slog let list gt ~print_short = log "list"; let gt = OpamGlobalState.fix_switch_list gt in if print_short then List.iter (OpamConsole.msg "%s\n" @* OpamSwitch.to_string) (List.sort compare (OpamFile.Config.installed_switches gt.config)) else let installed_switches = OpamGlobalState.fold_switches (fun sw sel acc -> let opams = OpamPackage.Set.fold (fun nv acc -> match OpamFile.OPAM.read_opt (OpamPath.Switch.installed_opam gt.root sw nv) with | Some opam -> OpamPackage.Map.add nv opam acc | None -> acc) sel.sel_compiler OpamPackage.Map.empty in let ifempty default m = if OpamPackage.Map.is_empty m then default else m in let comp = OpamPackage.Map.filter (fun nv _ -> OpamPackage.Set.mem nv sel.sel_roots) opams |> ifempty opams in let comp = OpamPackage.Map.filter (fun _ opam -> OpamFile.OPAM.has_flag Pkgflag_Compiler opam) comp |> ifempty comp in let conf = OpamFile.Switch_config.read_opt (OpamPath.Switch.switch_config gt.root sw) in let descr = match conf with | Some c -> c.OpamFile.Switch_config.synopsis | None -> OpamConsole.colorise `red "Missing config file" in OpamSwitch.Map.add sw (OpamPackage.keys comp, descr) acc) gt OpamSwitch.Map.empty in let list = OpamSwitch.Map.bindings installed_switches in let table = List.map (OpamConsole.colorise `blue) ["#"; "switch"; "compiler"; "description" ] :: List.map (fun (switch, (packages, descr)) -> let current = Some switch = OpamStateConfig.get_switch_opt () in List.map (if current then OpamConsole.colorise `bold else fun s -> s) [ if current then OpamConsole.(utf8_symbol Symbols.rightwards_arrow "->") else ""; OpamSwitch.to_string switch; OpamStd.List.concat_map "," (OpamConsole.colorise `yellow @* OpamPackage.to_string) (OpamPackage.Set.elements packages); descr ]) list in OpamConsole.print_table stdout ~sep:" " (OpamStd.Format.align_table table); match OpamStateConfig.get_switch_opt (), OpamStateConfig.(!r.switch_from) with | None, _ when OpamFile.Config.installed_switches gt.config <> [] -> OpamConsole.note "No switch is currently set, you should use 'opam switch ' \ to set an active switch" | Some switch, `Env -> let sys = OpamFile.Config.switch gt.config in if not (OpamGlobalState.switch_exists gt switch) then (OpamConsole.msg "\n"; OpamConsole.warning "The OPAMSWITCH variable does not point to a valid switch: %S" (OpamSwitch.to_string switch)) else if sys <> Some switch then (OpamConsole.msg "\n"; OpamConsole.note "Current switch is set locally through the OPAMSWITCH variable.\n\ The current global system switch is %s." (OpamStd.Option.to_string ~none:"unset" (fun s -> OpamConsole.colorise `bold (OpamSwitch.to_string s)) sys)) else (match OpamStateConfig.get_current_switch_from_cwd gt.root with | None -> () | Some sw -> OpamConsole.msg "\n"; OpamConsole.note "Current switch is set globally and through the OPAMSWITCH variable.\n\ Thus, the local switch found at %s was ignored." (OpamConsole.colorise `bold (OpamSwitch.to_string sw))) | Some switch, `Default when not (OpamGlobalState.switch_exists gt switch) -> OpamConsole.msg "\n"; OpamConsole.warning "The currently selected switch (%S) is invalid.\n%s" (OpamSwitch.to_string switch) (if OpamSwitch.is_external switch then "Stale '_opam' directory or link ?" else "Fix the selection with 'opam switch set SWITCH'.") | Some switch, `Default when OpamSwitch.is_external switch -> OpamConsole.msg "\n"; OpamConsole.note "Current switch has been selected based on the current directory.\n\ The current global system switch is %s." (OpamStd.Option.to_string ~none:"unset" (fun s -> OpamConsole.colorise `bold (OpamSwitch.to_string s)) (OpamFile.Config.switch gt.config)); if not (OpamEnv.is_up_to_date_switch gt.root switch) then OpamConsole.warning "The environment is not in sync with the current switch.\n\ You should run: %s" (OpamEnv.eval_string gt (Some switch)) | Some switch, `Default -> if not (OpamEnv.is_up_to_date_switch gt.root switch) then (OpamConsole.msg "\n"; OpamConsole.warning "The environment is not in sync with the current switch.\n\ You should run: %s" (OpamEnv.eval_string gt (Some switch))) | _ -> () let clear_switch ?(keep_debug=false) gt switch = let module C = OpamFile.Config in let config = gt.config in let config = C.with_installed_switches (List.filter ((<>) switch) (C.installed_switches config)) config in let config = if C.switch config = Some switch then C.with_switch_opt None config else config in let gt = { gt with config } in OpamGlobalState.write gt; let comp_dir = OpamPath.Switch.root gt.root switch in if keep_debug && (OpamClientConfig.(!r.keep_build_dir) || (OpamConsole.debug ())) then (OpamConsole.note "Keeping %s despite errors (debug mode), \ you may want to remove it by hand" (OpamFilename.Dir.to_string comp_dir); gt) else try OpamFilename.rmdir comp_dir; gt with OpamSystem.Internal_error _ -> gt let remove gt ?(confirm = true) switch = log "remove switch=%a" (slog OpamSwitch.to_string) switch; if not (OpamGlobalState.switch_exists gt switch) then ( OpamConsole.msg "The compiler switch %s does not exist.\n" (OpamSwitch.to_string switch); OpamStd.Sys.exit_because `Not_found; ); if not confirm || OpamConsole.confirm "Switch %s and all its packages will be wiped. Are you sure?" (OpamSwitch.to_string switch) then clear_switch gt switch else gt let install_compiler_packages t atoms = (* install the compiler packages *) if atoms = [] then t else let roots = OpamPackage.Name.Set.of_list (List.map fst atoms) in let not_found = OpamPackage.Name.Set.diff roots @@ OpamPackage.names_of_packages @@ OpamPackage.packages_of_names t.packages roots in if not (OpamPackage.Name.Set.is_empty not_found) then OpamConsole.error_and_exit `Not_found "No packages %s found." (OpamPackage.Name.Set.to_string not_found); let solution = OpamSolution.resolve t Switch ~orphans:OpamPackage.Set.empty ~requested:roots { wish_install = []; wish_remove = []; wish_upgrade = atoms; criteria = `Default; extra_attributes = []; } in let solution = match solution with | Success s -> s | Conflicts cs -> OpamConsole.error_and_exit `No_solution "Could not resolve set of base packages:\n%s" (OpamCudf.string_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs); in let () = match OpamSolver.stats solution with | { s_install = _; s_reinstall = 0; s_upgrade = 0; s_downgrade=0; s_remove = 0 } -> () | stats -> OpamConsole.error_and_exit `No_solution "Inconsistent resolution of base package installs:\n%s" (OpamSolver.string_of_stats stats) in let to_install_pkgs = OpamSolver.new_packages solution in let base_comp = OpamPackage.packages_of_names to_install_pkgs roots in let non_comp = OpamPackage.Set.filter (fun nv -> not (OpamFile.OPAM.has_flag Pkgflag_Compiler (OpamSwitchState.opam t nv))) base_comp in if not (OpamPackage.Set.is_empty non_comp) && not (OpamConsole.confirm ~default:false "Packages %s don't have the 'compiler' flag set. Are you sure \ you want to set them as the compiler base for this switch?" (OpamPackage.Set.to_string non_comp)) then OpamConsole.error_and_exit `Aborted "Aborted installation of non-compiler packages \ as switch base."; let t = if t.switch_config.OpamFile.Switch_config.synopsis = "" then let synopsis = match OpamPackage.Set.elements base_comp with | [] -> OpamSwitch.to_string t.switch | [pkg] -> let open OpamStd.Option.Op in (OpamSwitchState.opam_opt t pkg >>= OpamFile.OPAM.synopsis) +! OpamPackage.to_string pkg | pkgs -> OpamStd.List.concat_map " " OpamPackage.to_string pkgs in let switch_config = { t.switch_config with OpamFile.Switch_config.synopsis } in if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then OpamSwitchAction.install_switch_config t.switch_global.root t.switch switch_config; { t with switch_config } else t in let t = { t with compiler_packages = to_install_pkgs } in let t, result = OpamSolution.apply ~ask:OpamClientConfig.(!r.show) t Switch ~requested:roots solution in OpamSolution.check_solution ~quiet:OpamClientConfig.(not !r.show) t result; t let install gt ?rt ?synopsis ?repos ~update_config ~packages ?(local_compiler=false) switch = let update_config = update_config && not (OpamSwitch.is_external switch) in let old_switch_opt = OpamFile.Config.switch gt.config in let comp_dir = OpamPath.Switch.root gt.root switch in if OpamGlobalState.switch_exists gt switch then OpamConsole.error_and_exit `Bad_arguments "There already is an installed switch named %s" (OpamSwitch.to_string switch); if Sys.file_exists (OpamFilename.Dir.to_string comp_dir) then OpamConsole.error_and_exit `Bad_arguments "Directory %S already exists, please choose a different name" (OpamFilename.Dir.to_string comp_dir); let gt, st = if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then let gt = OpamSwitchAction.create_empty_switch gt ?synopsis ?repos switch in if update_config then gt, OpamSwitchAction.set_current_switch `Lock_write gt ?rt switch else let rt = match rt with | None -> OpamRepositoryState.load `Lock_none gt | Some rt -> ({ rt with repos_global = (gt :> unlocked global_state) } :> unlocked repos_state) in gt, OpamSwitchState.load `Lock_write gt rt switch else gt, let rt = match rt with | None -> OpamRepositoryState.load `Lock_none gt | Some rt -> (rt :> unlocked repos_state) in let st = OpamSwitchState.load_virtual ?repos_list:repos gt rt in let available_packages = lazy (OpamSwitchState.compute_available_packages gt switch (OpamSwitchAction.gen_switch_config gt.root ?repos switch) ~pinned:OpamPackage.Set.empty ~opams:st.opams) in { st with switch; available_packages } in let st = if OpamSwitch.is_external switch && local_compiler then OpamAuxCommands.autopin st ~quiet:true [`Dirname (OpamFilename.Dir.of_string (OpamSwitch.to_string switch))] |> fst else st in let packages = try OpamSolution.sanitize_atom_list st packages with e -> OpamStd.Exn.finalise e @@ fun () -> if update_config then (OpamEnv.clear_dynamic_init_scripts gt; OpamStd.Option.iter (ignore @* OpamSwitchAction.set_current_switch `Lock_write gt) old_switch_opt); ignore (OpamSwitchState.unlock st); ignore (clear_switch gt switch) in let gt = OpamGlobalState.unlock gt in try gt, install_compiler_packages st packages with e -> if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then ((try OpamStd.Exn.fatal e with e -> OpamConsole.warning "Switch %s left partially installed" (OpamSwitch.to_string switch); raise e); if OpamConsole.confirm "Switch initialisation failed: clean up? \ ('n' will leave the switch partially installed)" then begin ignore (OpamSwitchState.unlock st); ignore (clear_switch gt switch) end); raise e let switch lock gt switch = log "switch switch=%a" (slog OpamSwitch.to_string) switch; if OpamGlobalState.switch_exists gt switch then let st = if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then OpamSwitchAction.set_current_switch lock gt switch else let rt = OpamRepositoryState.load `Lock_none gt in OpamSwitchState.load lock gt rt switch in OpamEnv.check_and_print_env_warning st; st else let installed_switches = OpamFile.Config.installed_switches gt.config in OpamConsole.error_and_exit `Not_found "No switch %s is currently installed. Did you mean \ 'opam switch create %s'?\n\ Installed switches are:\n%s" (OpamSwitch.to_string switch) (OpamSwitch.to_string switch) (OpamStd.Format.itemize OpamSwitch.to_string installed_switches) let import_t ?ask importfile t = log "import switch"; let import_sel = importfile.OpamFile.SwitchExport.selections in let import_opams = importfile.OpamFile.SwitchExport.overlays in let opams = OpamPackage.Name.Map.fold (fun name opam opams -> let nv = OpamPackage.create name (OpamFile.OPAM.version opam) in OpamPackage.Map.add nv opam opams) import_opams t.opams in let packages = t.packages ++ OpamPackage.keys opams in let pinned = let names = OpamPackage.names_of_packages import_sel.sel_pinned in OpamPackage.Set.filter (fun nv -> not (OpamPackage.Name.Set.mem nv.name names)) t.pinned ++ import_sel.sel_pinned in let available = OpamSwitchState.compute_available_packages t.switch_global t.switch t.switch_config ~pinned ~opams in let compiler_packages, to_install = if OpamPackage.Set.is_empty t.compiler_packages then import_sel.sel_compiler %% available, import_sel.sel_installed else t.compiler_packages, import_sel.sel_installed -- import_sel.sel_compiler in let t = { t with available_packages = lazy available; packages; compiler_packages; pinned; opams; } in let unavailable_version, unavailable = let available_names = OpamPackage.names_of_packages available in OpamPackage.Set.partition (fun nv -> OpamPackage.Name.Set.mem nv.name available_names) (to_install -- available) in if not (OpamPackage.Set.is_empty unavailable_version) then OpamConsole.warning "These packages aren't available at the specified versions, \ version constraints have been discarded:\n%s" (OpamStd.Format.itemize OpamPackage.to_string (OpamPackage.Set.elements unavailable_version)); if not (OpamPackage.Set.is_empty unavailable) then OpamConsole.warning "These packages are unavailable, they have been ignored from \ the import file:\n%s" (OpamStd.Format.itemize OpamPackage.to_string (OpamPackage.Set.elements unavailable)); let t, solution = let to_import = OpamSolution.eq_atoms_of_packages (to_install %% available) @ OpamSolution.atoms_of_packages unavailable_version in let add_roots = OpamPackage.names_of_packages import_sel.sel_roots in OpamSolution.resolve_and_apply ?ask t Import ~requested:(OpamPackage.Name.Set.of_list @@ List.map fst to_import) ~add_roots ~orphans:OpamPackage.Set.empty { wish_install = to_import; wish_remove = []; wish_upgrade = []; criteria = `Default; extra_attributes = []; } in OpamSolution.check_solution t solution; if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then begin (* Put imported overlays in place *) OpamPackage.Set.iter (fun nv -> match OpamPackage.Name.Map.find_opt nv.name import_opams with | None -> () | Some opam -> OpamFilename.rmdir (OpamPath.Switch.Overlay.package t.switch_global.root t.switch nv.name); OpamFile.OPAM.write (OpamPath.Switch.Overlay.opam t.switch_global.root t.switch nv.name) opam) pinned; (* Save new pinnings *) let sel = OpamSwitchState.load_selections t.switch_global t.switch in S.write (OpamPath.Switch.selections t.switch_global.root t.switch) { sel with sel_pinned = pinned } end; t let read_overlays (read: package -> OpamFile.OPAM.t option) packages = OpamPackage.Set.fold (fun nv acc -> match read nv with | Some opam -> if OpamFile.OPAM.extra_files opam <> None then (OpamConsole.warning "Metadata of package %s uses a files/ subdirectory, it may not be \ re-imported correctly (skipping definition)" (OpamPackage.to_string nv); acc) else OpamPackage.Name.Map.add nv.name opam acc | None -> acc) packages OpamPackage.Name.Map.empty let export ?(full=false) filename = let switch = OpamStateConfig.get_switch () in let root = OpamStateConfig.(!r.root_dir) in let export = OpamFilename.with_flock `Lock_none (OpamPath.Switch.lock root switch) @@ fun _ -> let selections = S.safe_read (OpamPath.Switch.selections root switch) in let overlays = read_overlays (fun nv -> OpamFileTools.read_opam (OpamPath.Switch.Overlay.package root switch nv.name)) selections.sel_pinned in let overlays = if full then OpamPackage.Name.Map.union (fun a _ -> a) overlays @@ read_overlays (fun nv -> OpamFile.OPAM.read_opt (OpamPath.Switch.installed_opam root switch nv)) (selections.sel_installed -- selections.sel_pinned) else overlays in { OpamFile.SwitchExport.selections; overlays } in match filename with | None -> OpamFile.SwitchExport.write_to_channel stdout export | Some f -> OpamFile.SwitchExport.write f export let show () = OpamConsole.msg "%s\n" (OpamSwitch.to_string (OpamStateConfig.get_switch ())) let reinstall init_st = let switch = init_st.switch in log "reinstall switch=%a" (slog OpamSwitch.to_string) switch; let gt = init_st.switch_global in let switch_root = OpamPath.Switch.root gt.root switch in let opam_subdir = OpamPath.Switch.meta gt.root switch in let pkg_dirs = List.filter ((<>) opam_subdir) (OpamFilename.dirs switch_root) in List.iter OpamFilename.cleandir pkg_dirs; List.iter OpamFilename.remove (OpamFilename.files switch_root); OpamFilename.cleandir (OpamPath.Switch.config_dir gt.root switch); OpamFilename.cleandir (OpamPath.Switch.installed_opams gt.root switch); let st = { init_st with installed = OpamPackage.Set.empty; installed_roots = OpamPackage.Set.empty; reinstall = OpamPackage.Set.empty; } in import_t { OpamFile.SwitchExport. selections = OpamSwitchState.selections init_st; overlays = OpamPackage.Name.Map.empty; } st let import st filename = let import_str = match filename with | None -> OpamSystem.string_of_channel stdin | Some f -> OpamFilename.read (OpamFile.filename f) in let importfile = try OpamFile.SwitchExport.read_from_string ?filename import_str with OpamPp.Bad_format _ as e -> log "Error loading export file, trying the old file format"; try let selections = OpamFile.LegacyState.read_from_string import_str in { OpamFile.SwitchExport.selections; overlays = OpamPackage.Name.Map.empty } with e1 -> OpamStd.Exn.fatal e1; raise e in import_t importfile st let set_compiler st namesv = let name_unknown = List.filter (fun (name,_) -> not (OpamPackage.has_name st.packages name)) namesv in if name_unknown <> [] then OpamConsole.error_and_exit `Not_found "No packages by these names found: %s" (OpamStd.List.concat_map ", " (OpamPackage.Name.to_string @* fst) name_unknown); let packages = List.map (function | name, Some v -> OpamPackage.create name v | name, None -> OpamSwitchState.get_package st name) namesv in let uninstalled = List.filter (fun nv -> not (OpamPackage.Set.mem nv st.installed)) packages in if uninstalled <> [] then (OpamConsole.warning "These packages are not installed:\n%s" (OpamStd.List.concat_map ", " OpamPackage.to_string uninstalled); if not (OpamConsole.confirm "Set them as compilers at the proposed versions regardless?") then OpamStd.Sys.exit_because `Aborted); let st = { st with compiler_packages = OpamPackage.Set.of_list packages } in OpamSwitchAction.write_selections st; st let get_compiler_packages ?repos rt = let repos = match repos with | None -> OpamGlobalState.repos_list rt.repos_global | Some r -> r in let package_index = OpamRepositoryState.build_index rt repos in OpamPackage.Map.filter (fun _ opam -> OpamFile.OPAM.has_flag Pkgflag_Compiler opam && OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_global rt.repos_global) (OpamFile.OPAM.available opam)) package_index |> OpamPackage.keys let advise_compiler_dependencies rt opams compilers name atoms = let packages = OpamFormula.packages_of_atoms (OpamPackage.keys opams) atoms in let deps = List.map (fun nv -> let opam = OpamPackage.Map.find nv opams in OpamPackageVar.filter_depends_formula ~default:false ~env:(OpamPackageVar.resolve_switch_raw ~package:nv rt.repos_global (OpamSwitch.of_string name) (OpamFile.Switch_config.empty)) (OpamFile.OPAM.depends opam)) (OpamPackage.Set.elements packages) in let comp_deps = List.fold_left (fun acc f -> OpamPackage.Set.union acc (OpamFormula.packages compilers f)) OpamPackage.Set.empty deps in if not (OpamPackage.Set.is_empty comp_deps) then OpamConsole.formatted_msg "Package%s %s do%sn't have the 'compiler' flag set, and may not be \ suitable to set as switch base. You probably meant to choose among \ the following compiler implementations, which they depend \ upon:\n%s" (match atoms with [_] -> "" | _ -> "s") (OpamStd.List.concat_map ", " OpamFormula.short_string_of_atom atoms) (match atoms with [_] -> "es" | _ -> "") (OpamStd.Format.itemize OpamPackage.Name.to_string (OpamPackage.Name.Set.elements (OpamPackage.names_of_packages comp_deps))) let guess_compiler_package ?repos rt name = let repos = match repos with | None -> OpamGlobalState.repos_list rt.repos_global | Some r -> r in let opams = OpamRepositoryState.build_index rt repos |> OpamPackage.Map.filter (fun _ opam -> OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_global rt.repos_global) (OpamFile.OPAM.available opam)) in let compiler_packages = OpamPackage.Map.filter (fun _ -> OpamFile.OPAM.has_flag Pkgflag_Compiler) opams |> OpamPackage.keys in let no_compiler_error () = OpamConsole.error_and_exit `Not_found "No compiler matching '%s' found, use 'opam switch list-available' \ to see what is available, or use '--packages' to select packages \ explicitly." name in match OpamPackage.of_string_opt name with | Some nv when OpamPackage.Set.mem nv compiler_packages -> [OpamSolution.eq_atom_of_package nv] | Some nv when OpamRepositoryState.find_package_opt rt repos nv <> None -> advise_compiler_dependencies rt opams compiler_packages name [OpamSolution.eq_atom_of_package nv]; no_compiler_error () | _ -> let pkgname = try Some (OpamPackage.Name.of_string name) with Failure _ -> None in match pkgname with | Some pkgname when OpamPackage.has_name compiler_packages pkgname -> [pkgname, None] | Some pkgname when OpamPackage.Map.exists (fun nv _ -> OpamPackage.name nv = pkgname) opams -> advise_compiler_dependencies rt opams compiler_packages name [pkgname, None]; no_compiler_error () | _ -> let version = OpamPackage.Version.of_string name in let has_version = OpamPackage.Set.filter (fun nv -> nv.version = version) compiler_packages in try [OpamSolution.eq_atom_of_package (OpamPackage.Set.choose_one has_version)] with | Not_found -> no_compiler_error () | Failure _ -> OpamConsole.error_and_exit `Bad_arguments "Compiler selection '%s' is ambiguous. matching packages: %s" name (OpamPackage.Set.to_string has_version) opam-2.0.5/src/client/opamMain.mli0000644000175000017500000000144413511367404015772 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** opam main CLI entry point *) opam-2.0.5/src/client/opamGitVersion.mli0000644000175000017500000000167413511367404017204 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2014 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** (generated) Current git version of OPAM *) (** This is defined only at the client lib level to avoid triggering full recompilations all the time *) val version: string option opam-2.0.5/src/client/opamArg.ml0000644000175000017500000015253713511367404015460 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open Cmdliner open OpamStd.Op (* Global options *) type global_options = { debug_level: int option; verbose: int; quiet : bool; color : [ `Always | `Never | `Auto ] option; opt_switch : string option; yes : bool; strict : bool; opt_root : dirname option; git_version : bool; external_solver : string option; use_internal_solver : bool; cudf_file : string option; solver_preferences : string option; best_effort : bool; safe_mode : bool; json : string option; no_auto_upgrade : bool; working_dir : bool; ignore_pin_depends : bool; } let deprecated_option option absent name instead = if option <> absent then OpamConsole.warning "Option %s is deprecated, ignoring it.%s" name (match instead with | None -> "" | Some instead -> Printf.sprintf " You can use %s instead." instead) let create_global_options git_version debug debug_level verbose quiet color opt_switch yes strict opt_root external_solver use_internal_solver cudf_file solver_preferences best_effort safe_mode json no_auto_upgrade working_dir ignore_pin_depends d_no_aspcud = deprecated_option d_no_aspcud false "no-aspcud" None; let debug_level = OpamStd.Option.Op.( debug_level >>+ fun () -> if debug then Some 1 else None ) in let verbose = List.length verbose in { git_version; debug_level; verbose; quiet; color; opt_switch; yes; strict; opt_root; external_solver; use_internal_solver; cudf_file; solver_preferences; best_effort; safe_mode; json; no_auto_upgrade; working_dir; ignore_pin_depends; } let apply_global_options o = if o.git_version then ( begin match OpamGitVersion.version with | None -> () | Some v -> OpamConsole.msg "%s\n" v end; OpamStd.Sys.exit_because `Success ); let open OpamStd.Option.Op in let flag f = if f then Some true else None in let some x = match x with None -> None | some -> Some some in let solver = if o.use_internal_solver then Some (lazy (OpamCudfSolver.get_solver ~internal:true OpamCudfSolver.default_solver_selection)) else o.external_solver >>| fun s -> lazy (OpamCudfSolver.solver_of_string s) in let solver_prefs = o.solver_preferences >>| fun p -> lazy (Some p) in OpamClientConfig.opam_init (* - format options - *) ?strict:(flag o.strict) (* ?skip_version_checks:bool *) (* ?all_parens:bool *) (* - core options - *) ?debug_level:(if o.safe_mode then Some 0 else o.debug_level) ?verbose_level:(if o.quiet then Some 0 else if o.verbose = 0 then None else Some o.verbose) ?color:o.color (* ?utf8:[ `Extended | `Always | `Never | `Auto ] *) (* ?disp_status_line:[ `Always | `Never | `Auto ] *) ?answer:(some (flag o.yes)) ?safe_mode:(flag o.safe_mode) (* ?lock_retries:int *) (* ?log_dir:OpamTypes.dirname *) (* ?keep_log_dir:bool *) (* - repository options - *) (* ?download_tool:(OpamTypes.arg list * dl_tool_kind) Lazy.t *) (* ?retries:int *) (* ?force_checksums:bool option *) (* - solver options *) ?cudf_file:(some o.cudf_file) ?solver ?best_effort:(flag o.best_effort) ?solver_preferences_default:solver_prefs ?solver_preferences_upgrade:solver_prefs ?solver_preferences_fixup:solver_prefs (* ?solver_preferences_best_effort_prefix: *) (* - state options - *) ?root_dir:o.opt_root ?current_switch:(o.opt_switch >>| OpamSwitch.of_string) ?switch_from:(o.opt_switch >>| fun _ -> `Command_line) (* ?jobs: int *) (* ?dl_jobs: int *) (* ?keep_build_dir:bool *) (* ?build_test:bool *) (* ?build_doc:bool *) (* ?show:bool *) (* ?dryrun:bool *) (* ?fake:bool *) (* ?makecmd:string Lazy.t *) (* ?ignore_constraints_on:name_set *) (* ?skip_dev_update:bool *) ?json_out:OpamStd.Option.Op.(o.json >>| function "" -> None | s -> Some s) (* ?root_is_ok:bool *) ?no_auto_upgrade:(flag o.no_auto_upgrade) (* - client options - *) ?working_dir:(flag o.working_dir) ?ignore_pin_depends:(flag o.ignore_pin_depends) (* ?print_stats:bool *) (* ?sync_archives:bool *) (* ?pin_kind_auto:bool *) (* ?autoremove:bool *) (* ?editor:string *) (); if OpamClientConfig.(!r.json_out <> None) then ( OpamJson.append "opam-version" (`String OpamVersion.(to_string (full ()))); OpamJson.append "command-line" (`A (List.map (fun s -> `String s) (Array.to_list Sys.argv))) ) (* Build options *) type build_options = { keep_build_dir: bool; reuse_build_dir: bool; inplace_build : bool; make : string option; no_checksums : bool; req_checksums : bool; build_test : bool; build_doc : bool; show : bool; dryrun : bool; fake : bool; skip_update : bool; jobs : int option; ignore_constraints_on: name list option; unlock_base : bool; locked: string option; } let create_build_options keep_build_dir reuse_build_dir inplace_build make no_checksums req_checksums build_test build_doc show dryrun skip_update fake jobs ignore_constraints_on unlock_base locked = { keep_build_dir; reuse_build_dir; inplace_build; make; no_checksums; req_checksums; build_test; build_doc; show; dryrun; skip_update; fake; jobs; ignore_constraints_on; unlock_base; locked; } let apply_build_options b = let flag f = if f then Some true else None in let some x = match x with None -> None | some -> Some some in OpamRepositoryConfig.update (* ?download_tool:(OpamTypes.arg list * dl_tool_kind) Lazy.t *) (* ?retries:int *) ?force_checksums:(if b.req_checksums then Some (Some true) else if b.no_checksums then Some (Some false) else None) (); OpamStateConfig.update (* ?root: -- handled globally *) ?jobs:OpamStd.Option.Op.(b.jobs >>| fun j -> lazy j) (* ?dl_jobs:int *) (* ?no_base_packages:(flag o.no_base_packages) -- handled globally *) ?build_test:(flag b.build_test) ?build_doc:(flag b.build_doc) ?dryrun:(flag b.dryrun) ?makecmd:OpamStd.Option.Op.(b.make >>| fun m -> lazy m) ?ignore_constraints_on: OpamStd.Option.Op.(b.ignore_constraints_on >>| OpamPackage.Name.Set.of_list) ?unlock_base:(flag b.unlock_base) ?locked:(some b.locked) (); OpamClientConfig.update ?keep_build_dir:(flag b.keep_build_dir) ?reuse_build_dir:(flag b.reuse_build_dir) ?inplace_build:(flag b.inplace_build) ?show:(flag b.show) ?fake:(flag b.fake) ?skip_dev_update:(flag b.skip_update) () let when_enum = [ "always", `Always; "never", `Never; "auto", `Auto ] (* Help sections common to all commands *) let global_option_section = "COMMON OPTIONS" let help_sections = [ `S global_option_section; `P "These options are common to all commands."; `S "ENVIRONMENT VARIABLES"; `P "Opam makes use of the environment variables listed here. Boolean \ variables should be set to \"0\", \"no\", \"false\" or the empty string \ to disable, \"1\", \"yes\" or \"true\" to enable."; (* Alphabetical order *) `P "$(i,OPAMALLPARENS) surround all filters with parenthesis"; `P "$(i,OPAMAUTOREMOVE) see remove option `--auto-remove`"; `P "$(i,OPAMBESTEFFORT) see option `--best-effort`"; `P "$(i,OPAMBESTEFFORTPREFIXCRITERIA) sets the string that must be prepended \ to the criteria when the `--best-effort` option is set, and is expected \ to maximise the `opam-query` property in the solution "; `P "$(i,OPAMCOLOR), when set to $(i,always) or $(i,never), sets a default \ value for the --color option."; `P "$(i,OPAMCRITERIA) specifies user $(i,preferences) for dependency \ solving. The default value depends on the solver version, use `config \ report` to know the current setting. See also option --criteria"; `P "$(i,OPAMCUDFFILE file) save the cudf graph to \ $(i,file)-actions-explicit.dot"; `P "$(i,OPAMCURL) can be used to select a given 'curl' program. See \ $(i,OPAMFETCH) for more options."; `P "$(i,OPAMDEBUG) see options `--debug' and `--debug-level'."; `P "$(i,OPAMDOWNLOADJOBS) sets the maximum number of simultaneous downloads."; `P "$(i,OPAMDRYRUN) see option `--dry-run`"; `P "$(i,OPAMEDITOR) sets the editor to use for opam file editing, overrides \ $(i,\\$EDITOR) and $(i,\\$VISUAL)"; `P "$(i,OPAMERRLOGLEN) sets the number of log lines printed when a \ sub-process fails. 0 to print all."; `P "$(i,OPAMEXTERNALSOLVER) see option `--solver'."; `P "$(i,OPAMFAKE) see option `--fake`"; `P "$(i,OPAMFETCH) specifies how to download files: either `wget', `curl' or \ a custom command where variables $(b,%{url}%), $(b,%{out}%), \ $(b,%{retry}%), $(b,%{compress}%) and $(b,%{checksum}%) will \ be replaced. Overrides the \ 'download-command' value from the main config file."; `P "$(i,OPAMFIXUPCRITERIA) same as $(i,OPAMUPGRADECRITERIA), but specific \ to fixup"; `P "$(i,OPAMIGNORECONSTRAINTS) see install option `--ignore-constraints-on`"; `P "$(i,OPAMIGNOREPINDEPENDS) see option `--ignore-pin-depends`"; `P "$(i,OPAMJOBS) sets the maximum number of parallel workers to run."; `P "$(i,OPAMJSON) log json output to the given file (use character `%' to \ index the files)"; `P "$(i,OPAMLOCKED) see install option `--locked`"; `P "$(i,OPAMLOGS logdir) sets log directory, default is a temporary directory \ in /tmp"; `P "$(i,OPAMMAKECMD) set the system make command to use"; `P "$(i,OPAMNOAUTOUPGRADE) disables automatic internal upgrade of \ repositories in an earlier format to the current one, on 'update' or \ 'init'."; `P "$(i,OPAMKEEPLOGS) tells opam to not remove some temporary command logs \ and some backups. This skips some finalisers and may also help to get \ more reliable backtraces"; `P "$(i,OPAMLOCKRETRIES) sets the number of tries after which opam gives up \ acquiring its lock and fails. <= 0 means infinite wait."; `P "$(i,OPAMMERGEOUT) merge process outputs, stderr on stdout"; `P "$(i,OPAMNO) answer no to any question asked."; `P "$(i,OPAMNOASPCUD) Deprecated."; `P "$(i,OPAMNOCHECKSUMS) enables option --no-checksums when available."; `P "$(i,OPAMNOSELFUPGRADE) see option `--no-self-upgrade'."; `P "$(i,OPAMPINKINDAUTO) sets whether version control systems should be \ detected when pinning to a local path. Enabled by default since 1.3.0."; `P "$(i,OPAMPRECISETRACKING) fine grain tracking of directories"; `P "$(i,OPAMREQUIRECHECKSUMS) Enables option `--require-checksums' when \ available (e.g. for `opam install`)."; `P "$(i,OPAMRETRES) sets the number of tries before failing downloads."; `P "$(i,OPAMROOT) see option `--root'. This is automatically set by \ `opam env --root=DIR --set-root'."; `P "$(i,OPAMROOTISOK) don't complain when running as root."; `P "$(i,OPAMSAFE) see option `--safe'"; `P "$(i,OPAMSHOW) see option `--show`"; `P "$(i,OPAMSKIPUPDATE) see option `--skip-updates`"; `P "$(i,OPAMSKIPVERSIONCHECKS) bypasses some version checks. Unsafe, for \ compatibility testing only."; `P (Printf.sprintf "$(i,OPAMSOLVERTIMEOUT) change the time allowance of the solver. \ Default is %.1f, set to 0 for unlimited. Note that all solvers may \ not support this option." (OpamStd.Option.default 0. OpamSolverConfig.(default.solver_timeout))); `P ("$(i,OPAMSTATUSLINE) display a dynamic status line showing what's \ currently going on on the terminal. \ (one of "^Arg.doc_alts_enum when_enum^")"); `P "$(i,OPAMSTATS) display stats at the end of command"; `P "$(i,OPAMSTRICT) fail on inconsistencies (file reading, switch import, etc.)"; `P "$(i,OPAMSWITCH) see option `--switch'. Automatically set by \ `opam env --switch=SWITCH --set-switch'."; `P "$(i,OPAMUNLOCKBASE) see install option `--unlock-base`"; `P ("$(i,OPAMUPGRADECRITERIA) specifies user $(i,preferences) for dependency \ solving when performing an upgrade. Overrides $(i,OPAMCRITERIA) in \ upgrades if both are set. See also option --criteria"); `P "$(i,OPAMUSEINTERNALSOLVER) see option `--use-internal-solver'."; `P "$(i,OPAMUSEOPENSSL) force openssl use for hash computing"; `P ("$(i,OPAMUTF8) use UTF8 characters in output \ (one of "^Arg.doc_alts_enum when_enum^ "). By default `auto', which is determined from the locale)."); `P "$(i,OPAMUTF8MSGS) use extended UTF8 characters (camels) in opam \ messages. Implies $(i,OPAMUTF8). This is set by default on OSX only."; `P "$(i,OPAMVALIDATIONHOOK hook) if set, uses the `%{hook%}` command to \ validate an opam repository update"; `P "$(i,OPAMVAR_var) overrides the contents of the variable $(i,var) when \ substituting `%{var}%` strings in `opam` files."; `P "$(i,OPAMVAR_package_var) overrides the contents of the variable \ $(i,package:var) when substituting `%{package:var}%` strings in \ `opam` files."; `P "$(i,OPAMVERBOSE) see option `--verbose'."; `P "$(i,OPAMWORKINGDIR) see option `--working-dir`"; `P "$(i,OPAMYES) see option `--yes'."; `S "EXIT STATUS"; `P "As an exception to the following, the `exec' command returns 127 if the \ command was not found or couldn't be executed, and the command's exit \ value otherwise." ] @ List.map (fun (reason, code) -> `I (string_of_int code, match reason with | `Success -> "Success, or true for boolean queries." | `False -> "False. Returned when a boolean return value is expected, e.g. when \ running with $(b,--check), or for queries like $(b,opam lint)." | `Bad_arguments -> "Bad command-line arguments, or command-line arguments pointing to \ an invalid context (e.g. file not following the expected format)." | `Not_found -> "Not found. You requested something (package, version, repository, \ etc.) that couldn't be found." | `Aborted -> "Aborted. The operation required confirmation, which wasn't given." | `Locked -> "Could not acquire the locks required for the operation." | `No_solution -> "There is no solution to the user request. This can be caused by \ asking to install two incompatible packages, for example." | `File_error -> "Error in package definition, or other metadata files. Using \ $(b,--strict) raises this error more often." | `Package_operation_error -> "Package script error. Some package operations were unsuccessful. \ This may be an error in the packages or an incompatibility with \ your system. This can be a partial error." | `Sync_error -> "Sync error. Could not fetch some remotes from the network. This can \ be a partial error." | `Configuration_error -> "Configuration error. Opam or system configuration doesn't allow \ operation, and needs fixing." | `Solver_failure -> "Solver failure. The solver failed to return a sound answer. It can \ be due to a broken external solver, or an error in solver \ configuration." | `Internal_error -> "Internal error. Something went wrong, likely due to a bug in opam \ itself." | `User_interrupt -> "User interrupt. SIGINT was received, generally due to the user \ pressing Ctrl-C." )) OpamStd.Sys.exit_codes @ [ `S "FURTHER DOCUMENTATION"; `P (Printf.sprintf "See https://opam.ocaml.org/doc."); `S "AUTHORS"; `P "Vincent Bernardoff "; `Noblank; `P "Raja Boujbel "; `Noblank; `P "Roberto Di Cosmo "; `Noblank; `P "Thomas Gazagnaire "; `Noblank; `P "Louis Gesbert "; `Noblank; `P "Fabrice Le Fessant "; `Noblank; `P "Anil Madhavapeddy "; `Noblank; `P "Guillem Rieu "; `Noblank; `P "Ralf Treinen "; `Noblank; `P "Frederic Tuong "; `S "BUGS"; `P "Check bug reports at https://github.com/ocaml/opam/issues."; ] (* Converters *) let pr_str = Format.pp_print_string let repository_name = let parse str = `Ok (OpamRepositoryName.of_string str) in let print ppf name = pr_str ppf (OpamRepositoryName.to_string name) in parse, print let url = let parse str = `Ok (OpamUrl.parse str) in let print ppf url = pr_str ppf (OpamUrl.to_string url) in parse, print let filename = let parse str = `Ok (OpamFilename.of_string str) in let print ppf filename = pr_str ppf (OpamFilename.to_string filename) in parse, print let existing_filename_or_dash = let parse str = if str = "-" then `Ok None else let f = OpamFilename.of_string str in if OpamFilename.exists f then `Ok (Some f) else `Error (Printf.sprintf "File %s not found" (OpamFilename.to_string f)) in let print ppf filename = pr_str ppf OpamStd.Option.Op.((filename >>| OpamFilename.to_string) +! "-") in parse, print let dirname = let parse str = `Ok (OpamFilename.Dir.of_string str) in let print ppf dir = pr_str ppf (OpamFilename.prettify_dir dir) in parse, print let existing_filename_dirname_or_dash = let parse str = if str = "-" then `Ok None else match OpamFilename.opt_file (OpamFilename.of_string str) with | Some f -> `Ok (Some (OpamFilename.F f)) | None -> match OpamFilename.opt_dir (OpamFilename.Dir.of_string str) with | Some d -> `Ok (Some (OpamFilename.D d)) | None -> `Error (Printf.sprintf "File or directory %s not found" str) in let print ppf gf = pr_str ppf @@ match gf with | None -> "-" | Some (OpamFilename.D d) -> OpamFilename.Dir.to_string d | Some (OpamFilename.F f) -> OpamFilename.to_string f in parse, print let package_name = let parse str = try `Ok (OpamPackage.Name.of_string str) with Failure msg -> `Error msg in let print ppf pkg = pr_str ppf (OpamPackage.Name.to_string pkg) in parse, print let positive_integer : int Arg.converter = let (parser, printer) = Arg.int in let parser s = match parser s with | `Error _ -> `Error "expected a strictly positive integer" | `Ok n as r -> if n <= 0 then `Error "expected a positive integer" else r in (parser, printer) (* name * version option *) let package = let parse str = let re = Re.(compile @@ seq [ bos; group @@ rep1 @@ diff any (set ">=<.!"); opt @@ seq [ set ".="; group @@ rep1 any ]; eos; ]) in try let sub = Re.exec re str in let name = OpamPackage.Name.of_string (Re.get sub 1) in let version_opt = try Some (OpamPackage.Version.of_string (Re.get sub 2)) with Not_found -> None in `Ok (name, version_opt) with Not_found | Failure _ -> `Error "bad package format" in let print ppf (name, version_opt) = match version_opt with | None -> pr_str ppf (OpamPackage.Name.to_string name) | Some v -> pr_str ppf (OpamPackage.Name.to_string name ^"."^ OpamPackage.Version.to_string v) in parse, print let package_with_version = let parse str = match fst package str with | `Ok (n, Some v) -> `Ok (OpamPackage.create n v) | `Ok (_, None) -> `Error "missing package version" | `Error e -> `Error e in let print ppf nv = pr_str ppf (OpamPackage.to_string nv) in parse, print (* name * version constraint *) let atom = let parse str = let re = Re.(compile @@ seq [ bos; group @@ rep1 @@ diff any (set ">=<.!"); group @@ alt [ seq [ set "<>"; opt @@ char '=' ]; set "=."; str "!="; ]; group @@ rep1 any; eos; ]) in try let sub = Re.exec re str in let sname = Re.get sub 1 in let sop = Re.get sub 2 in let sversion = Re.get sub 3 in let name = OpamPackage.Name.of_string sname in let sop = if sop = "." then "=" else sop in let op = OpamLexer.relop sop in let version = OpamPackage.Version.of_string sversion in `Ok (name, Some (op, version)) with Not_found | Failure _ | OpamLexer.Error _ -> try `Ok (OpamPackage.Name.of_string str, None) with Failure msg -> `Error msg in let print ppf atom = pr_str ppf (OpamFormula.short_string_of_atom atom) in parse, print let atom_or_local = let parse str = if OpamStd.String.contains ~sub:Filename.dir_sep str || OpamStd.String.starts_with ~prefix:"." str then if OpamFilename.(exists (of_string str)) then `Ok (`Filename (OpamFilename.of_string str)) else if OpamFilename.(exists_dir (Dir.of_string str)) then `Ok (`Dirname (OpamFilename.Dir.of_string str)) else `Error (Printf.sprintf "Not a valid package specification or existing file or \ directory: %s" str) else match fst atom str with | `Ok at -> `Ok (`Atom at) | `Error e -> `Error e in let print ppf = function | `Filename f -> pr_str ppf (OpamFilename.to_string f) | `Dirname d -> pr_str ppf (OpamFilename.Dir.to_string d) | `Atom a -> snd atom ppf a in parse, print let atom_or_dir = let parse str = match fst atom_or_local str with | `Ok (`Filename _) -> `Error (Printf.sprintf "Not a valid package specification or existing directory: %s" str) | `Ok (`Atom _ | `Dirname _ as atom_or_dir) -> `Ok (atom_or_dir) | `Error e -> `Error e in let print ppf = snd atom_or_local ppf in parse, print let variable_bindings = let parse str = try OpamStd.String.split str ',' |> List.map (fun s -> match OpamStd.String.cut_at s '=' with | Some (a, b) -> OpamVariable.of_string a, b | None -> Printf.ksprintf failwith "%S is not a binding" s) |> fun bnds -> `Ok bnds with Failure e -> `Error e in let print ppf x = List.map (fun (a,b) -> Printf.sprintf "%s=%s" (OpamVariable.to_string a) b) x |> String.concat "," |> pr_str ppf in parse, print let warn_selector = let parse str = let sep = Re.(compile (set "+-")) in let sel = Re.(compile @@ seq [bos; group (rep1 digit); opt @@ seq [str ".."; group (rep1 digit)]; eos]) in let rec seq i j = if i = j then [i] else if i < j then i :: seq (i+1) j else j :: seq (j+1) i in let rec aux acc = function | `Delim d :: `Text n :: r -> let nums = let g = Re.exec sel n in let i = int_of_string (Re.Group.get g 1) in try seq i (int_of_string (Re.Group.get g 2)) with Not_found -> [i] in let enabled = Re.Group.get d 0 = "+" in let acc = List.fold_left (fun acc n -> (n, enabled) :: acc) acc nums in aux acc r | [] -> acc | _ -> raise Not_found in try `Ok (List.rev (aux [] (Re.split_full sep str))) with Not_found -> `Error "Expected a warning string, e.g. '--warn=-10..21+12-36'" in let print ppf warns = pr_str ppf @@ OpamStd.List.concat_map "" (fun (num,enable) -> Printf.sprintf "%c%d" (if enable then '+' else '-') num) warns in parse, print type 'a default = [> `default of string] as 'a let enum_with_default sl: 'a Arg.converter = let parse, print = Arg.enum sl in let parse s = match parse s with | `Ok _ as x -> x | _ -> `Ok (`default s) in parse, print let opamlist_column = let parse str = if OpamStd.String.ends_with ~suffix:":" str then let fld = OpamStd.String.remove_suffix ~suffix:":" str in `Ok (OpamListCommand.Field fld) else try List.find (function (OpamListCommand.Field _), _ -> false | _, name -> name = str) OpamListCommand.field_names |> fun (f, _) -> `Ok f with Not_found -> `Error (Printf.sprintf "No known printer for column %s. If you meant an opam file \ field, use '%s:' instead (with a trailing colon)." str str) in let print ppf field = Format.pp_print_string ppf (OpamListCommand.string_of_field field) in parse, print let opamlist_columns = let field_re = (* max paren nesting 1, obviously *) Re.(compile @@ seq [ start; group @@ seq [ rep @@ diff any (set ",("); opt @@ seq [char '('; rep (diff any (char ')')); char ')']; ]; alt [char ','; stop]; ]) in let parse str = try let rec aux pos = if pos = String.length str then [] else let g = Re.exec ~pos field_re str in Re.Group.get g 1 :: aux (Re.Group.stop g 0) in let fields = aux 0 in List.fold_left (function | `Error _ as e -> fun _ -> e | `Ok acc -> fun str -> match fst opamlist_column str with | `Ok f -> `Ok (acc @ [f]) | `Error _ as e -> e) (`Ok []) fields with Not_found -> `Error (Printf.sprintf "Invalid columns specification: '%s'." str) in let print ppf cols = let rec aux = function | x::(_::_) as r -> snd opamlist_column ppf x; Format.pp_print_char ppf ','; aux r | [x] -> snd opamlist_column ppf x | [] -> () in aux cols in parse, print (* Helpers *) let mk_flag ?section flags doc = let doc = Arg.info ?docs:section ~doc flags in Arg.(value & flag & doc) let mk_opt ?section ?vopt flags value doc kind default = let doc = Arg.info ?docs:section ~docv:value ~doc flags in Arg.(value & opt ?vopt kind default & doc) let mk_opt_all ?section ?vopt ?(default=[]) flags value doc kind = let doc = Arg.info ?docs:section ~docv:value ~doc flags in Arg.(value & opt_all ?vopt kind default & doc) let mk_tristate_opt ?section flags value doc = let doc = Arg.info ?docs:section ~docv:value ~doc flags in Arg.(value & opt (some (enum when_enum)) None & doc) type 'a subcommand = string * 'a * string list * string type 'a subcommands = 'a subcommand list let mk_subdoc ?(defaults=[]) commands = let bold s = Printf.sprintf "$(b,%s)" s in let it s = Printf.sprintf "$(i,%s)" s in `S "COMMANDS" :: (List.map (function | "", name -> `P (Printf.sprintf "Without argument, defaults to %s." (bold name)) | arg, default -> `I (it arg, Printf.sprintf "With a %s argument, defaults to %s %s." (it arg) (bold default) (it arg)) ) defaults) @ List.map (fun (c,_,args,d) -> let cmds = bold c ^ " " ^ OpamStd.List.concat_map " " it args in `I (cmds, d) ) commands let mk_subcommands_aux my_enum commands = let command = let doc = Arg.info ~docv:"COMMAND" [] in let commands = List.fold_left (fun acc (c,f,_,_) -> (c,f) :: acc) [] commands in Arg.(value & pos 0 (some & my_enum commands) None & doc) in let params = let doc = Arg.info ~doc:"Optional parameters." [] in Arg.(value & pos_right 0 string [] & doc) in command, params let mk_subcommands commands = mk_subcommands_aux Arg.enum commands let mk_subcommands_with_default commands = mk_subcommands_aux enum_with_default commands let make_command_alias cmd ?(options="") name = let term, info = cmd in let orig = Term.name info in let doc = Printf.sprintf "An alias for $(b,%s%s)." orig options in let man = [ `S "DESCRIPTION"; `P (Printf.sprintf "$(mname)$(b, %s) is an alias for $(mname)$(b, %s%s)." name orig options); `P (Printf.sprintf "See $(mname)$(b, %s --help) for details." orig); `S "OPTIONS"; ] @ help_sections in term, Term.info name ~docs:"COMMAND ALIASES" ~doc ~man let bad_subcommand subcommands (command, usersubcommand, userparams) = match usersubcommand with | None -> `Error (false, Printf.sprintf "Missing subcommand. Valid subcommands are %s." (OpamStd.Format.pretty_list (List.map (fun (a,_,_,_) -> a) subcommands))) | Some (`default cmd) -> `Error (true, Printf.sprintf "Invalid %s subcommand %S" command cmd) | Some usersubcommand -> let exe = Filename.basename Sys.executable_name in match List.find_all (fun (_,cmd,_,_) -> cmd = usersubcommand) subcommands with | [name, _, args, _doc] -> let usage = Printf.sprintf "%s %s [OPTION]... %s %s" exe command name (String.concat " " args) in if List.length userparams < List.length args then `Error (false, Printf.sprintf "%s: Missing argument.\nUsage: %s\n" exe usage) else `Error (false, Printf.sprintf "%s: Too many arguments.\nUsage: %s\n" exe usage) | _ -> `Error (true, Printf.sprintf "Invalid %s subcommand" command) let term_info title ~doc ~man = let man = man @ help_sections in Term.info ~sdocs:global_option_section ~docs:"COMMANDS" ~doc ~man title let arg_list name doc kind = let doc = Arg.info ~docv:name ~doc [] in Arg.(value & pos_all kind [] & doc) let nonempty_arg_list name doc kind = let doc = Arg.info ~docv:name ~doc [] in Arg.(non_empty & pos_all kind [] & doc) (* Common flags *) let print_short_flag = mk_flag ["s";"short"] "Output raw lists of names, one per line, skipping any details." let installed_roots_flag = mk_flag ["installed-roots"] "Display only the installed roots." let shell_opt = let enum = [ "bash",SH_bash; "sh",SH_sh; "csh",SH_csh; "zsh",SH_zsh; "fish",SH_fish; ] in mk_opt ["shell"] "SHELL" (Printf.sprintf "Sets the configuration mode for opam environment appropriate for \ $(docv). One of %s. Guessed from the parent processes and the \\$SHELL \ variable by default." (Arg.doc_alts_enum enum)) (Arg.some (Arg.enum enum)) None let dot_profile_flag = mk_opt ["dot-profile"] "FILENAME" "Name of the configuration file to update instead of \ $(i,~/.profile) or $(i,~/.zshrc) based on shell detection." (Arg.some filename) None let repo_kind_flag = let main_kinds = [ "http" , `http; "local", `rsync; "git" , `git; "darcs", `darcs; "hg" , `hg; ] in let aliases_kinds = [ "wget" , `http; "curl" , `http; "rsync", `rsync; ] in mk_opt ["k";"kind"] "KIND" (Printf.sprintf "Specify the kind of the repository to be used (%s)." (Arg.doc_alts_enum main_kinds)) Arg.(some (enum (main_kinds @ aliases_kinds))) None let jobs_flag = mk_opt ["j";"jobs"] "JOBS" "Set the maximal number of concurrent jobs to use. The default value is \ calculated from the number of cores. You can also set it using the \ $(b,\\$OPAMJOBS) environment variable." Arg.(some positive_integer) None let name_list = arg_list "PACKAGES" "List of package names." package_name let atom_list = arg_list "PACKAGES" "List of package names, with an optional version or constraint, \ e.g `pkg', `pkg.1.0' or `pkg>=0.5'." atom let atom_or_local_list = arg_list "PACKAGES" "List of package names, with an optional version or constraint, e.g `pkg', \ `pkg.1.0' or `pkg>=0.5' ; or files or directory names containing package \ description, with explicit directory (e.g. `./foo.opam' or `.')" atom_or_local let atom_or_dir_list = arg_list "PACKAGES" "List of package names, with an optional version or constraint, e.g `pkg', \ `pkg.1.0' or `pkg>=0.5' ; or directory names containing package \ description, with explicit directory (e.g. `./srcdir' or `.')" atom_or_dir let nonempty_atom_list = nonempty_arg_list "PACKAGES" "List of package names, with an optional version or constraint, \ e.g `pkg', `pkg.1.0' or `pkg>=0.5'." atom let param_list = arg_list "PARAMS" "List of parameters." Arg.string (* Options common to all commands *) let global_options = let section = global_option_section in let git_version = mk_flag ~section ["git-version"] "Print the git version of opam, if set (i.e. you are using a development \ version), and exit." in let debug = mk_flag ~section ["debug"] "Print debug message to stderr. \ This is equivalent to setting $(b,\\$OPAMDEBUG) to \"true\"." in let debug_level = mk_opt ~section ["debug-level"] "LEVEL" "Like $(b,--debug), but allows specifying the debug level ($(b,--debug) \ sets it to 1). Equivalent to setting $(b,\\$OPAMDEBUG) to a positive \ integer." Arg.(some int) None in let verbose = Arg.(value & flag_all & info ~docs:section ["v";"verbose"] ~doc: "Be more verbose. One $(b,-v) shows all package commands, repeat to \ also display commands called internally (e.g. $(i,tar), $(i,curl), \ $(i,patch) etc.) Repeating $(i,n) times is equivalent to setting \ $(b,\\$OPAMVERBOSE) to \"$(i,n)\".") in let quiet = mk_flag ~section ["q";"quiet"] "Disables $(b,--verbose)." in let color = mk_tristate_opt ~section ["color"] "WHEN" (Printf.sprintf "Colorize the output. $(docv) must be %s." (Arg.doc_alts_enum when_enum)) in let switch = mk_opt ~section ["switch"] "SWITCH" "Use $(docv) as the current compiler switch. \ This is equivalent to setting $(b,\\$OPAMSWITCH) to $(i,SWITCH)." Arg.(some string) None in let yes = mk_flag ~section ["y";"yes"] "Answer yes to all yes/no questions without prompting. \ This is equivalent to setting $(b,\\$OPAMYES) to \"true\"." in let strict = mk_flag ~section ["strict"] "Fail whenever an error is found in a package definition \ or a configuration file. The default is to continue silently \ if possible." in let root = mk_opt ~section ["root"] "ROOT" "Use $(docv) as the current root path. \ This is equivalent to setting $(b,\\$OPAMROOT) to $(i,ROOT)." Arg.(some dirname) None in let d_no_aspcud = mk_flag ~section ["no-aspcud"] "Deprecated." in let use_internal_solver = mk_flag ~section ["use-internal-solver"] "Disable any external solver, and use the built-in one (this requires \ that opam has been compiled with a built-in solver). This is equivalent \ to setting $(b,\\$OPAMNOASPCUD) or $(b,\\$OPAMUSEINTERNALSOLVER)." in let external_solver = mk_opt ~section ["solver"] "CMD" (Printf.sprintf "Specify the CUDF solver to use for resolving package installation \ problems. This is either a predefined solver (this version of opam \ supports %s), or a custom command that should contain the variables \ %%{input}%%, %%{output}%%, %%{criteria}%%, and optionally \ %%{timeout}%%. This is equivalent to setting $(b,\\$OPAMEXTERNALSOLVER)." (OpamStd.List.concat_map ", " (fun (module S : OpamCudfSolver.S) -> S.name) (OpamCudfSolver.default_solver_selection))) Arg.(some string) None in let solver_preferences = mk_opt ~section ["criteria"] "CRITERIA" ("Specify user $(i,preferences) for dependency solving for this run. \ Overrides both $(b,\\$OPAMCRITERIA) and $(b,\\$OPAMUPGRADECRITERIA). \ For details on the supported language, and the external solvers available, see \ $(i, http://opam.ocaml.org/doc/External_solvers.html). \ A general guide to using solver preferences can be found at \ $(i, http://www.dicosmo.org/Articles/usercriteria.pdf).") Arg.(some string) None in let cudf_file = mk_opt ~section ["cudf"] "FILENAME" "Debug option: Save the CUDF requests sent to the solver to \ $(docv)-.cudf." Arg.(some string) None in let best_effort = mk_flag ~section ["best-effort"] "Don't fail if all requested packages can't be installed: try to install \ as many as possible. Note that not all external solvers may support \ this option (recent versions of $(i,aspcud) or $(i,mccs) should). This \ is equivalent to setting $(b,\\$OPAMBESTEFFORT) environment variable." in let safe_mode = mk_flag ~section ["readonly"; "safe"] "Make sure nothing will be automatically updated or rewritten. Useful \ for calling from completion scripts, for example. Will fail whenever \ such an operation is needed ; also avoids waiting for locks, skips \ interactive questions and overrides the $(b,\\$OPAMDEBUG) variable. \ This is equivalent to set environment variable $(b,\\$OPAMSAFE)." in let json_flag = mk_opt ~section ["json"] "FILENAME" "Save the results of the opam run in a computer-readable file. If the \ filename contains the character `%', it will be replaced by an index \ that doesn't overwrite an existing file. Similar to setting the \ $(b,\\$OPAMJSON) variable." Arg.(some string) None in let no_auto_upgrade = mk_flag ~section ["no-auto-upgrade"] "When configuring or updating a repository that is written for an \ earlier opam version (1.2), opam internally converts it to the current \ format. This disables this behaviour. Note that repositories should \ define their format version in a 'repo' file at their root, or they \ will be assumed to be in the older format. It is, in any case, \ preferable to upgrade the repositories manually using $(i,opam admin \ upgrade [--mirror URL]) when possible." in let working_dir = mk_flag ~section ["working-dir"; "w"] "Whenever updating packages that are bound to a local, \ version-controlled directory, update to the current working state of \ their source instead of the last committed state, or the ref they are \ pointing to. \ This only affects packages explicitly listed on the command-line.\ It can also be set with $(b,\\$OPAMWORKINGDIR). " in let ignore_pin_depends = mk_flag ~section ["ignore-pin-depends"] "Ignore extra pins required by packages that get pinned, either manually \ through $(i,opam pin) or through $(i,opam install DIR). This is \ equivalent to setting $(b,IGNOREPINDEPENDS=true)." in Term.(const create_global_options $git_version $debug $debug_level $verbose $quiet $color $switch $yes $strict $root $external_solver $use_internal_solver $cudf_file $solver_preferences $best_effort $safe_mode $json_flag $no_auto_upgrade $working_dir $ignore_pin_depends $d_no_aspcud) (* Options common to all build commands *) let build_option_section = "PACKAGE BUILD OPTIONS" let build_options = let section = build_option_section in let keep_build_dir = mk_flag ~section ["b";"keep-build-dir"] "Keep the build directories after compiling packages. \ This is equivalent to setting $(b,\\$OPAMKEEPBUILDDIR) to \"true\"." in let reuse_build_dir = mk_flag ~section ["reuse-build-dir"] "Reuse existing build directories (kept by using $(b,--keep-build-dir)), \ instead of compiling from a fresh clone of the source. This can be \ faster, but also lead to failures if the build systems of the packages \ don't handle upgrades of dependencies well. This is equivalent to \ setting $(b,\\$OPAMREUSEBUILDDIR) to \"true\"." in let inplace_build = mk_flag ~section ["inplace-build"] "When compiling a package which has its source bound to a local \ directory, process the build and install actions directly in that \ directory, rather than in a clean copy handled by opam. This only \ affects packages that are explicitly listed on the command-line. \ This is equivalent to setting $(b,\\$OPAMINPLACEBUILD) to \"true\"." in let no_checksums = mk_flag ~section ["no-checksums"] "Do not verify the checksum of downloaded archives.\ This is equivalent to setting $(b,\\$OPAMNOCHECKSUMS) to \"true\"." in let req_checksums = mk_flag ~section ["require-checksums"] "Reject the installation of packages that don't provide a checksum for the upstream archives. \ This is equivalent to setting $(b,\\$OPAMREQUIRECHECKSUMS) to \"true\"." in let build_test = mk_flag ~section ["t";"with-test";"build-test"] "Build and $(b,run) the package unit-tests. This only affects packages \ listed on the command-line. The $(b,--build-test) form is deprecated as \ this also affects installation. This is equivalent to setting \ $(b,\\$OPAMWITHTEST) (or the deprecated $(b,\\$OPAMBUILDTEST)) to \ \"true\"." in let build_doc = mk_flag ~section ["d";"with-doc";"build-doc"] "Build the package documentation. This only affects packages listed on \ the command-line. The $(b,--build-doc) form is deprecated as this does \ also installation. This is equivalent to setting $(b,\\$OPAMWITHDOC) \ (or the deprecated $(b,\\$OPAMBUILDDOC)) to \"true\"." in let make = mk_opt ~section ["m";"make"] "MAKE" "Use $(docv) as the default 'make' command. Deprecated: use $(b,opam \ config set[-global] make MAKE) instead. Has no effect if the $(i,make) \ variable is defined." Arg.(some string) None in let show = mk_flag ~section ["show-actions"] "Call the solver and display the actions. Don't perform any changes. \ This is equivalent to setting $(b,\\$OPAMSHOW)." in let dryrun = mk_flag ~section ["dry-run"] "Simulate the command, but don't actually perform any changes. This also \ can be set with environment variable $(b,\\$OPAMDEBUG)." in let skip_update = mk_flag ~section ["skip-updates"] "When running an install, upgrade or reinstall on source-pinned \ packages, they are normally updated from their origin first. This flag \ disables that behaviour and will keep them to their version in cache. \ This is equivalent to setting $(b,\\$OPAMSKIPUPDATE)." in let fake = mk_flag ~section ["fake"] "This option registers the actions into the opam database, without \ actually performing them. \ WARNING: This option is dangerous and likely to break your opam \ environment. You probably want `--dry-run'. You've been $(i,warned)." in let ignore_constraints_on = mk_opt ~section ["ignore-constraints-on"] "PACKAGES" "Forces opam to ignore version constraints on all dependencies to the \ listed packages. This can be used to test compatibility, but expect \ builds to break when using this. Note that version constraints on \ optional dependencies and conflicts are unaffected. This is equivalent \ to setting $(b,\\$OPAMIGNORECONSTRAINTS)." Arg.(some (list package_name)) None ~vopt:(Some []) in let unlock_base = mk_flag ~section ["unlock-base"] "Allow changes to the packages set as switch base (typically, the main \ compiler). Use with caution. This is equivalent to setting the \ $(b,\\$OPAMUNLOCKBASE) environment variable" in let locked = let open Arg in value & opt ~vopt:(Some "locked") (some string) None & info ~docs:section ~docv:"SUFFIX" ["locked"] ~doc: "In commands that use opam files found from pinned sources, if a variant \ of the file with an added .$(i,SUFFIX) extension is found (e.g. \ $(b,foo.opam.locked) besides $(b,foo.opam)), that will be used instead. \ This is typically useful to offer a more specific set of dependencies \ and reproduce similar build contexts, hence the name. The $(i,opam \ lock) plugin can be used to generate such files, based on the versions \ of the dependencies currently installed on the host. This is equivalent \ to setting the $(b,\\$OPAMLOCKED) environment variable. Note that this \ option doesn't generally affect already pinned packages." in Term.(const create_build_options $keep_build_dir $reuse_build_dir $inplace_build $make $no_checksums $req_checksums $build_test $build_doc $show $dryrun $skip_update $fake $jobs_flag $ignore_constraints_on $unlock_base $locked) (* Option common to install commands *) let assume_built = Arg.(value & flag & info ["assume-built"] ~doc:"For use on locally-pinned packages: assume they have already \ been correctly built, and only run their installation \ instructions, directly from their source directory. This \ skips the build instructions and can be useful to install \ packages that are being worked on. Implies $(i,--inplace-build). \ No locally-pinned packages will be skipped.") let package_selection_section = "PACKAGE SELECTION OPTIONS" let package_selection = let section = package_selection_section in let docs = section in let depends_on = let doc = "List only packages that depend on one of (comma-separated) $(docv)." in Arg.(value & opt_all (list atom) [] & info ~doc ~docs ~docv:"PACKAGES" ["depends-on"]) in let required_by = let doc = "List only the dependencies of (comma-separated) $(docv)." in Arg.(value & opt_all (list atom) [] & info ~doc ~docs ~docv:"PACKAGES" ["required-by"]) in let conflicts_with = let doc = "List packages that have declared conflicts with at least one of the \ given list. This includes conflicts defined from the packages in the \ list, from the other package, or by a common $(b,conflict-class:) \ field." in Arg.(value & opt_all (list package_with_version) [] & info ~doc ~docs ~docv:"PACKAGES" ["conflicts-with"]) in let coinstallable_with = let doc = "Only list packages that are compatible with all of $(docv)." in Arg.(value & opt_all (list package_with_version) [] & info ~doc ~docs ~docv:"PACKAGES" ["coinstallable-with"]) in let resolve = let doc = "Restrict to a solution to install (comma-separated) $(docv), $(i,i.e.) \ a consistent set of packages including those. This is subtly different \ from `--required-by --recursive`, which is more predictable and can't \ fail, but lists all dependencies independently without ensuring \ consistency. \ Without `--installed`, the answer is self-contained and independent of \ the current installation. With `--installed', it's computed from the \ set of currently installed packages. \ `--no-switch` further makes the solution independent from the \ currently pinned packages, architecture, and compiler version. \ The combination with `--depopts' is not supported." in Arg.(value & opt_all (list atom) [] & info ~doc ~docs ~docv:"PACKAGES" ["resolve"]) in let recursive = mk_flag ["recursive"] ~section "With `--depends-on' and `--required-by', display all transitive \ dependencies rather than just direct dependencies." in let depopts = mk_flag ["depopts"] ~section "Include optional dependencies in dependency requests." in let nobuild = mk_flag ["nobuild"] ~section "Exclude build dependencies (they are included by default)." in let post = mk_flag ["post"] ~section "Include dependencies tagged as $(i,post)." in let dev = mk_flag ["dev"] ~section "Include development packages in dependencies." in let doc_flag = mk_flag ["doc";"with-doc"] ~section "Include doc-only dependencies." in let test = mk_flag ["t";"test";"with-test"] ~section "Include test-only dependencies." in let field_match = mk_opt_all ["field-match"] "FIELD:PATTERN" ~section "Filter packages with a match for $(i,PATTERN) on the given $(i,FIELD)" Arg.(pair ~sep:':' string string) in let has_flag = mk_opt_all ["has-flag"] "FLAG" ~section ("Only include packages which have the given flag set. Package flags are \ one of: "^ (OpamStd.List.concat_map " " (Printf.sprintf "$(b,%s)" @* string_of_pkg_flag) all_package_flags)) ((fun s -> match pkg_flag_of_string s with | Pkgflag_Unknown s -> `Error ("Invalid package flag "^s^", must be one of "^ OpamStd.List.concat_map " " string_of_pkg_flag all_package_flags) | f -> `Ok f), fun fmt flag -> Format.pp_print_string fmt (string_of_pkg_flag flag)) in let has_tag = mk_opt_all ["has-tag"] "TAG" ~section "Only includes packages which have the given tag set" Arg.string in let filter depends_on required_by conflicts_with coinstallable_with resolve recursive depopts nobuild post dev doc_flag test field_match has_flag has_tag = let dependency_toggles = { OpamListCommand. recursive; depopts; build = not nobuild; post; test; doc = doc_flag; dev } in List.map (fun flag -> OpamListCommand.Flag flag) has_flag @ List.map (fun tag -> OpamListCommand.Tag tag) has_tag @ List.map (fun (field,patt) -> OpamListCommand.Pattern ({OpamListCommand.default_pattern_selector with OpamListCommand.fields = [field]}, patt)) field_match @ List.map (fun deps -> OpamListCommand.Depends_on (dependency_toggles, deps)) depends_on @ List.map (fun rdeps -> OpamListCommand.Required_by (dependency_toggles, rdeps)) required_by @ List.map (fun pkgs -> OpamListCommand.Conflicts_with pkgs) conflicts_with @ List.map (fun deps -> OpamListCommand.Solution (dependency_toggles, deps)) resolve @ List.map (fun pkgs -> OpamListCommand.Coinstallable_with (dependency_toggles, pkgs)) coinstallable_with in Term.(const filter $ depends_on $ required_by $ conflicts_with $ coinstallable_with $ resolve $ recursive $ depopts $ nobuild $ post $ dev $ doc_flag $ test $ field_match $ has_flag $ has_tag) let package_listing_section = "OUTPUT FORMAT OPTIONS" let package_listing = let section = package_listing_section in let all_versions = mk_flag ["all-versions";"V"] ~section "Normally, when multiple versions of a package match, only one is shown \ in the output (the installed one, the pinned-to one, or, failing that, \ the highest one available or the highest one). This flag disables this \ behaviour and shows all matching versions. This also changes the \ default display format to include package versions instead of just \ package names (including when --short is set). This is automatically \ turned on when a single non-pattern package name is provided on the \ command-line." in let print_short = mk_flag ["short";"s"] ~section "Don't print a header, and sets the default columns to $(b,name) only. \ If you need package versions included, use $(b,--columns=package) \ instead" in let sort = mk_flag ["sort";"S"] ~section "Sort the packages in dependency order (i.e. an order in which they \ could be individually installed.)" in let columns = mk_opt ["columns"] "COLUMNS" ~section (Printf.sprintf "Select the columns to display among: %s.\n\ The default is $(b,name) when $(i,--short) is present \ and %s otherwise." (OpamStd.List.concat_map ", " (fun (_,f) -> Printf.sprintf "$(b,%s)" f) OpamListCommand.field_names) (OpamStd.List.concat_map ", " (fun f -> Printf.sprintf "$(b,%s)" (OpamListCommand.string_of_field f)) OpamListCommand.default_list_format)) Arg.(some & opamlist_columns) None in let normalise = mk_flag ["normalise"] ~section "Print the values of opam fields normalised" in let wrap = mk_flag ["wrap"] ~section "Wrap long lines, the default being to truncate when displaying on a \ terminal, or to keep as is otherwise" in let separator = Arg.(value & opt string " " & info ["separator"] ~docv:"STRING" ~docs:package_listing_section ~doc:"Set the column-separator string") in let format all_versions short sort columns normalise wrap separator = fun ~force_all_versions -> let all_versions = force_all_versions || all_versions in let columns = match columns with | Some c -> c | None -> let cols = if short then [OpamListCommand.Name] else OpamListCommand.default_list_format in if all_versions then List.map (function | OpamListCommand.Name -> OpamListCommand.Package | c -> c) cols else cols in { OpamListCommand. short; header = not short; columns; all_versions; wrap = if wrap then Some (`Wrap "\\ ") else Some `Truncate; separator; value_printer = if normalise then `Normalised else `Normal; order = if sort then `Dependency else `Standard; } in Term.(const format $ all_versions $ print_short $ sort $ columns $ normalise $ wrap $ separator) opam-2.0.5/src/client/opamAdminCommand.ml0000644000175000017500000011735713511367404017277 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2017 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamProcess.Job.Op open OpamStateTypes open Cmdliner let admin_command_doc = "Tools for repository administrators" let admin_command_man = [ `S "DESCRIPTION"; `P "This command can perform various actions on repositories in the opam \ format. It is expected to be run from the root of a repository, i.e. a \ directory containing a 'repo' file and a subdirectory 'packages/' \ holding package definition within subdirectories. A 'compilers/' \ subdirectory (opam repository format version < 2) will also be used by \ the $(b,upgrade-format) subcommand." ] let index_command_doc = "Generate an inclusive index file for serving over HTTP." let index_command = let command = "index" in let doc = index_command_doc in let man = [ `S "DESCRIPTION"; `P "An opam repository can be served over HTTP or HTTPS using any web \ server. To that purpose, an inclusive index needs to be generated \ first: this command generates the files the opam client will expect \ when fetching from an HTTP remote, and should be run after any changes \ are done to the contents of the repository." ] in let urls_txt_arg = Arg.(value & vflag `minimal_urls_txt [ `no_urls_txt, info ["no-urls-txt"] ~doc: "Don't generate a 'urls.txt' file. That index file is no longer \ needed from opam 2.0 on, but is still used by older versions."; `full_urls_txt, info ["full-urls-txt"] ~doc: "Generate an inclusive 'urls.txt', for a repository that will be \ used by opam versions earlier than 2.0."; `minimal_urls_txt, info ["minimal-urls-txt"] ~doc: "Generate a minimal 'urls.txt' file, that only includes the 'repo' \ file. This allows opam versions earlier than 2.0 to read that file, \ and be properly redirected to a repository dedicated to their \ version, assuming a suitable 'redirect:' field is defined, instead \ of failing. This is the default."; ]) in let cmd global_options urls_txt = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in if not (OpamFilename.exists_dir OpamFilename.Op.(repo_root / "packages")) then OpamConsole.error_and_exit `Bad_arguments "No repository found in current directory.\n\ Please make sure there is a \"packages/\" directory"; let repo_file = OpamRepositoryPath.repo repo_root in let repo_def = match OpamFile.Repo.read_opt repo_file with | None -> OpamConsole.warning "No \"repo\" file found. Creating a minimal one."; OpamFile.Repo.create ~opam_version:OpamVersion.current_nopatch () | Some r -> r in let repo_stamp = let date () = let t = Unix.gmtime (Unix.time ()) in Printf.sprintf "%04d-%02d-%02d %02d:%02d" (t.Unix.tm_year + 1900) (t.Unix.tm_mon +1) t.Unix.tm_mday t.Unix.tm_hour t.Unix.tm_min in match OpamUrl.guess_version_control (OpamFilename.Dir.to_string repo_root) with | None -> date () | Some vcs -> let module VCS = (val OpamRepository.find_backend_by_kind vcs) in match OpamProcess.Job.run (VCS.revision repo_root) with | None -> date () | Some hash -> OpamPackage.Version.to_string hash in let repo_def = OpamFile.Repo.with_stamp repo_stamp repo_def in OpamFile.Repo.write repo_file repo_def; if urls_txt <> `no_urls_txt then (OpamConsole.msg "Generating urls.txt...\n"; OpamFilename.of_string "repo" :: (if urls_txt = `full_urls_txt then OpamFilename.rec_files OpamFilename.Op.(repo_root / "compilers") @ OpamFilename.rec_files (OpamRepositoryPath.packages_dir repo_root) else []) |> List.fold_left (fun set f -> if not (OpamFilename.exists f) then set else let attr = OpamFilename.to_attribute repo_root f in OpamFilename.Attribute.Set.add attr set ) OpamFilename.Attribute.Set.empty |> OpamFile.File_attributes.write (OpamFile.make (OpamFilename.of_string "urls.txt"))); OpamConsole.msg "Generating index.tar.gz...\n"; OpamHTTP.make_index_tar_gz repo_root; OpamConsole.msg "Done.\n"; in Term.(const cmd $ OpamArg.global_options $ urls_txt_arg), OpamArg.term_info command ~doc ~man (* Downloads all urls of the given package to the given cache_dir *) let package_files_to_cache repo_root cache_dir ?link (nv, prefix) = match OpamFileTools.read_opam (OpamRepositoryPath.packages repo_root prefix nv) with | None -> Done (OpamPackage.Map.empty) | Some opam -> let add_to_cache ?name urlf errors = let label = OpamPackage.to_string nv ^ OpamStd.Option.to_string ((^) "/") name in match OpamFile.URL.checksum urlf with | [] -> OpamConsole.warning "[%s] no checksum, not caching" (OpamConsole.colorise `green label); Done errors | (first_checksum :: _) as checksums -> OpamRepository.pull_file_to_cache label ~cache_dir checksums (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| function | Not_available (_,m) -> OpamPackage.Map.update nv (fun l -> m::l) [] errors | Up_to_date () | Result () -> OpamStd.Option.iter (fun link_dir -> let target = OpamRepository.cache_file cache_dir first_checksum in let name = OpamStd.Option.default (OpamUrl.basename (OpamFile.URL.url urlf)) name in let link = OpamFilename.Op.(link_dir / OpamPackage.to_string nv // name) in OpamFilename.link ~relative:true ~target ~link) link; errors in let urls = (match OpamFile.OPAM.url opam with | None -> [] | Some urlf -> [add_to_cache urlf]) @ (List.map (fun (name,urlf) -> add_to_cache ~name:(OpamFilename.Base.to_string name) urlf) (OpamFile.OPAM.extra_sources opam)) in OpamProcess.Job.seq urls OpamPackage.Map.empty let cache_command_doc = "Fills a local cache of package archives" let cache_command = let command = "cache" in let doc = cache_command_doc in let man = [ `S "DESCRIPTION"; `P "Downloads the archives for all packages to fill a local cache, that \ can be used when serving the repository." ] in let cache_dir_arg = Arg.(value & pos 0 OpamArg.dirname (OpamFilename.Dir.of_string "./cache") & info [] ~docv:"DIR" ~doc: "Name of the cache directory to use.") in let no_repo_update_arg = Arg.(value & flag & info ["no-repo-update";"n"] ~doc: "Don't check, create or update the 'repo' file to point to the \ generated cache ('archive-mirrors:' field).") in let link_arg = Arg.(value & opt (some OpamArg.dirname) None & info ["link"] ~docv:"DIR" ~doc: "Create reverse symbolic links to the archives within $(i,DIR), in \ the form $(b,DIR/PKG.VERSION/FILENAME).") in let jobs_arg = Arg.(value & opt OpamArg.positive_integer 8 & info ["jobs"; "j"] ~docv:"JOBS" ~doc: "Number of parallel downloads") in let cmd global_options cache_dir no_repo_update link jobs = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in if not (OpamFilename.exists_dir OpamFilename.Op.(repo_root / "packages")) then OpamConsole.error_and_exit `Bad_arguments "No repository found in current directory.\n\ Please make sure there is a \"packages\" directory"; let repo_file = OpamRepositoryPath.repo repo_root in let repo_def = OpamFile.Repo.safe_read repo_file in let repo = OpamRepositoryBackend.local repo_root in let pkg_prefixes = OpamRepository.packages_with_prefixes repo in let errors = OpamParallel.reduce ~jobs ~nil:OpamPackage.Map.empty ~merge:(OpamPackage.Map.union (fun a _ -> a)) ~command:(package_files_to_cache repo_root cache_dir ?link) (List.sort (fun (nv1,_) (nv2,_) -> (* Some pseudo-randomisation to avoid downloading all files from the same host simultaneously *) match compare (Hashtbl.hash nv1) (Hashtbl.hash nv2) with | 0 -> compare nv1 nv2 | n -> n) (OpamPackage.Map.bindings pkg_prefixes)) in if not no_repo_update then let cache_dir_url = OpamFilename.remove_prefix_dir repo_root cache_dir in if not (List.mem cache_dir_url (OpamFile.Repo.dl_cache repo_def)) then (OpamConsole.msg "Adding %s to %s...\n" cache_dir_url (OpamFile.to_string repo_file); OpamFile.Repo.write repo_file (OpamFile.Repo.with_dl_cache (cache_dir_url :: OpamFile.Repo.dl_cache repo_def) repo_def)); if not (OpamPackage.Map.is_empty errors) then ( OpamConsole.error "Got some errors while processing: %s" (OpamStd.List.concat_map ", " OpamPackage.to_string (OpamPackage.Map.keys errors)); OpamConsole.errmsg "%s" (OpamStd.Format.itemize (fun (nv,el) -> Printf.sprintf "[%s] %s" (OpamPackage.to_string nv) (String.concat "\n" el)) (OpamPackage.Map.bindings errors)) ); OpamConsole.msg "Done.\n"; in Term.(const cmd $ OpamArg.global_options $ cache_dir_arg $ no_repo_update_arg $ link_arg $ jobs_arg), OpamArg.term_info command ~doc ~man let add_hashes_command_doc = "Add archive hashes to an opam repository." let add_hashes_command = let command = "add-hashes" in let doc = add_hashes_command_doc in let cache_dir = OpamFilename.Dir.of_string "~/.cache/opam-hash-cache" in let man = [ `S "DESCRIPTION"; `P (Printf.sprintf "This command scans through package definitions, and add hashes as \ requested (fetching the archives if required). A cache is generated \ in %s for subsequent runs." (OpamFilename.Dir.to_string cache_dir)); ] in let hash_kinds = [`MD5; `SHA256; `SHA512] in let hash_types_arg = let hash_kind_conv = Arg.enum (List.map (fun k -> OpamHash.string_of_kind k, k) hash_kinds) in Arg.(non_empty & pos_all hash_kind_conv [] & info [] ~docv:"HASH_ALGO" ~doc: "The hash, or hashes to be added") in let replace_arg = Arg.(value & flag & info ["replace"] ~doc: "Replace the existing hashes rather than adding to them") in let hash_tables = let t = Hashtbl.create (List.length hash_kinds) in List.iter (fun k1 -> List.iter (fun k2 -> if k1 <> k2 then ( let cache_file : string list list OpamFile.t = OpamFile.make @@ OpamFilename.Op.( cache_dir // (OpamHash.string_of_kind k1 ^ "_to_" ^ OpamHash.string_of_kind k2)) in let t_mapping = Hashtbl.create 187 in (OpamStd.Option.default [] (OpamFile.Lines.read_opt cache_file) |> List.iter @@ function | [src; dst] -> Hashtbl.add t_mapping (OpamHash.of_string src) (OpamHash.of_string dst) | _ -> failwith ("Bad cache at "^OpamFile.to_string cache_file)); Hashtbl.add t (k1,k2) (cache_file, t_mapping); )) hash_kinds ) hash_kinds; t in let save_hashes () = Hashtbl.iter (fun _ (file, tbl) -> Hashtbl.fold (fun src dst l -> [OpamHash.to_string src; OpamHash.to_string dst]::l) tbl [] |> fun lines -> try OpamFile.Lines.write file lines with e -> OpamStd.Exn.fatal e; OpamConsole.log "ADMIN" "Could not write hash cache to %s, skipping (%s)" (OpamFile.to_string file) (Printexc.to_string e)) hash_tables in let additions_count = ref 0 in let get_hash cache_urls kind known_hashes url = let found = List.fold_left (fun result hash -> match result with | None -> let known_kind = OpamHash.kind hash in let _, tbl = Hashtbl.find hash_tables (known_kind, kind) in (try Some (Hashtbl.find tbl hash) with Not_found -> None) | some -> some) None known_hashes in match found with | Some h -> Some h | None -> let h = OpamProcess.Job.run @@ OpamFilename.with_tmp_dir_job @@ fun dir -> let f = OpamFilename.Op.(dir // OpamUrl.basename url) in OpamProcess.Job.ignore_errors ~default:None (fun () -> OpamRepository.pull_file (OpamUrl.to_string url) ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) ~cache_urls f known_hashes [url] @@| function | Result () | Up_to_date () -> OpamHash.compute ~kind (OpamFilename.to_string f) |> OpamStd.Option.some | Not_available _ -> None) in (match h with | Some h -> List.iter (fun h0 -> Hashtbl.replace (snd (Hashtbl.find hash_tables (OpamHash.kind h0, kind))) h0 h ) known_hashes; incr additions_count; if !additions_count mod 20 = 0 then save_hashes () | None -> ()); h in let cmd global_options hash_types replace = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in if not (OpamFilename.exists_dir OpamFilename.Op.(repo_root / "packages")) then OpamConsole.error_and_exit `Bad_arguments "No repository found in current directory.\n\ Please make sure there is a \"packages\" directory"; let repo = OpamRepositoryBackend.local repo_root in let cache_urls = let repo_file = OpamRepositoryPath.repo repo_root in List.map (fun rel -> if OpamStd.String.contains ~sub:"://" rel then OpamUrl.of_string rel else OpamUrl.Op.(OpamUrl.of_string (OpamFilename.Dir.to_string repo_root) / rel)) (OpamFile.Repo.dl_cache (OpamFile.Repo.safe_read repo_file)) in let pkg_prefixes = OpamRepository.packages_with_prefixes repo in let has_error = OpamPackage.Map.fold (fun nv prefix has_error -> let opam_file = OpamRepositoryPath.opam repo_root prefix nv in let opam = OpamFile.OPAM.read opam_file in let has_error = if OpamFile.exists (OpamRepositoryPath.url repo_root prefix nv) then (OpamConsole.warning "Not updating external URL file at %s" (OpamFile.to_string (OpamRepositoryPath.url repo_root prefix nv)); true) else has_error in let process_url has_error urlf = let hashes = OpamFile.URL.checksum urlf in let hashes = if replace then List.filter (fun h -> List.mem (OpamHash.kind h) hash_types) hashes else hashes in let has_error, hashes = List.fold_left (fun (has_error, hashes) kind -> if List.exists (fun h -> OpamHash.kind h = kind) hashes then has_error, hashes else match get_hash cache_urls kind hashes (OpamFile.URL.url urlf) with | Some h -> has_error, hashes @ [h] | None -> OpamConsole.error "Could not get hash for %s: %s" (OpamPackage.to_string nv) (OpamUrl.to_string (OpamFile.URL.url urlf)); true, hashes) (has_error, hashes) hash_types in has_error, OpamFile.URL.with_checksum hashes urlf in let has_error, url_opt = match OpamFile.OPAM.url opam with | None -> has_error, None | Some urlf -> let has_error, urlf = process_url has_error urlf in has_error, Some urlf in let has_error, extra_sources = List.fold_right (fun (basename, urlf) (has_error, acc) -> let has_error, urlf = process_url has_error urlf in has_error, (basename, urlf) :: acc) (OpamFile.OPAM.extra_sources opam) (has_error, []) in let opam1 = OpamFile.OPAM.with_url_opt url_opt opam in let opam1 = OpamFile.OPAM.with_extra_sources extra_sources opam1 in if opam1 <> opam then OpamFile.OPAM.write_with_preserved_format opam_file opam1; has_error ) pkg_prefixes false in save_hashes (); if has_error then OpamStd.Sys.exit_because `Sync_error else OpamStd.Sys.exit_because `Success in Term.(const cmd $ OpamArg.global_options $ hash_types_arg $ replace_arg), OpamArg.term_info command ~doc ~man let upgrade_command_doc = "Upgrades repository from earlier opam versions." let upgrade_command = let command = "upgrade" in let doc = upgrade_command_doc in let man = [ `S "DESCRIPTION"; `P "This command reads repositories from earlier opam versions, and \ converts them to repositories suitable for the current opam version. \ Packages might be created or renamed, and any compilers defined in the \ old format ('compilers/' directory) will be turned into packages, \ using a pre-defined hierarchy that assumes OCaml compilers." ] in let clear_cache_arg = let doc = "Instead of running the upgrade, clear the cache of archive hashes (held \ in ~/.cache), that is used to avoid re-downloading files to obtain \ their hashes at every run." in Arg.(value & flag & info ["clear-cache"] ~doc) in let create_mirror_arg = let doc = "Don't overwrite the current repository, but put an upgraded mirror in \ place in a subdirectory, with proper redirections. Needs the URL the \ repository will be served from to put in the redirects (older versions \ of opam don't understand relative redirects)." in Arg.(value & opt (some OpamArg.url) None & info ~docv:"URL" ["m"; "mirror"] ~doc) in let cmd global_options clear_cache create_mirror = OpamArg.apply_global_options global_options; if clear_cache then OpamAdminRepoUpgrade.clear_cache () else match create_mirror with | None -> OpamAdminRepoUpgrade.do_upgrade (OpamFilename.cwd ()); if OpamFilename.exists (OpamFilename.of_string "index.tar.gz") || OpamFilename.exists (OpamFilename.of_string "urls.txt") then OpamConsole.note "Indexes need updating: you should now run:\n\ \n\ \ opam admin index" | Some m -> OpamAdminRepoUpgrade.do_upgrade_mirror (OpamFilename.cwd ()) m in Term.(const cmd $ OpamArg.global_options $ clear_cache_arg $ create_mirror_arg), OpamArg.term_info command ~doc ~man let lint_command_doc = "Runs 'opam lint' and reports on a whole repository" let lint_command = let command = "lint" in let doc = lint_command_doc in let man = [ `S "DESCRIPTION"; `P "This command gathers linting results on all files in a repository. The \ warnings and errors to show or hide can be selected" ] in let short_arg = OpamArg.mk_flag ["s";"short"] "Print only packages and warning/error numbers, without explanations" in let list_arg = OpamArg.mk_flag ["list";"l"] "Only list package names, without warning details" in let include_arg = OpamArg.arg_list "INT" "Show only these warnings" OpamArg.positive_integer in let exclude_arg = OpamArg.mk_opt_all ["exclude";"x"] "INT" "Exclude the given warnings or errors" OpamArg.positive_integer in let ignore_arg = OpamArg.mk_opt_all ["ignore-packages";"i"] "INT" "Ignore any packages having one of these warnings or errors" OpamArg.positive_integer in let warn_error_arg = OpamArg.mk_flag ["warn-error";"W"] "Return failure on any warnings, not only on errors" in let cmd global_options short list incl excl ign warn_error = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in if not (OpamFilename.exists_dir OpamFilename.Op.(repo_root / "packages")) then OpamConsole.error_and_exit `Bad_arguments "No repository found in current directory.\n\ Please make sure there is a \"packages\" directory"; let repo = OpamRepositoryBackend.local repo_root in let pkg_prefixes = OpamRepository.packages_with_prefixes repo in let ret = OpamPackage.Map.fold (fun nv prefix ret -> let opam_file = OpamRepositoryPath.opam repo_root prefix nv in let w, _ = OpamFileTools.lint_file opam_file in if List.exists (fun (n,_,_) -> List.mem n ign) w then ret else let w = List.filter (fun (n,_,_) -> (incl = [] || List.mem n incl) && not (List.mem n excl)) w in if w <> [] then if list then OpamConsole.msg "%s\n" (OpamPackage.to_string nv) else if short then OpamConsole.msg "%s %s\n" (OpamPackage.to_string nv) (OpamStd.List.concat_map " " (fun (n,k,_) -> OpamConsole.colorise (match k with `Warning -> `yellow | `Error -> `red) (string_of_int n)) w) else begin OpamConsole.carriage_delete (); OpamConsole.msg "In %s:\n%s\n" (OpamPackage.to_string nv) (OpamFileTools.warns_to_string w) end; ret && not (warn_error && w <> [] || List.exists (fun (_,k,_) -> k = `Error) w)) pkg_prefixes true in OpamStd.Sys.exit_because (if ret then `Success else `False) in Term.(const cmd $ OpamArg.global_options $ short_arg $ list_arg $ include_arg $ exclude_arg $ ignore_arg $ warn_error_arg), OpamArg.term_info command ~doc ~man let check_command_doc = "Runs some consistency checks on a repository" let check_command = let command = "check" in let doc = check_command_doc in let man = [ `S "DESCRIPTION"; `P "This command runs consistency checks on a repository, and prints a \ report to stdout. Checks include packages that are not installable \ (due e.g. to a missing dependency) and dependency cycles. The \ 'available' field is ignored for these checks, that is, all packages \ are supposed to be available. By default, all checks are run." ] in let ignore_test_arg = OpamArg.mk_flag ["ignore-test-doc";"i"] "By default, $(b,{with-test}) and $(b,{with-doc}) dependencies are \ included. This ignores them, and makes the test more tolerant." in let print_short_arg = OpamArg.mk_flag ["s";"short"] "Only output a list of uninstallable packages" in let installability_arg = OpamArg.mk_flag ["installability"] "Do the installability check (and disable the others by default)" in let cycles_arg = OpamArg.mk_flag ["cycles"] "Do the cycles check (and disable the others by default)" in let obsolete_arg = OpamArg.mk_flag ["obsolete"] "Analyse for obsolete packages" in let cmd global_options ignore_test print_short installability cycles obsolete = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in let installability, cycles, obsolete = if installability || cycles || obsolete then installability, cycles, obsolete else true, true, false in if not (OpamFilename.exists_dir OpamFilename.Op.(repo_root / "packages")) then OpamConsole.error_and_exit `Bad_arguments "No repository found in current directory.\n\ Please make sure there is a \"packages\" directory"; let pkgs, unav_roots, uninstallable, cycle_packages, obsolete = OpamAdminCheck.check ~quiet:print_short ~installability ~cycles ~obsolete ~ignore_test repo_root in let all_ok = OpamPackage.Set.is_empty uninstallable && OpamPackage.Set.is_empty cycle_packages && OpamPackage.Set.is_empty obsolete in let open OpamPackage.Set.Op in (if print_short then OpamConsole.msg "%s\n" (OpamStd.List.concat_map "\n" OpamPackage.to_string (OpamPackage.Set.elements (uninstallable ++ cycle_packages ++ obsolete))) else if all_ok then OpamConsole.msg "No issues detected on this repository's %d packages\n" (OpamPackage.Set.cardinal pkgs) else let pr set msg = if OpamPackage.Set.is_empty set then "" else Printf.sprintf "- %d %s\n" (OpamPackage.Set.cardinal set) msg in OpamConsole.msg "Summary: out of %d packages (%d distinct names)\n\ %s%s%s%s\n" (OpamPackage.Set.cardinal pkgs) (OpamPackage.Name.Set.cardinal (OpamPackage.names_of_packages pkgs)) (pr unav_roots "uninstallable roots") (pr (uninstallable -- unav_roots) "uninstallable dependent packages") (pr (cycle_packages -- uninstallable) "packages part of dependency cycles") (pr obsolete "obsolete packages")); OpamStd.Sys.exit_because (if all_ok then `Success else `False) in Term.(const cmd $ OpamArg.global_options $ ignore_test_arg $ print_short_arg $ installability_arg $ cycles_arg $ obsolete_arg), OpamArg.term_info command ~doc ~man let pattern_list_arg = OpamArg.arg_list "PATTERNS" "Package patterns with globs. matching against $(b,NAME) or \ $(b,NAME.VERSION)" Arg.string let env_arg = Arg.(value & opt (list string) [] & info ["environment"] ~doc: "Use the given opam environment, in the form of a list \ comma-separated 'var=value' bindings, when resolving variables. \ This is used e.g. when computing available packages: if undefined, \ availability of packages is not taken into account. Note that, \ unless overridden, variables like 'root' or 'opam-version' may be \ taken from the current opam installation. What is defined in \ $(i,~/.opam/config) is always ignored.") let state_selection_arg = let docs = OpamArg.package_selection_section in Arg.(value & vflag OpamListCommand.Available [ OpamListCommand.Any, info ~docs ["A";"all"] ~doc:"Include all, even uninstalled or unavailable packages"; OpamListCommand.Available, info ~docs ["a";"available"] ~doc:"List only packages that are available according to the defined \ $(b,environment). Without $(b,--environment), equivalent to \ $(b,--all)."; OpamListCommand.Installable, info ~docs ["installable"] ~doc:"List only packages that are installable according to the \ defined $(b,environment) (this calls the solver and may be \ more costly; a package depending on an unavailable may be \ available, but is never installable)"; ]) let get_virtual_switch_state repo_root env = let env = List.map (fun s -> match OpamStd.String.cut_at s '=' with | Some (var,value) -> OpamVariable.of_string var, S value | None -> OpamVariable.of_string s, B true) env in let repo = OpamRepositoryBackend.local repo_root in let repo_file = OpamRepositoryPath.repo repo_root in let repo_def = OpamFile.Repo.safe_read repo_file in let opams = OpamRepositoryState.load_repo_opams repo in let gt = { global_lock = OpamSystem.lock_none; root = OpamStateConfig.(!r.root_dir); config = OpamStd.Option.Op.(OpamStateConfig.(load !r.root_dir) +! OpamFile.Config.empty); global_variables = OpamVariable.Map.empty; } in let singl x = OpamRepositoryName.Map.singleton repo.repo_name x in let rt = { repos_global = gt; repos_lock = OpamSystem.lock_none; repositories = singl repo; repos_definitions = singl repo_def; repo_opams = singl opams; } in let st = OpamSwitchState.load_virtual ~repos_list:[repo.repo_name] gt rt in if env = [] then st else let gt = {gt with global_variables = OpamVariable.Map.of_list @@ List.map (fun (var, value) -> var, (lazy (Some value), "Manually defined")) env } in {st with switch_global = gt; available_packages = lazy ( OpamPackage.keys @@ OpamPackage.Map.filter (fun package opam -> OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_switch_raw ~package gt OpamSwitch.unset OpamFile.Switch_config.empty) (OpamFile.OPAM.available opam)) st.opams )} let or_arg = Arg.(value & flag & info ~docs:OpamArg.package_selection_section ["or"] ~doc:"Instead of selecting packages that match $(i,all) the \ criteria, select packages that match $(i,any) of them") let list_command_doc = "Lists packages from a repository" let list_command = let command = "list" in let doc = list_command_doc in let man = [ `S "DESCRIPTION"; `P "This command is similar to 'opam list', but allows listing packages \ directly from a repository instead of what is available in a given \ opam installation."; `S "ARGUMENTS"; `S "OPTIONS"; `S OpamArg.package_selection_section; `S OpamArg.package_listing_section; ] in let cmd global_options package_selection disjunction state_selection package_listing env packages = OpamArg.apply_global_options global_options; let format = let force_all_versions = match packages with | [single] -> let nameglob = match OpamStd.String.cut_at single '.' with | None -> single | Some (n, _v) -> n in (try ignore (OpamPackage.Name.of_string nameglob); true with Failure _ -> false) | _ -> false in package_listing ~force_all_versions in let pattern_selector = OpamListCommand.pattern_selector packages in let join = if disjunction then OpamFormula.ors else OpamFormula.ands in let filter = OpamFormula.ands [ Atom state_selection; join (pattern_selector :: List.map (fun x -> Atom x) package_selection); ] in let st = get_virtual_switch_state (OpamFilename.cwd ()) env in if not format.OpamListCommand.short && filter <> OpamFormula.Empty then OpamConsole.msg "# Packages matching: %s\n" (OpamListCommand.string_of_formula filter); let results = OpamListCommand.filter ~base:st.packages st filter in OpamListCommand.display st format results in Term.(const cmd $ OpamArg.global_options $ OpamArg.package_selection $ or_arg $ state_selection_arg $ OpamArg.package_listing $ env_arg $ pattern_list_arg), OpamArg.term_info command ~doc ~man let filter_command_doc = "Filters a repository to only keep selected packages" let filter_command = let command = "filter" in let doc = filter_command_doc in let man = [ `S "DESCRIPTION"; `P "This command removes all package definitions that don't match the \ search criteria (specified similarly to 'opam admin list') from a \ repository."; `S "ARGUMENTS"; `S "OPTIONS"; `S OpamArg.package_selection_section; ] in let remove_arg = OpamArg.mk_flag ["remove"] "Invert the behaviour and remove the matching packages, keeping the ones \ that don't match." in let dryrun_arg = OpamArg.mk_flag ["dry-run"] "List the removal commands, without actually performing them" in let cmd global_options package_selection disjunction state_selection env remove dryrun packages = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in let pattern_selector = OpamListCommand.pattern_selector packages in let join = if disjunction then OpamFormula.ors else OpamFormula.ands in let filter = OpamFormula.ands [ Atom state_selection; join (pattern_selector :: List.map (fun x -> Atom x) package_selection) ] in let st = get_virtual_switch_state repo_root env in let packages = OpamListCommand.filter ~base:st.packages st filter in if OpamPackage.Set.is_empty packages then if remove then (OpamConsole.warning "No packages match the selection criteria"; OpamStd.Sys.exit_because `Success) else OpamConsole.error_and_exit `Not_found "No packages match the selection criteria"; let num_total = OpamPackage.Set.cardinal st.packages in let num_selected = OpamPackage.Set.cardinal packages in if remove then OpamConsole.formatted_msg "The following %d packages will be REMOVED from the repository (%d \ packages will be kept):\n%s\n" num_selected (num_total - num_selected) (OpamStd.List.concat_map " " OpamPackage.to_string (OpamPackage.Set.elements packages)) else OpamConsole.formatted_msg "The following %d packages will be kept in the repository (%d packages \ will be REMOVED):\n%s\n" num_selected (num_total - num_selected) (OpamStd.List.concat_map " " OpamPackage.to_string (OpamPackage.Set.elements packages)); let packages = if remove then packages else OpamPackage.Set.Op.(st.packages -- packages) in if not (dryrun || OpamConsole.confirm "Confirm?") then OpamStd.Sys.exit_because `Aborted else let repo = OpamRepositoryBackend.local repo_root in let pkg_prefixes = OpamRepository.packages_with_prefixes repo in OpamPackage.Map.iter (fun nv prefix -> if OpamPackage.Set.mem nv packages then let d = OpamRepositoryPath.packages repo_root prefix nv in if dryrun then OpamConsole.msg "rm -rf %s\n" (OpamFilename.Dir.to_string d) else (OpamFilename.cleandir d; OpamFilename.rmdir_cleanup d)) pkg_prefixes in Term.(const cmd $ OpamArg.global_options $ OpamArg.package_selection $ or_arg $ state_selection_arg $ env_arg $ remove_arg $ dryrun_arg $ pattern_list_arg), OpamArg.term_info command ~doc ~man let add_constraint_command_doc = "Adds version constraints on all dependencies towards a given package" let add_constraint_command = let command = "add-constraint" in let doc = add_constraint_command_doc in let man = [ `S "DESCRIPTION"; `P "This command searches to all dependencies towards a given package, and \ adds a version constraint to them. It is particularly useful to add \ upper bounds to existing dependencies when a new, incompatible major \ version of a library is added to a repository. The new version \ constraint is merged with the existing one, and simplified if \ possible (e.g. $(b,>=3 & >5) becomes $(b,>5))."; `S "ARGUMENTS"; `S "OPTIONS"; ] in let atom_arg = Arg.(required & pos 0 (some OpamArg.atom) None & info [] ~docv:"PACKAGE" ~doc: "A package name with a version constraint, e.g. $(b,name>=version). \ If no version constraint is specified, the command will just \ simplify existing version constraints on dependencies to the named \ package.") in let force_arg = Arg.(value & flag & info ["force"] ~doc: "Force updating of constraints even if the resulting constraint is \ unsatisfiable (e.g. when adding $(b,>3) to the constraint \ $(b,<2)). The default in this case is to print a warning and keep \ the existing constraint unchanged.") in let cmd global_options force atom = OpamArg.apply_global_options global_options; let repo_root = OpamFilename.cwd () in if not (OpamFilename.exists_dir OpamFilename.Op.(repo_root / "packages")) then OpamConsole.error_and_exit `Not_found "No repository found in current directory.\n\ Please make sure there is a \"packages\" directory"; let repo = OpamRepositoryBackend.local repo_root in let pkg_prefixes = OpamRepository.packages_with_prefixes repo in let name, cstr = atom in let cstr = match cstr with | Some (relop, v) -> OpamFormula.Atom (Constraint (relop, FString (OpamPackage.Version.to_string v))) | None -> OpamFormula.Empty in let add_cstr nv n c = let f = OpamFormula.ands [c; cstr] in match OpamFilter.simplify_extended_version_formula f with | Some f -> f | None -> (* conflicting constraint *) if force then f else (OpamConsole.warning "In package %s, updated constraint %s cannot be satisfied, not \ updating (use `--force' to update anyway)" (OpamPackage.to_string nv) (OpamConsole.colorise `bold (OpamFilter.string_of_filtered_formula (Atom (n, f)))); c) in OpamPackage.Map.iter (fun nv prefix -> let opam_file = OpamRepositoryPath.opam repo_root prefix nv in let opam = OpamFile.OPAM.read opam_file in let deps0 = OpamFile.OPAM.depends opam in let deps = OpamFormula.map (function | (n,c as atom) -> if n = name then Atom (n, (add_cstr nv n c)) else Atom atom) deps0 in if deps <> deps0 then OpamFile.OPAM.write_with_preserved_format opam_file (OpamFile.OPAM.with_depends deps opam)) pkg_prefixes in Term.(pure cmd $ OpamArg.global_options $ force_arg $ atom_arg), OpamArg.term_info command ~doc ~man let admin_subcommands = [ index_command; OpamArg.make_command_alias index_command "make"; cache_command; upgrade_command; lint_command; check_command; list_command; filter_command; add_constraint_command; add_hashes_command; ] let default_subcommand = let man = admin_command_man @ [ `S "COMMANDS"; `S "COMMAND ALIASES"; ] @ OpamArg.help_sections in let usage global_options = OpamArg.apply_global_options global_options; OpamConsole.formatted_msg "usage: opam admin [--version]\n\ \ [--help]\n\ \ []\n\ \n\ The most commonly used opam commands are:\n\ \ index %s\n\ \ cache %s\n\ \ upgrade-format %s\n\ \n\ See 'opam admin --help' for more information on a specific \ command.\n" index_command_doc cache_command_doc upgrade_command_doc in Term.(const usage $ OpamArg.global_options), Term.info "opam admin" ~version:(OpamVersion.to_string OpamVersion.current) ~sdocs:OpamArg.global_option_section ~doc:admin_command_doc ~man opam-2.0.5/src/client/opamCommands.mli0000644000175000017500000000305013511367404016642 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Opam CLI main entry point *) open Cmdliner (** {2 Commands} *) (** Type of commands *) type command = unit Term.t * Term.info (** The default list of commands *) val commands: command list (** opam *) val default: command (** opam init *) val init: command (** opam list *) val list: ?force_search:bool -> unit -> command (** opam show *) val show: command (** opam install *) val install: command (** opam remove *) val remove: command (** opam reinstall *) val reinstall: command (** opam update *) val update: command (** opam upgrade *) val upgrade: command (** opam config *) val config: command (** opam repository *) val repository: command (** opam switch *) val switch: command (** opam pin *) val pin: ?unpin_only:bool -> unit -> command (** opam help *) val help: command opam-2.0.5/src/client/opamAdminRepoUpgrade.ml0000644000175000017500000004556313511367404020135 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamProcess.Job.Op open OpamStd.Option.Op module O = OpamFile.OPAM let upgradeto_version_string = "2.0" let upgradeto_version = OpamVersion.of_string upgradeto_version_string let ocaml_wrapper_pkgname = OpamPackage.Name.of_string "ocaml" let ocaml_official_pkgname = OpamPackage.Name.of_string "ocaml-base-compiler" let ocaml_variants_pkgname = OpamPackage.Name.of_string "ocaml-variants" let ocaml_system_pkgname = OpamPackage.Name.of_string "ocaml-system" let ocaml_conflict_class = OpamPackage.Name.of_string "ocaml-core-compiler" let ocaml_package_names = [ocaml_wrapper_pkgname; ocaml_official_pkgname; ocaml_variants_pkgname; ocaml_system_pkgname] (* OCaml script that generates the .config file for a given ocaml compiler *) let wrapper_conf_script = "let () =\n\ \ let ocaml_version =\n\ \ let v = Sys.ocaml_version in\n\ \ try String.sub v 0 (String.index v '+') with Not_found -> v\n\ \ in\n\ \ if ocaml_version <> \"%{_:version}%\" then\n\ \ (Printf.eprintf\n\ \ \"OCaml version mismatch: %%s, expected %{_:version}%\"\n\ \ ocaml_version;\n\ \ exit 1)\n\ \ else\n\ \ let oc = open_out \"%{_:name}%.config\" in\n\ \ let exe = \".exe\" in\n\ \ let (ocaml, suffix) =\n\ \ let s = Sys.executable_name in\n\ \ if Filename.check_suffix s exe then\n\ \ (Filename.chop_suffix s exe, exe)\n\ \ else\n\ \ (s, \"\")\n\ \ in\n\ \ let ocamlc = ocaml^\"c\"^suffix in\n\ \ let libdir =\n\ \ let ic = Unix.open_process_in (ocamlc^\" -where\") in\n\ \ set_binary_mode_in ic false;\n\ \ let r = input_line ic in\n\ \ if Unix.close_process_in ic <> Unix.WEXITED 0 then \n\ \ failwith \"Bad return from 'ocamlc -where'\";\n\ \ r\n\ \ in\n\ \ let stubsdir =\n\ \ let ic = open_in (Filename.concat libdir \"ld.conf\") in\n\ \ let rec r acc = try r (input_line ic::acc) with End_of_file -> acc in\n\ \ let lines = List.rev (r []) in\n\ \ close_in ic;\n\ \ String.concat \":\" lines\n\ \ in\n\ \ let p fmt = Printf.fprintf oc (fmt ^^ \"\\n\") in\n\ \ p \"opam-version: \\\"" ^ upgradeto_version_string ^ "\\\"\";\n\ \ p \"variables {\";\n\ \ p \" native: %%b\"\n\ \ (Sys.file_exists (ocaml^\"opt\"^suffix));\n\ \ p \" native-tools: %%b\"\n\ \ (Sys.file_exists (ocamlc^\".opt\"^suffix));\n\ \ p \" native-dynlink: %%b\"\n\ \ (Sys.file_exists (Filename.concat libdir \"dynlink.cmxa\"));\n\ \ p \" stubsdir: %%S\"\n\ \ stubsdir;\n\ \ p \" preinstalled: %{ocaml-system:installed}%\";\n\ \ p \" compiler: \\\"%{ocaml-system:installed?system:}%\ %{ocaml-base-compiler:version}%\ %{ocaml-variants:version}%\\\"\";\n\ \ p \"}\";\n\ \ close_out oc\n\ " let system_conf_script = "let () =\n\ \ let exe = \".exe\" in\n\ \ let ocamlc =\n\ \ let (base, suffix) =\n\ \ let s = Sys.executable_name in\n\ \ if Filename.check_suffix s exe then\n\ \ (Filename.chop_suffix s exe, exe)\n\ \ else\n\ \ (s, \"\") in\n\ \ base ^ \"c\" ^ suffix in\n\ \ if Sys.ocaml_version <> \"%{_:version}%\" then\n\ \ (Printf.eprintf\n\ \ \"ERROR: The compiler found at %%s has version %%s,\\n\\\n\ \ and this package requires %{_:version}%.\\n\\\n\ \ You should use e.g. 'opam switch create %{_:name}%.%%s' \\\n\ \ instead.\"\n\ \ ocamlc Sys.ocaml_version Sys.ocaml_version;\n\ \ exit 1)\n\ \ else\n\ \ let ocamlc_digest = Digest.to_hex (Digest.file ocamlc) in\n\ \ let libdir =\n\ \ if Sys.command (ocamlc^\" -where > %{_:name}%.config\") = 0 then\n\ \ let ic = open_in \"%{_:name}%.config\" in\n\ \ let r = input_line ic in\n\ \ close_in ic;\n\ \ Sys.remove \"%{_:name}%.config\";\n\ \ r\n\ \ else\n\ \ failwith \"Bad return from 'ocamlc -where'\"\n\ \ in\n\ \ let graphics = Filename.concat libdir \"graphics.cmi\" in\n\ \ let graphics_digest =\n\ \ if Sys.file_exists graphics then\n\ \ Digest.to_hex (Digest.file graphics)\n\ \ else\n\ \ String.make 32 '0'\n\ \ in\n\ \ let oc = open_out \"%{_:name}%.config\" in\n\ \ Printf.fprintf oc \"opam-version: \\\"" ^ upgradeto_version_string ^ "\\\"\\n\\\n\ \ file-depends: [ [ %%S %%S ] [ %%S %%S ] ]\\n\\\n\ \ variables { path: %%S }\\n\"\n\ \ ocamlc ocamlc_digest graphics graphics_digest (Filename.dirname ocamlc);\n\ \ close_out oc\n\ " let conf_script_name = "gen_ocaml_config.ml" let all_base_packages = OpamPackage.Name.Set.of_list (List.map OpamPackage.Name.of_string [ "base-bigarray"; "base-threads"; "base-unix"; ]) let cache_file : string list list OpamFile.t = OpamFile.make @@ OpamFilename.of_string "~/.cache/opam-compilers-to-packages/url-hashes" let do_upgrade repo_root = let repo = OpamRepositoryBackend.local repo_root in let write_opam ?(add_files=[]) opam = let nv = O.package opam in let pfx = Some (OpamPackage.name_to_string nv) in let files_dir = OpamRepositoryPath.files repo.repo_root pfx nv in O.write (OpamRepositoryPath.opam repo.repo_root pfx nv) opam; List.iter (fun (base,contents) -> OpamFilename.(write Op.(files_dir // base) contents)) add_files in let compilers = let compilers_dir = OpamFilename.Op.(repo.repo_root / "compilers") in if OpamFilename.exists_dir compilers_dir then ( List.fold_left (fun map f -> if OpamFilename.check_suffix f ".comp" then let c = OpamFilename.(Base.to_string (basename (chop_extension f))) in OpamStd.String.Map.add c f map else map) OpamStd.String.Map.empty (OpamFilename.rec_files compilers_dir) ) else OpamStd.String.Map.empty in let get_url_md5, save_cache = let url_md5 = Hashtbl.create 187 in let () = OpamFile.Lines.read_opt cache_file +! [] |> List.iter @@ function | [url; md5] -> Hashtbl.add url_md5 (OpamUrl.of_string url) (OpamHash.of_string md5) | _ -> failwith "Bad cache, run 'opam admin upgrade --clear-cache'" in (fun url -> try Done (Some (Hashtbl.find url_md5 url)) with Not_found -> OpamFilename.with_tmp_dir_job @@ fun dir -> OpamProcess.Job.ignore_errors ~default:None (fun () -> OpamDownload.download ~overwrite:false url dir @@| fun f -> let hash = OpamHash.compute (OpamFilename.to_string f) in Hashtbl.add url_md5 url hash; Some hash)), (fun () -> Hashtbl.fold (fun url hash l -> [OpamUrl.to_string url; OpamHash.to_string hash]::l) url_md5 [] |> fun lines -> try OpamFile.Lines.write cache_file lines with e -> OpamStd.Exn.fatal e; OpamConsole.log "REPO_UPGRADE" "Could not write archive hash cache to %s, skipping (%s)" (OpamFile.to_string cache_file) (Printexc.to_string e)) in let ocaml_versions = OpamStd.String.Map.fold (fun c comp_file ocaml_versions -> let comp = OpamFile.Comp.read (OpamFile.make comp_file) in let descr_file = OpamFilename.(opt_file (add_extension (chop_extension comp_file) "descr")) in let descr = descr_file >>| fun f -> OpamFile.Descr.read (OpamFile.make f) in let nv, ocaml_version, variant = match OpamStd.String.cut_at c '+' with | None -> OpamPackage.create ocaml_official_pkgname (OpamPackage.Version.of_string c), c, None | Some (version,variant) -> OpamPackage.create ocaml_variants_pkgname (OpamPackage.Version.of_string (version^"+"^variant)), version, Some variant in (* (Some exotic compiler variants have e.g. 'lwt' as base package, which won't work in our current setup. They'll need to be rewritten, but break the following detection of all base packages, which isn't idempotent anyway...) List.iter (fun (name, _) -> all_base_packages := OpamPackage.Name.Set.add name !all_base_packages) (OpamFormula.atoms (OpamFile.Comp.packages comp)); *) let opam = OpamFormatUpgrade.comp_file ~package:nv ?descr comp in let opam = O.with_conflict_class [ocaml_conflict_class] opam in let opam = match OpamFile.OPAM.url opam with | Some urlf when OpamFile.URL.checksum urlf = [] -> let url = OpamFile.URL.url urlf in (match url.OpamUrl.backend with | #OpamUrl.version_control -> Some opam | `rsync when OpamUrl.local_dir url <> None -> Some opam | _ -> (match OpamProcess.Job.run (get_url_md5 url) with | None -> None | Some hash -> Some (OpamFile.OPAM.with_url (OpamFile.URL.with_checksum [hash] urlf) opam))) | _ -> Some opam in match opam with | None -> OpamConsole.error "Could not get the archive of %s, skipping" (OpamPackage.to_string nv); ocaml_versions | Some opam -> let patches = OpamFile.Comp.patches comp in if patches <> [] then OpamConsole.msg "Fetching patches of %s to check their hashes...\n" (OpamPackage.to_string nv); let extra_sources = (* Download them just to get their MD5 *) OpamParallel.map ~jobs:3 ~command:(fun url -> get_url_md5 url @@| function | Some md5 -> Some (url, md5, None) | None -> OpamConsole.error "Could not get patch file for %s from %s, skipping" (OpamPackage.to_string nv) (OpamUrl.to_string url); None) (OpamFile.Comp.patches comp) in if List.mem None extra_sources then ocaml_versions else let opam = opam |> OpamFile.OPAM.with_extra_sources (List.map (fun (url, hash, _) -> OpamFilename.Base.of_string (OpamUrl.basename url), OpamFile.URL.create ~checksum:[hash] url) (OpamStd.List.filter_some extra_sources)) in write_opam opam; if variant = None then begin (* "official" compiler release: generate a system compiler package *) let sys_nv = OpamPackage.create ocaml_system_pkgname nv.version in let rev_dep_flag = Filter (FIdent ([], OpamVariable.of_string "post", None)) in let system_opam = O.create sys_nv |> O.with_substs [OpamFilename.Base.of_string conf_script_name] |> O.with_build [ List.map (fun s -> CString s, None) [ "ocaml"; conf_script_name ], None ] |> O.with_conflict_class [ocaml_conflict_class] |> O.with_depends (OpamFormula.ands ( List.map (fun name -> Atom (OpamPackage.Name.of_string name, Atom (rev_dep_flag))) ["ocaml"; "base-unix"; "base-threads"; "base-bigarray"] )) |> O.with_maintainer [ "platform@lists.ocaml.org" ] |> O.with_flags [Pkgflag_Compiler] |> O.with_descr (OpamFile.Descr.create "The OCaml compiler (system version, from outside of opam)") |> O.with_available (FOp (FIdent ([],OpamVariable.of_string "sys-ocaml-version",None), `Eq, FString (OpamPackage.Version.to_string nv.version))) (* add depext towards an 'ocaml' package? *) in write_opam ~add_files:[conf_script_name^".in", system_conf_script] system_opam end; (* cleanup *) OpamFilename.remove comp_file; OpamStd.Option.iter OpamFilename.remove descr_file; OpamFilename.rmdir_cleanup (OpamFilename.dirname comp_file); OpamConsole.status_line "Compiler %s successfully converted to package %s" c (OpamPackage.to_string nv); OpamStd.String.Set.add ocaml_version ocaml_versions ) compilers OpamStd.String.Set.empty in OpamConsole.clear_status (); save_cache (); (* Generate "ocaml" package wrappers depending on one of the implementations at the appropriate version *) let gen_ocaml_wrapper str_version = let version = OpamPackage.Version.of_string str_version in let wrapper_nv = OpamPackage.create ocaml_wrapper_pkgname version in let upper_bound_v = let g = Re.(exec @@ compile @@ seq [rep digit; eos]) str_version in try let sn = Re.Group.get g 0 in String.sub str_version 0 (fst (Re.Group.offset g 0)) ^ (string_of_int (1 + int_of_string sn)) ^ "~" with Not_found -> str_version ^ "a" in let wrapper_opam = O.create wrapper_nv |> O.with_substs [OpamFilename.Base.of_string conf_script_name] |> O.with_build [ List.map (fun s -> CString s, None) [ "ocaml"; "unix.cma"; conf_script_name ], None ] |> O.with_maintainer [ "platform@lists.ocaml.org" ] |> O.with_build_env ["CAML_LD_LIBRARY_PATH", Eq, "", None] |> O.with_env [ "CAML_LD_LIBRARY_PATH", Eq, "%{_:stubsdir}%", None; "CAML_LD_LIBRARY_PATH", PlusEq, "%{lib}%/stublibs", None; "OCAML_TOPLEVEL_PATH", Eq, "%{toplevel}%", None; ] |> (* leave the Compiler flag to the implementations (since the user needs to select one) O.with_flags [Pkgflag_Compiler] |> *) O.with_descr (OpamFile.Descr.create "The OCaml compiler (virtual package)\n\ This package requires a matching implementation of OCaml,\n\ and polls it to initialise specific variables like \ `ocaml:native-dynlink`") |> O.with_depends (OpamFormula.ors [ Atom ( ocaml_official_pkgname, Atom (Constraint (`Eq, FString str_version)) ); Atom ( ocaml_variants_pkgname, OpamFormula.ands [ Atom (Constraint (`Geq, FString str_version)); Atom (Constraint (`Lt, FString upper_bound_v)); ] ); Atom ( ocaml_system_pkgname, Atom (Constraint (`Eq, FString str_version)) ) ]) in write_opam ~add_files:[conf_script_name^".in", wrapper_conf_script] wrapper_opam in OpamStd.String.Set.iter gen_ocaml_wrapper ocaml_versions; let packages = OpamRepository.packages_with_prefixes repo in OpamConsole.log "REPO_UPGRADE" "Will not update base packages: %s\n" (OpamPackage.Name.Set.to_string all_base_packages); OpamPackage.Map.iter (fun package prefix -> let opam_file = OpamRepositoryPath.opam repo.repo_root prefix package in let opam0 = OpamFile.OPAM.read opam_file in OpamFile.OPAM.print_errors ~file:opam_file opam0; let nv = OpamFile.OPAM.package opam0 in if not (List.mem nv.name ocaml_package_names) && not (OpamPackage.Name.Set.mem nv.name all_base_packages) then let opam = OpamFileTools.add_aux_files ~files_subdir_hashes:true opam0 in let opam = OpamFormatUpgrade.opam_file_from_1_2_to_2_0 ~filename:opam_file opam in if opam <> opam0 then (OpamFile.OPAM.write_with_preserved_format opam_file opam; List.iter OpamFilename.remove [ OpamFile.filename (OpamRepositoryPath.descr repo.repo_root prefix package); OpamFile.filename (OpamRepositoryPath.url repo.repo_root prefix package); ]; OpamConsole.status_line "Updated %s" (OpamFile.to_string opam_file)) ) packages; OpamConsole.clear_status (); let repo_file = OpamRepositoryPath.repo repo.repo_root in OpamFile.Repo.write repo_file (OpamFile.Repo.with_opam_version upgradeto_version (OpamFile.Repo.safe_read repo_file)) let clear_cache () = OpamFilename.remove (OpamFile.filename cache_file) let do_upgrade_mirror repo_root base_url = OpamFilename.with_tmp_dir @@ fun tmp_mirror_dir -> let open OpamFilename.Op in let copy_dir d = let src = repo_root / d in if OpamFilename.exists_dir src then OpamFilename.copy_dir ~src ~dst:(tmp_mirror_dir / d) in let copy_file f = let src = repo_root // f in if OpamFilename.exists src then OpamFilename.copy ~src ~dst:(tmp_mirror_dir // f) in copy_dir "packages"; copy_dir "compilers"; copy_file "repo"; do_upgrade tmp_mirror_dir; let repo_file = OpamFile.make (OpamFilename.of_string "repo") in let repo0 = OpamFile.Repo.safe_read repo_file in let opam_version_fid = FIdent ([], OpamVariable.of_string "opam-version", None) in let redir = OpamUrl.to_string OpamUrl.Op.(base_url / upgradeto_version_string), Some (FOp (opam_version_fid, `Geq, FString (upgradeto_version_string ^ "~"))) in let repo0 = if OpamFile.Repo.opam_version repo0 = None then OpamFile.Repo.with_opam_version (OpamVersion.of_string "1.2") repo0 else repo0 in let repo0 = OpamFile.Repo.with_redirect (List.filter (fun r -> r <> redir) (OpamFile.Repo.redirect repo0)) repo0 in let repo_12 = OpamFile.Repo.with_redirect (redir :: OpamFile.Repo.redirect repo0) repo0 in let repo_20 = let redir = (OpamUrl.to_string base_url, Some (FOp (opam_version_fid, `Lt, FString (upgradeto_version_string ^ "~")))) in repo0 |> OpamFile.Repo.with_opam_version (OpamVersion.current_nopatch) |> OpamFile.Repo.with_redirect (redir :: OpamFile.Repo.redirect repo0) in OpamFile.Repo.write repo_file repo_12; OpamFile.Repo.write (OpamFile.make OpamFilename.Op.(tmp_mirror_dir // "repo")) repo_20; let dir20 = OpamFilename.Dir.of_string upgradeto_version_string in OpamFilename.rmdir dir20; OpamFilename.move_dir ~src:tmp_mirror_dir ~dst:dir20; OpamConsole.note "Indexes need updating: you should now run\n\ \n%s\ \ cd %s && opam admin index" (if repo_12 <> repo0 && OpamFilename.exists (OpamFilename.of_string "urls.txt") then " opam admin index --full-urls-txt\n" else "") (OpamFilename.remove_prefix_dir repo_root dir20) opam-2.0.5/src/client/opamAuxCommands.ml0000644000175000017500000005067213511367404017163 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes let log fmt = OpamConsole.log "AUXCMD" fmt let slog = OpamConsole.slog let package_file_changes st packages = OpamPackage.Set.fold (fun nv acc -> let f = OpamPath.Switch.changes st.switch_global.root st.switch nv.name in match OpamFile.Changes.read_opt f with | None -> acc | Some ch -> OpamStd.String.Map.union (fun _ x -> x) acc ch) packages OpamStd.String.Map.empty let copy_files_to_destdir st pfx packages = let switch_pfx = OpamPath.Switch.root st.switch_global.root st.switch in package_file_changes st packages |> OpamDirTrack.check switch_pfx |> List.iter @@ function | src, `Unchanged -> let relf = OpamFilename.remove_prefix switch_pfx src in let dst = OpamFilename.Op.(pfx // relf) in if OpamConsole.verbose () then OpamConsole.msg "%-40s %s %s\n" relf (OpamConsole.colorise `blue "=>") (OpamFilename.to_string dst); if not OpamStateConfig.(!r.dryrun) then if OpamFilename.exists src then OpamFilename.copy ~src ~dst else let as_dir f = OpamFilename.(Dir.of_string (to_string f)) in if OpamFilename.exists_dir (as_dir src) then OpamFilename.mkdir (as_dir dst) | src, (`Changed | `Removed as ch) -> OpamConsole.warning "Not installing %s, which was %s since" (OpamConsole.colorise `bold (OpamFilename.to_string src)) (match ch with `Changed -> "changed" | `Removed -> "removed") let remove_files_from_destdir st pfx packages = package_file_changes st packages |> OpamStd.String.Map.bindings |> List.rev |> (* Get the longer names first, their parent folders last *) List.iter @@ fun (rel_file, change) -> match change with | OpamDirTrack.Added _ | OpamDirTrack.Contents_changed _ | OpamDirTrack.Kind_changed _ -> let f = OpamFilename.Op.(pfx // rel_file) in let d = OpamFilename.Op.(pfx / rel_file) in if OpamFilename.exists f then (if OpamConsole.verbose () then OpamConsole.msg "Removing %s\n" (OpamConsole.colorise `bold (OpamFilename.to_string f)); if not OpamStateConfig.(!r.dryrun) then OpamFilename.remove f) else if OpamFilename.exists_dir d then if OpamFilename.dir_is_empty d then (if OpamConsole.verbose () then OpamConsole.msg "Removing %s\n" (OpamConsole.colorise `bold (OpamFilename.Dir.to_string d)); if not OpamStateConfig.(!r.dryrun) then OpamFilename.rmdir d) else OpamConsole.note "Not removing non-empty directory %s" (OpamConsole.colorise `bold (OpamFilename.Dir.to_string d)) | _ -> () let name_from_project_dirname d = try Some (OpamFilename.(Base.to_string (basename_dir d)) |> Re.(replace_string (compile (seq [char '.'; any]))) ~by:"" |> OpamPackage.Name.of_string) with Failure _ -> None let url_with_local_branch = function | { OpamUrl.backend = #OpamUrl.version_control; hash = None; _ } as url -> (match OpamProcess.Job.run (OpamRepository.current_branch url) with | Some b -> { url with OpamUrl.hash = Some b } | None -> url) | url -> url let opams_of_dir d = let files = OpamPinned.files_in_source d in List.fold_left (fun acc (n, f) -> let name = let open OpamStd.Option.Op in n >>+ fun () -> OpamFile.OPAM.(name_opt (safe_read f)) >>+ fun () -> match files with | [] | _::_::_ -> None | [_] -> name_from_project_dirname d in match name with | Some n -> (n, f) :: acc | None -> OpamConsole.warning "Ignoring file at %s: could not infer package name" (OpamFile.to_string f); acc) [] files let name_and_dir_of_opam_file f = let srcdir = OpamFilename.dirname f in let srcdir = if OpamFilename.dir_ends_with ".opam" srcdir && OpamUrl.guess_version_control (OpamFilename.Dir.to_string srcdir) = None then OpamFilename.dirname_dir srcdir else srcdir in let name = let open OpamStd.Option.Op in OpamPinned.name_of_opam_filename srcdir f >>+ fun () -> OpamFile.OPAM.(name_opt (safe_read (OpamFile.make f))) >>+ fun () -> name_from_project_dirname srcdir in name, srcdir let resolve_locals_pinned st atom_or_local_list = let pinned_packages_of_dir st dir = OpamPackage.Set.filter (fun nv -> OpamStd.Option.Op.(OpamSwitchState.primary_url st nv >>= OpamUrl.local_dir) = Some dir) st.pinned in let atoms = List.fold_left (fun acc -> function | `Atom a -> a::acc | `Dirname d -> let pkgs = pinned_packages_of_dir st d in if OpamPackage.Set.is_empty pkgs then OpamConsole.warning "No pinned packages found at %s" (OpamFilename.Dir.to_string d); List.rev_append (OpamSolution.eq_atoms_of_packages pkgs) acc | `Filename f -> OpamConsole.error_and_exit `Bad_arguments "This command doesn't support specifying a file name (%S)" (OpamFilename.to_string f)) [] atom_or_local_list in List.rev atoms let resolve_locals ?(quiet=false) atom_or_local_list = let target_dir dir = let d = OpamFilename.Dir.to_string dir in let backend = OpamUrl.guess_version_control d in OpamUrl.parse ?backend d |> url_with_local_branch in let to_pin, atoms = List.fold_left (fun (to_pin, atoms) -> function | `Atom a -> to_pin, a :: atoms | `Dirname d -> let names_files = opams_of_dir d in if names_files = [] && not quiet then OpamConsole.warning "No package definitions found at %s" (OpamFilename.Dir.to_string d); let target = target_dir d in let to_pin = List.map (fun (n,f) -> n, target, f) names_files @ to_pin in let atoms = List.map (fun (n,_) -> n, None) names_files @ atoms in to_pin, atoms | `Filename f -> match name_and_dir_of_opam_file f with | Some n, srcdir -> (n, target_dir srcdir, OpamFile.make f) :: to_pin, (n, None) :: atoms | None, _ -> OpamConsole.error_and_exit `Not_found "Could not infer package name from package definition file %s" (OpamFilename.to_string f)) ([], []) atom_or_local_list in let duplicates = List.filter (fun (n, _, f) -> List.exists (fun (n1, _, f1) -> n = n1 && f <> f1) to_pin) to_pin in match duplicates with | [] -> List.rev to_pin, List.rev atoms | _ -> OpamConsole.error_and_exit `Bad_arguments "Multiple files for the same package name were specified:\n%s" (OpamStd.Format.itemize (fun (n, t, f) -> Printf.sprintf "Package %s with definition %s %s %s" (OpamConsole.colorise `bold @@ OpamPackage.Name.to_string n) (OpamFile.to_string f) (OpamConsole.colorise `blue "=>") (OpamUrl.to_string t)) duplicates) let autopin_aux st ?quiet ?(for_view=false) atom_or_local_list = let to_pin, atoms = resolve_locals ?quiet atom_or_local_list in if to_pin = [] then atoms, to_pin, OpamPackage.Set.empty, OpamPackage.Set.empty else let pinning_dirs = OpamStd.List.filter_map (function | `Dirname d -> Some d | _ -> None) atom_or_local_list in log "autopin: %a" (slog @@ OpamStd.List.to_string (fun (name, target, _) -> Printf.sprintf "%s => %s" (OpamPackage.Name.to_string name) (OpamUrl.to_string target))) to_pin; let obsolete_pins = (* Packages not current but pinned to the same dirs *) OpamPackage.Set.filter (fun nv -> not (List.exists (fun (n,_,_) -> n = nv.name) to_pin) && match OpamStd.Option.Op.(OpamSwitchState.primary_url st nv >>= OpamUrl.local_dir) with | Some d -> List.mem d pinning_dirs | None -> false) st.pinned in let already_pinned, to_pin = List.partition (fun (name, target, opam) -> try (* check of the target to avoid repin of pin to update with `opam install .` and loose edited opams *) let pinned_pkg = OpamPinned.package st name in OpamSwitchState.primary_url st pinned_pkg = Some target && (* For `opam show`, we need to check is the opam file changed to perform a simulated pin if so *) (not for_view || match OpamSwitchState.opam_opt st pinned_pkg, OpamFile.OPAM.read_opt opam with | Some opam0, Some opam -> OpamFile.OPAM.equal opam0 opam | _, _ -> false) with Not_found -> false) to_pin in let already_pinned_set = List.fold_left (fun acc (name, _, _) -> OpamPackage.Set.add (OpamPinned.package st name) acc) OpamPackage.Set.empty already_pinned in atoms, to_pin, obsolete_pins, already_pinned_set let simulate_local_pinnings ?quiet ?(for_view=false) st to_pin = assert (not (for_view && OpamSystem.get_lock_flag st.switch_lock = `Lock_write)); let local_names = List.fold_left (fun set (name, _, _) -> OpamPackage.Name.Set.add name set) OpamPackage.Name.Set.empty to_pin in let local_opams = List.fold_left (fun map (name, target, file) -> match OpamPinCommand.read_opam_file_for_pinning ?quiet name file target with | None -> map | Some opam -> let opam = OpamFile.OPAM.with_name name opam in let opam = if for_view then opam else OpamFile.OPAM.with_url (OpamFile.URL.create target) opam in let opam, version = match OpamFile.OPAM.version_opt opam with | Some v -> opam, v | None -> let v = OpamPinCommand.default_version st name in OpamFile.OPAM.with_version v opam, v in OpamPackage.Map.add (OpamPackage.create name version) opam map) OpamPackage.Map.empty to_pin in let local_packages = OpamPackage.keys local_opams in let pinned = if for_view then (* For `opam show`, to display local files instead of the stored on, we need to have on the pinned set only the new simulated pinned ones instead of really pinned ones. *) let open OpamPackage.Set.Op in st.pinned -- OpamPackage.packages_of_names st.pinned (OpamPackage.names_of_packages local_packages) ++ local_packages else st.pinned in let st = { st with opams = OpamPackage.Map.union (fun _ o -> o) st.opams local_opams; packages = OpamPackage.Set.union st.packages local_packages; available_packages = lazy ( OpamPackage.Set.union (OpamPackage.Set.filter (fun nv -> not (OpamPackage.Name.Set.mem nv.name local_names)) (Lazy.force st.available_packages)) (OpamSwitchState.compute_available_packages st.switch_global st.switch st.switch_config ~pinned:st.pinned ~opams:local_opams) ); pinned; } in st, local_packages let simulate_autopin st ?quiet ?(for_view=false) atom_or_local_list = let atoms, to_pin, obsolete_pins, already_pinned_set = autopin_aux st ?quiet ~for_view atom_or_local_list in if to_pin = [] then st, atoms else let st = OpamPackage.Set.fold (fun nv st -> OpamPinCommand.unpin_one st nv) obsolete_pins st in let st, pins = simulate_local_pinnings ?quiet ~for_view st to_pin in if not for_view then (let pins = OpamPackage.Set.union pins already_pinned_set in let pin_depends = OpamPackage.Set.fold (fun nv acc -> List.fold_left (fun acc (nv,target) -> OpamPackage.Map.add nv target acc) acc (OpamFile.OPAM.pin_depends (OpamSwitchState.opam st nv))) pins OpamPackage.Map.empty in if not (OpamPackage.Map.is_empty pin_depends) then (OpamConsole.msg "Would pin the following:\n%s" (OpamStd.Format.itemize (fun (nv, url) -> Printf.sprintf "%s to %s" (OpamConsole.colorise `bold (OpamPackage.to_string nv)) (OpamConsole.colorise `underline (OpamUrl.to_string url))) (OpamPackage.Map.bindings pin_depends)); OpamConsole.note "The following may not reflect the above pinnings (their \ package definitions are not available at this stage)"; OpamConsole.msg "\n")); st, atoms let autopin st ?(simulate=false) ?quiet atom_or_local_list = if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) then simulate_autopin st ?quiet atom_or_local_list else let atoms, to_pin, obsolete_pins, already_pinned_set = autopin_aux st ?quiet atom_or_local_list in if to_pin = [] && OpamPackage.Set.is_empty obsolete_pins && OpamPackage.Set.is_empty already_pinned_set then st, atoms else let st = if simulate then OpamPackage.Set.fold (fun nv st -> OpamPinCommand.unpin_one st nv) obsolete_pins st else OpamPinCommand.unpin st (OpamPackage.Name.Set.elements (OpamPackage.names_of_packages obsolete_pins)) in let st = let working_dir = if OpamClientConfig.(!r.working_dir) then already_pinned_set else OpamPackage.Set.empty in let _result, st, _updated = OpamUpdate.dev_packages st ~working_dir already_pinned_set in st in let st, pins = if simulate then simulate_local_pinnings ?quiet st to_pin else try List.fold_left (fun (st, pins) (name, target, file) -> match OpamPinCommand.read_opam_file_for_pinning ?quiet name file target with | None -> st, pins | Some opam -> let st = try OpamPinCommand.source_pin st name ~quiet:true ~opam (Some target) with OpamPinCommand.Nothing_to_do -> st in st, OpamPackage.Set.add (OpamPinned.package st name) pins) (st, OpamPackage.Set.empty) to_pin with OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted in let st = if OpamClientConfig.(!r.ignore_pin_depends) then st else OpamPackage.Set.fold (fun nv st -> OpamPinCommand.handle_pin_depends st nv (OpamSwitchState.opam st nv)) (OpamPackage.Set.union pins already_pinned_set) st in st, atoms let get_compatible_compiler ?repos rt dir = let gt = rt.repos_global in let virt_st = OpamSwitchState.load_virtual ?repos_list:repos gt rt in let local_files = opams_of_dir dir in let local_opams = List.fold_left (fun acc (name, f) -> let opam = OpamFile.OPAM.safe_read f in let opam = OpamFormatUpgrade.opam_file ~filename:f opam in let nv, opam = match OpamFile.OPAM.version_opt opam with | Some v -> OpamPackage.create name v, opam | None -> let v = OpamPinCommand.default_version virt_st name in OpamPackage.create name v, OpamFile.OPAM.with_version v opam in OpamPackage.Map.add nv opam acc) OpamPackage.Map.empty local_files in let local_packages = OpamPackage.keys local_opams in let pin_depends = OpamPackage.Map.fold (fun _nv opam acc -> List.fold_left (fun acc (nv,_) -> OpamPackage.Set.add nv acc) acc (OpamFile.OPAM.pin_depends opam)) local_opams OpamPackage.Set.empty in let virt_st = let opams = OpamPackage.Map.union (fun _ x -> x) virt_st.opams local_opams in let available = lazy ( OpamPackage.Map.filter (fun package opam -> OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_switch_raw ~package gt (OpamSwitch.of_dirname dir) OpamFile.Switch_config.empty) (OpamFile.OPAM.available opam)) opams |> OpamPackage.keys ) in let open OpamPackage.Set.Op in { virt_st with opams = OpamPackage.Set.fold (fun nv acc -> OpamPackage.Map.add nv (OpamFile.OPAM.create nv) acc) pin_depends opams; packages = virt_st.packages ++ local_packages ++ pin_depends; available_packages = lazy (Lazy.force available ++ local_packages ++ pin_depends); } in let univ = OpamSwitchState.universe virt_st ~requested:(OpamPackage.names_of_packages local_packages) Query in (* Find if there is a single possible dependency having Pkgflag_Compiler *) let alldeps = OpamSolver.dependencies ~depopts:false ~build:true ~post:true ~installed:false univ local_packages in let compilers = OpamPackage.Set.filter (fun nv -> OpamFile.OPAM.has_flag Pkgflag_Compiler (OpamSwitchState.opam virt_st nv)) (OpamPackage.Set.of_list alldeps) in let installable = OpamSolver.installable_subset {univ with u_base = local_packages; u_installed = local_packages} (OpamPackage.Set.union local_packages compilers) in if not (OpamPackage.Set.is_empty local_packages) && OpamPackage.Set.is_empty installable then (OpamConsole.error "The following local packages don't appear to be installable:\n%s" (OpamStd.Format.itemize OpamPackage.to_string (OpamPackage.Set.elements local_packages)); if OpamConsole.confirm "Do you want to create an empty switch regardless?" then [], false else OpamStd.Sys.exit_because `Aborted) else let compilers = OpamPackage.Set.inter compilers installable in try [OpamSolution.eq_atom_of_package (OpamPackage.Set.choose_one compilers)], true with | Not_found when not (OpamPackage.Set.is_empty local_packages) -> OpamConsole.warning "No possible installation was found including a compiler and the \ selected packages."; if OpamClientConfig.(!r.show) || OpamConsole.confirm "Create the switch with no specific compiler selected, and attempt to \ continue?" then [], false else OpamStd.Sys.exit_because `Aborted | Failure _ | Not_found -> (* Find a matching compiler from the default selection *) let default_compiler = OpamFile.Config.default_compiler gt.config in if default_compiler = Empty then (OpamConsole.warning "No compiler selected"; [], false) else let candidates = OpamFormula.to_dnf default_compiler in try OpamStd.List.find_map (fun atoms -> let has_all compiler_packages = List.for_all (fun at -> OpamPackage.Set.exists (OpamFormula.check at) compiler_packages) atoms in let compiler = OpamFormula.packages_of_atoms (Lazy.force virt_st.available_packages) atoms in if not (has_all compiler) then None else if OpamPackage.Set.is_empty local_packages then Some (OpamSolution.eq_atoms_of_packages compiler) else (* fake universe with `local_packages` as base, just to check coinstallability *) let univ = { univ with u_base = local_packages; u_installed = local_packages } in let compiler = OpamSolver.installable_subset univ compiler in if has_all compiler then Some (OpamSolution.eq_atoms_of_packages compiler) else None ) candidates, false with Not_found -> OpamConsole.warning "The default compiler selection: %s\n\ is not compatible with the local packages found at %s, and the \ packages don't specify an unambiguous compiler.\n\ You can use `--compiler` to manually select one." (OpamFormula.to_string default_compiler) (OpamFilename.Dir.to_string dir); if OpamConsole.confirm "You may also proceed, with no specific compiler selected. \ Do you want to?" then [], false else OpamStd.Sys.exit_because `Aborted opam-2.0.5/src/client/opamPinCommand.mli0000644000175000017500000000604113511367404017131 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Functions handling the "opam pin" subcommand *) open OpamTypes open OpamStateTypes (** Pins a package to the given version, and writes to disk. Returns the updated state. The main difference with [source_pin] is that a definition overlay is not created. Therefore, the package must exist already. *) val version_pin: rw switch_state -> name -> version -> rw switch_state exception Aborted exception Nothing_to_do (** Sets the package as pinned to the given target. A package definition is looked for in the package source and current metadata (in this order), unless specified using [~opam]. If [edit], or if no package definition is found, this opens an editor (with a template if no definition is available). If [force], don't abort even if the source can't be fetched from [target] May raise [Aborted] or [Nothing_to_do]. *) val source_pin: rw switch_state -> name -> ?version:version -> ?edit:bool -> ?opam:OpamFile.OPAM.t -> ?quiet:bool -> ?force:bool -> ?ignore_extra_pins:bool -> url option -> rw switch_state (** Interactively handles the [pin-depends] in an opam file *) val handle_pin_depends: rw switch_state -> package -> OpamFile.OPAM.t -> rw switch_state (** Let the user edit a pinned package's opam file. If given, the version is put into the template in advance. Writes and returns the updated switch state. *) val edit: rw switch_state -> ?version:version -> name -> rw switch_state (** Unpin packages *) val unpin: rw switch_state -> name list -> rw switch_state (** Pure function that reverts a single package pinning *) val unpin_one: 'a switch_state -> package -> 'a switch_state (** List the pinned packages to the user. *) val list: 'a switch_state -> short:bool -> unit (** Lints the given opam file, prints warnings or errors accordingly (unless [quiet]), upgrades it to current format, adds references to files below the 'files/' subdir (unless the file is directly below the specified, local [url]), and returns it *) val read_opam_file_for_pinning: ?quiet:bool -> name -> OpamFile.OPAM.t OpamFile.t -> url -> OpamFile.OPAM.t option (** The default version for pinning a package: depends on the state, what is installed and available, and defaults to [~dev]. *) val default_version: 'a switch_state -> name -> version opam-2.0.5/src/client/opamSwitchCommand.mli0000644000175000017500000000620013511367404017641 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Functions handling the "opam switch" subcommand *) open OpamTypes open OpamStateTypes (** Install a new switch, with the given packages set as compiler. The given [global_state] is unlocked as soon as possible, i.e. after registering the existence of the new switch. [update_config] sets the switch as current globally, unless it is external *) val install: rw global_state -> ?rt:'a repos_state -> ?synopsis:string -> ?repos:repository_name list -> update_config:bool -> packages:atom conjunction -> ?local_compiler:bool -> switch -> unlocked global_state * rw switch_state (** Install a compiler's base packages *) val install_compiler_packages: rw switch_state -> atom conjunction -> rw switch_state (** Import a file which contains the packages to install. *) val import: rw switch_state -> OpamFile.SwitchExport.t OpamFile.t option -> rw switch_state (** Export a file which contains the installed packages. If full is specified and true, export metadata of all installed packages (excluding overlay files) as part of the export. [None] means export to stdout. *) val export: ?full:bool -> OpamFile.SwitchExport.t OpamFile.t option -> unit (** Remove the given compiler switch, and returns the updated state (unchanged in case [confirm] is [true] and the user didn't confirm) *) val remove: rw global_state -> ?confirm:bool -> switch -> rw global_state (** Changes the currently active switch *) val switch: 'a lock -> rw global_state -> switch -> 'a switch_state (** Reinstall the given compiler switch. *) val reinstall: rw switch_state -> rw switch_state (** Sets the packages configured as the current switch compiler base *) val set_compiler: rw switch_state -> (name * version option) list -> rw switch_state (** Display the current compiler switch. *) val show: unit -> unit (** List all the available compiler switches. *) val list: 'a global_state -> print_short:bool -> unit (** Returns all available compiler packages from a repo state *) val get_compiler_packages: ?repos:repository_name list -> 'a repos_state -> package_set (** Guess the compiler from the switch name: within compiler packages, match [name] against "pkg.version", "pkg", and, as a last resort, "version" (for compat with older opams, eg. 'opam switch 4.02.3') *) val guess_compiler_package: ?repos:repository_name list -> 'a repos_state -> string -> atom list opam-2.0.5/src/client/opamManifest.inc.in0000644000175000017500000000016313511367404017246 0ustar nicoonicoo(rule (targets opamManifest.ml) (deps @CONF_MANIFEST_O@) (action (with-stdout-to %{targets} (echo "")))) opam-2.0.5/src/client/opamPinCommand.ml0000644000175000017500000005643213511367404016771 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamStd.Op let log fmt = OpamConsole.log "COMMAND" fmt let slog = OpamConsole.slog let string_of_pinned opam = let bold = OpamConsole.colorise `bold in Printf.sprintf "pinned %s (version %s)" (OpamStd.Option.to_string ~none:(bold "locally") (fun u -> "to " ^ (bold (OpamUrl.to_string (OpamFile.URL.url u)))) (OpamFile.OPAM.url opam)) (bold (OpamPackage.Version.to_string (OpamFile.OPAM.version opam))) let read_opam_file_for_pinning ?(quiet=false) name f url = let opam0 = let dir = OpamFilename.dirname (OpamFile.filename f) in (* don't add aux files for [project/opam] *) let add_files = OpamUrl.local_dir url = Some dir in OpamStd.Option.map (OpamFormatUpgrade.opam_file_with_aux ~quiet ~dir ~files:add_files ~filename:f) (OpamFile.OPAM.read_opt f) in (match opam0 with | None -> let warns, _ = OpamFileTools.lint_file f in OpamConsole.error "Invalid opam file in %s source from %s:" (OpamPackage.Name.to_string name) (OpamUrl.to_string url); OpamConsole.errmsg "%s\n" (OpamFileTools.warns_to_string warns) | Some opam -> let warns = OpamFileTools.lint opam in if not quiet && warns <> [] then (OpamConsole.warning "Failed checks on %s package definition from source at %s:" (OpamPackage.Name.to_string name) (OpamUrl.to_string url); OpamConsole.errmsg "%s\n" (OpamFileTools.warns_to_string warns))); opam0 exception Fetch_Fail of string let get_source_definition ?version st nv url = let root = st.switch_global.root in let srcdir = OpamPath.Switch.pinned_package root st.switch nv.name in let fix opam = OpamFile.OPAM.with_url url @@ (match version with | Some v -> OpamFile.OPAM.with_version v | None -> fun o -> o) @@ opam in let open OpamProcess.Job.Op in OpamUpdate.fetch_dev_package url srcdir nv @@| function | Not_available (_,s) -> raise (Fetch_Fail s) | Up_to_date _ | Result _ -> match OpamPinned.find_opam_file_in_source nv.name srcdir with | None -> None | Some f -> match read_opam_file_for_pinning nv.name f (OpamFile.URL.url url) with | None -> let dst = OpamFile.filename (OpamPath.Switch.Overlay.tmp_opam root st.switch nv.name) in OpamFilename.copy ~src:(OpamFile.filename f) ~dst; None | Some opam -> Some (fix opam) let copy_files st opam = let name = OpamFile.OPAM.name opam in let files = OpamFile.OPAM.get_extra_files opam in if files = [] then (match OpamFile.OPAM.extra_files opam with | Some [] | None -> () | Some files -> OpamConsole.warning "Ignoring overlay files of %s (files/*) that were not found: %s" (OpamPackage.Name.to_string name) (OpamStd.List.to_string (fun (b,_) -> OpamFilename.Base.to_string b) files)); let destdir = OpamPath.Switch.Overlay.files st.switch_global.root st.switch name in let files = List.fold_left (fun acc (src, rel_file, hash) -> if not (OpamFilename.exists src) then (OpamConsole.warning "Overlay file of %s %s not found, ignoring" (OpamPackage.Name.to_string name) (OpamFilename.to_string src); acc) else let hash = if not (OpamHash.check_file (OpamFilename.to_string src) hash) then if OpamFormatConfig.(!r.strict) then OpamConsole.error_and_exit `File_error "Hash mismatch on %s %s (strict mode)" (OpamPackage.Name.to_string name) (OpamFilename.to_string src) else (OpamConsole.warning "Hash doesn't match for overlay file of %s %s, adjusted" (OpamPackage.Name.to_string name) (OpamFilename.to_string src); OpamHash.compute (OpamFilename.to_string src)) else hash in OpamFilename.copy ~src ~dst:(OpamFilename.create destdir rel_file); (rel_file, hash) :: acc) [] files in OpamFile.OPAM.with_extra_files (List.rev files) opam (* Returns the new opam file, without writing it to disk *) let edit_raw name temp_file = let rec edit () = if OpamStd.Sys.tty_in then (OpamConsole.msg "Press enter to start \"%s\" (this can be customised by \ setting EDITOR or OPAMEDITOR)... " OpamClientConfig.(!r.editor); ignore (read_line ())); let edited_ok = try Sys.command (Printf.sprintf "%s %s" (OpamClientConfig.(!r.editor)) (OpamFile.to_string temp_file)) = 0 && match OpamFilename.read (OpamFile.filename temp_file) with "" | "\n" -> false | _ -> true with _ -> false in if not edited_ok then (OpamFilename.remove (OpamFile.filename temp_file); OpamConsole.error "Empty file or editor error, aborting."; None) else try let warnings, opam_opt = OpamFileTools.lint_file temp_file in let opam = match opam_opt with | None -> OpamConsole.msg "Invalid opam file:\n%s\n" (OpamFileTools.warns_to_string warnings); failwith "Syntax errors" | Some opam -> opam in let namecheck = match OpamFile.OPAM.name_opt opam with | Some n when n <> name -> OpamConsole.error "Bad \"name: %S\" field, package name is %s" (OpamPackage.Name.to_string n) (OpamPackage.Name.to_string name); false | _ -> true in let versioncheck = match OpamFile.OPAM.version_opt opam with | None -> OpamConsole.error "Missing \"version\" field."; false | Some _ -> true in if not namecheck || not versioncheck then failwith "Bad name/version"; match warnings with | [] -> Some opam | ws -> OpamConsole.warning "The opam file didn't pass validation:"; OpamConsole.errmsg "%s\n" (OpamFileTools.warns_to_string ws); if OpamConsole.confirm "Proceed anyway ('no' will re-edit)?" then Some opam else edit () with e -> OpamStd.Exn.fatal e; (match e with | Failure _ -> () | e -> OpamConsole.error "%s" (Printexc.to_string e)); if OpamStd.Sys.tty_in && OpamConsole.confirm "Errors in %s, edit again?" (OpamFile.to_string temp_file) then edit () else None in match edit () with | None -> None | Some new_opam -> OpamConsole.msg "You can edit this file again with \"opam pin edit %s\", export it with \ \"opam show %s --raw\"\n" (OpamPackage.Name.to_string name) (OpamPackage.Name.to_string name); Some new_opam let edit st ?version name = log "pin-edit %a" (slog OpamPackage.Name.to_string) name; let nv = try OpamPinned.package st name with Not_found -> OpamConsole.error_and_exit `Bad_arguments "%s is not pinned" (OpamPackage.Name.to_string name) in let new_nv = match version with | None -> nv | Some v -> OpamPackage.create name v in let path f = f st.switch_global.root st.switch name in let overlay_file = path OpamPath.Switch.Overlay.opam in let temp_file = path OpamPath.Switch.Overlay.tmp_opam in let current_opam = OpamSwitchState.opam_opt st nv in if not (OpamFile.exists temp_file) then (let base_opam = match current_opam with | None -> OpamFileTools.template new_nv | Some o -> OpamFile.OPAM.with_version new_nv.version o in OpamFile.OPAM.write_with_preserved_format ?format_from:(OpamPinned.orig_opam_file name base_opam) temp_file base_opam); match edit_raw name temp_file with | None -> st | Some opam -> let opam = match current_opam with | Some cur -> OpamFile.OPAM.(with_metadata_dir (metadata_dir cur)) opam | None -> opam in let opam = copy_files st opam in match current_opam with | Some o when OpamFile.OPAM.equal opam o -> (OpamConsole.msg "Package metadata unchanged.\n"; st) | _ -> (* Remove obsolete auxiliary files, in case *) OpamFilename.remove (OpamFile.filename (path OpamPath.Switch.Overlay.url)); OpamFilename.remove (OpamFile.filename (path OpamPath.Switch.Overlay.descr)); let opam_extra = OpamStd.Option.default [] @@ OpamFile.OPAM.extra_files opam in List.iter (fun f -> let base = OpamFilename.Base.of_string @@ OpamFilename.remove_prefix (path OpamPath.Switch.Overlay.files) f in if not (List.mem_assoc base opam_extra) then (OpamConsole.note "Removing obsolete overlay file %s" (OpamFilename.to_string f); OpamFilename.remove f)) (OpamFilename.rec_files (path OpamPath.Switch.Overlay.files)); (* Write to overlay *) OpamFile.OPAM.write_with_preserved_format ~format_from:temp_file overlay_file opam; OpamFilename.remove (OpamFile.filename temp_file); (* Save back to source *) ignore OpamStd.Option.Op.( OpamFile.OPAM.get_url opam >>= OpamUrl.local_dir >>| fun dir -> let src_opam = OpamStd.Option.default (OpamFile.make OpamFilename.Op.(dir // "opam")) (OpamPinned.find_opam_file_in_source name dir) in let clean_opam = OpamFile.OPAM.with_url_opt None @* OpamFile.OPAM.with_extra_files [] in if (current_opam >>| fun o -> OpamFile.OPAM.equal (clean_opam opam) (clean_opam o)) <> Some true && OpamConsole.confirm "Save the new opam file back to %S?" (OpamFile.to_string src_opam) then OpamFile.OPAM.write_with_preserved_format src_opam (clean_opam opam) ); let nv = OpamPackage.create name (OpamFile.OPAM.version opam) in let st = OpamSwitchState.update_pin nv opam st in OpamUpdate.cleanup_source st current_opam opam; OpamSwitchAction.write_selections st; st let version_pin st name version = let root = st.switch_global.root in let nv = OpamPackage.create name version in let repo_opam = try OpamPackage.Map.find nv st.repos_package_index with Not_found -> OpamConsole.error_and_exit `Not_found "Package %s has no known version %s in the repositories" (OpamPackage.Name.to_string name) (OpamPackage.Version.to_string version) in begin match OpamPinned.package_opt st name with | Some pinned_nv -> let opam = OpamSwitchState.opam st pinned_nv in if Some opam = OpamPackage.Map.find_opt pinned_nv st.repos_package_index then (* already version-pinned *) (if pinned_nv <> nv then (OpamConsole.note "Package %s used to be pinned to version %s" (OpamPackage.Name.to_string name) (OpamPackage.Version.to_string pinned_nv.version); OpamFilename.rmdir (OpamPath.Switch.Overlay.package root st.switch name)) else OpamConsole.note "Pinning unchanged") else if OpamConsole.confirm "Package %s is already %s. Unpin and continue?" (OpamPackage.Name.to_string name) (string_of_pinned opam) then OpamFilename.rmdir (OpamPath.Switch.Overlay.package root st.switch name) else (OpamConsole.msg "Aborting.\n"; OpamStd.Sys.exit_because `Aborted) | None -> () end; let st = OpamSwitchState.update_pin nv repo_opam st in OpamSwitchAction.write_selections st; OpamConsole.msg "%s is now pinned to version %s\n" (OpamPackage.Name.to_string name) (OpamPackage.Version.to_string version); st exception Aborted exception Nothing_to_do let default_version st name = try OpamPackage.version (OpamSwitchState.get_package st name) with Not_found -> OpamPackage.Version.of_string "~dev" let rec handle_pin_depends st nv opam = let extra_pins = OpamFile.OPAM.pin_depends opam in let extra_pins = List.filter (fun (nv, url) -> not (OpamPackage.Set.mem nv st.pinned && OpamSwitchState.primary_url st nv = Some url)) extra_pins in if extra_pins = [] then st else (OpamConsole.msg "The following additional pinnings are required by %s:\n%s" (OpamPackage.to_string nv) (OpamStd.Format.itemize (fun (nv, url) -> Printf.sprintf "%s at %s" (OpamConsole.colorise `bold (OpamPackage.to_string nv)) (OpamConsole.colorise `underline (OpamUrl.to_string url))) extra_pins); if not (OpamConsole.confirm "Continue?") then (OpamConsole.msg "You can specify --ignore-pin-depends to bypass\n"; OpamStd.Sys.exit_because `Aborted); List.fold_left (fun st (nv, url) -> source_pin st nv.name ~version:nv.version (Some url) ~ignore_extra_pins:true) st extra_pins) and source_pin st name ?version ?edit:(need_edit=false) ?opam:opam_opt ?(quiet=false) ?(force=false) ?(ignore_extra_pins=OpamClientConfig.(!r.ignore_pin_depends)) target_url = log "pin %a to %a %a" (slog OpamPackage.Name.to_string) name (slog (OpamStd.Option.to_string OpamPackage.Version.to_string)) version (slog (OpamStd.Option.to_string ~none:"none" OpamUrl.to_string)) target_url; let cur_version, cur_urlf = try let cur_version = OpamPinned.version st name in let nv = OpamPackage.create name cur_version in let cur_opam = OpamSwitchState.opam st nv in let cur_urlf = OpamFile.OPAM.url cur_opam in let no_changes = target_url = OpamStd.Option.map OpamFile.URL.url cur_urlf && (version = Some cur_version || version = None) in if not (quiet && no_changes) then OpamConsole.note "Package %s is %s %s." (OpamPackage.Name.to_string name) (if no_changes then "already" else "currently") (string_of_pinned cur_opam); if no_changes then () else (* if OpamConsole.confirm "Proceed and change pinning target?" then *) OpamFilename.remove (OpamFile.filename (OpamPath.Switch.Overlay.tmp_opam st.switch_global.root st.switch name)) (* else raise Exns.Aborted *); cur_version, cur_urlf with Not_found -> if OpamPackage.has_name st.compiler_packages name then ( OpamConsole.warning "Package %s is part of the base packages of this compiler." (OpamPackage.Name.to_string name); if not @@ OpamConsole.confirm "Are you sure you want to override this and pin it anyway?" then raise Aborted ); let version = default_version st name in version, None in if not (OpamPackage.has_name st.packages name) && opam_opt = None && not (OpamConsole.confirm "Package %s does not exist, create as a %s package?" (OpamPackage.Name.to_string name) (OpamConsole.colorise `bold "NEW")) then raise Aborted; (match OpamStd.Option.map OpamFile.URL.url cur_urlf, target_url with | Some u, Some target when OpamUrl.( u.transport <> target.transport || u.path <> target.path || u.backend <> target.backend ) -> OpamFilename.rmdir (OpamPath.Switch.pinned_package st.switch_global.root st.switch name) | _ -> ()); let pin_version = OpamStd.Option.Op.(version +! cur_version) in let nv = OpamPackage.create name pin_version in let urlf = OpamStd.Option.Op.(target_url >>| OpamFile.URL.create) in let temp_file = OpamPath.Switch.Overlay.tmp_opam st.switch_global.root st.switch name in let opam_local = OpamFile.OPAM.read_opt temp_file |> OpamStd.Option.map (OpamFormatUpgrade.opam_file) in OpamFilename.remove (OpamFile.filename temp_file); let opam_opt = try OpamStd.Option.Op.( opam_opt >>+ fun () -> urlf >>= fun url -> OpamProcess.Job.run @@ get_source_definition ?version st nv url ) with Fetch_Fail err -> if force then None else (OpamConsole.error_and_exit `Sync_error "Error getting source from %s:\n%s" (OpamStd.Option.to_string OpamUrl.to_string target_url) (OpamStd.Format.itemize (fun x -> x) [err])); in let nv = match version with | Some _ -> nv | None -> OpamPackage.create name OpamStd.Option.Op.( (opam_opt >>= OpamFile.OPAM.version_opt) +! cur_version) in let opam_opt = OpamStd.Option.Op.( opam_opt >>+ fun () -> OpamPackage.Map.find_opt nv st.installed_opams >>+ fun () -> OpamSwitchState.opam_opt st nv) in let opam_opt = match opam_local, opam_opt with | Some local, None -> OpamConsole.warning "Couldn't retrieve opam file from versioned source, \ using the one found locally."; Some local | Some local, Some vers when not OpamFile.(OPAM.effectively_equal (OPAM.with_url URL.empty local) (OPAM.with_url URL.empty vers)) -> OpamConsole.warning "%s's opam file has uncommitted changes, using the versioned one" (OpamPackage.Name.to_string name); opam_opt | _ -> opam_opt in if not need_edit && opam_opt = None then OpamConsole.note "No package definition found for %s: please complete the template" (OpamConsole.colorise `bold (OpamPackage.to_string nv)); let need_edit = need_edit || opam_opt = None in let opam_opt = let opam_base = match opam_opt with | None -> OpamFileTools.template nv | Some opam -> opam in let opam_base = OpamFile.OPAM.with_url_opt urlf opam_base in if need_edit then (if not (OpamFile.exists temp_file) then OpamFile.OPAM.write_with_preserved_format ?format_from:(OpamPinned.orig_opam_file name opam_base) temp_file opam_base; OpamStd.Option.Op.( edit_raw name temp_file >>| (* Preserve metadata_dir so that copy_files below works *) OpamFile.OPAM.(with_metadata_dir (metadata_dir opam_base)) )) else Some opam_base in match opam_opt with | None -> OpamConsole.error_and_exit `Not_found "No valid package definition found" | Some opam -> let opam = match OpamFile.OPAM.get_url opam with | Some _ -> opam | None -> OpamFile.OPAM.with_url_opt urlf opam in let version = OpamStd.Option.Op.(OpamFile.OPAM.version_opt opam +! nv.version) in let nv = OpamPackage.create nv.name version in let st = if ignore_extra_pins then st else handle_pin_depends st nv opam in let opam = opam |> OpamFile.OPAM.with_name name |> OpamFile.OPAM.with_version version in OpamFilename.rmdir (OpamPath.Switch.Overlay.package st.switch_global.root st.switch nv.name); let opam = copy_files st opam in OpamFile.OPAM.write_with_preserved_format ?format_from:(OpamPinned.orig_opam_file name opam) (OpamPath.Switch.Overlay.opam st.switch_global.root st.switch nv.name) opam; OpamFilename.remove (OpamFile.filename temp_file); let st = OpamSwitchState.update_pin nv opam st in OpamSwitchAction.write_selections st; OpamConsole.msg "%s is now %s\n" (OpamPackage.Name.to_string name) (string_of_pinned opam); st (* pure *) let unpin_one st nv = let st = { st with pinned = OpamPackage.Set.remove nv st.pinned } in (* Restore availability of other versions of this package from the repos *) let repo_package = OpamPackage.Map.filter (fun nv2 _ -> nv2.name = nv.name) st.repos_package_index in let available_packages = lazy ( OpamSwitchState.compute_available_packages st.switch_global st.switch st.switch_config ~pinned:OpamPackage.Set.empty ~opams:repo_package |> OpamPackage.Set.union (OpamPackage.Set.remove nv (Lazy.force st.available_packages)) ) in match OpamPackage.Map.find_opt nv st.repos_package_index, OpamPackage.Map.find_opt nv st.installed_opams with | None, None -> OpamSwitchState.remove_package_metadata nv st | Some opam, _ | None, Some opam -> (* forget about overlay *) let st = OpamSwitchState.update_package_metadata nv opam st in { st with available_packages } let unpin st names = log "unpin %a" (slog @@ OpamStd.List.concat_map " " OpamPackage.Name.to_string) names; List.fold_left (fun st name -> OpamFilename.rmdir (OpamPath.Switch.pinned_package st.switch_global.root st.switch name); OpamFilename.rmdir (OpamPath.Switch.Overlay.package st.switch_global.root st.switch name); match OpamPinned.package_opt st name with | Some nv -> let pin_str = OpamStd.Option.to_string ~none:"pinned" string_of_pinned (OpamSwitchState.opam_opt st nv) in let st = unpin_one st nv in OpamSwitchAction.write_selections st; OpamConsole.msg "Ok, %s is no longer %s\n" (OpamPackage.Name.to_string name) pin_str; st | None -> OpamConsole.note "%s is not pinned." (OpamPackage.Name.to_string name); st) st names let list st ~short = log "pin_list"; if short then OpamPackage.Set.iter (fun nv -> OpamConsole.msg "%s\n" (OpamPackage.name_to_string nv)) st.pinned else let lines nv = try let opam = OpamSwitchState.opam st nv in let url = OpamFile.OPAM.get_url opam in let kind, target = if OpamSwitchState.is_version_pinned st nv.name then "version", OpamPackage.Version.to_string nv.version else match url with | Some u -> OpamUrl.string_of_backend u.OpamUrl.backend, OpamUrl.to_string u | None -> "local definition", "" in let state, extra = try let inst = OpamSwitchState.find_installed_package_by_name st nv.name in if inst.version = nv.version then "",[] else OpamConsole.colorise `red "(not in sync)", [Printf.sprintf "(installed:%s)" (OpamConsole.colorise `bold (OpamPackage.version_to_string inst))] with Not_found -> OpamConsole.colorise `yellow "(uninstalled)", [] in [ OpamPackage.to_string nv; state; OpamConsole.colorise `blue kind; String.concat " " (target::extra) ] with Not_found -> [ OpamPackage.to_string nv; OpamConsole.colorise `red " (no definition found)" ] in let table = List.map lines (OpamPackage.Set.elements st.pinned) in OpamConsole.print_table stdout ~sep:" " (OpamStd.Format.align_table table) opam-2.0.5/src/client/opamListCommand.mli0000644000175000017500000001371513511367404017324 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Functions handling the "opam list" subcommand *) open OpamTypes open OpamStateTypes (** Switches to determine what to include when querying (reverse) dependencies *) type dependency_toggles = { recursive: bool; depopts: bool; build: bool; post: bool; test: bool; doc: bool; dev: bool; } val default_dependency_toggles: dependency_toggles type pattern_selector = { case_sensitive: bool; exact: bool; glob: bool; fields: string list; ext_fields: bool; (** Match on raw strings in [x-foo] fields *) } val default_pattern_selector: pattern_selector (** Package selectors used to filter the set of packages *) type selector = | Any | Installed | Root | Compiler | Available | Installable | Pinned | Depends_on of dependency_toggles * atom list | Required_by of dependency_toggles * atom list | Conflicts_with of package list | Coinstallable_with of dependency_toggles * package list | Solution of dependency_toggles * atom list | Pattern of pattern_selector * string | Atoms of atom list | Flag of package_flag | Tag of string | From_repository of repository_name list | Owns_file of filename (** Applies a formula of selectors to filter the package from a given switch state *) val filter: base:package_set -> 'a switch_state -> selector OpamFormula.formula -> package_set (** Or-filter on package patterns (NAME or NAME.VERSION) *) val pattern_selector: string list -> selector OpamFormula.formula (** Get the aggregated active external dependencies of the given packages *) val get_depexts: 'a switch_state -> package_set -> OpamStd.String.Set.t (** Lists the given aggregated active external dependencies of the given packages *) val print_depexts: OpamStd.String.Set.t -> unit (** Element of package information to be printed. Fixme: should be part of the run-time man! *) type output_format = | Name (** Name without version *) | Version (** Version of the currently looked-at package *) | Package (** [name.version] *) | Synopsis (** One-line package description *) | Synopsis_or_target (** Pinning target if pinned, synopsis otherwise *) | Description (** The package description, excluding synopsis *) | Field of string (** The value of the given opam-file field *) | Installed_version (** Installed version or "--" if none *) | Pinning_target (** Empty string if not pinned *) | Source_hash (** The VC-reported ident of current version, for dev packages. Empty if not available *) | Raw (** The full contents of the opam file (reformatted) *) | All_installed_versions (** List of the installed versions in all switches with the corresponding switches in brackets *) | Available_versions (** List of the available versions (currently installed one in bold if color enabled) *) | All_versions (** List of the existing package versions (installed, installed in current switch and unavailable colored specifically if color enabled) *) | Repository (** The repository the package was found in (may be empty for pinned packages) *) | Installed_files (** The list of files that the installed package added to the system *) | VC_ref (** The version-control branch or tag the package url is bound to, if any *) | Depexts (** The external dependencies *) val default_list_format: output_format list (** Gets either the current switch state, if a switch is selected, or a virtual state corresponding to the configured repos *) val get_switch_state: 'a global_state -> unlocked switch_state (** For documentation, includes a dummy ':' for the [Field] format *) val field_names: (output_format * string) list val string_of_field: output_format -> string val field_of_string: string -> output_format type package_listing_format = { short: bool; header: bool; columns: output_format list; all_versions: bool; wrap: [`Wrap of string | `Truncate | `None] option; separator: string; value_printer: [`Normal | `Pretty | `Normalised]; order: [`Standard | `Dependency | `Custom of package -> package -> int]; } val default_package_listing_format: package_listing_format (** Outputs a list of packages as a table according to the formatting options. [normalise] supersedes [prettify] and uses a canonical way of displaying package definition file fields. [prettify] uses a nicer to read format for the package definition file fields. *) val display: 'a switch_state -> package_listing_format -> package_set -> unit (** Display a general summary of a collection of packages. *) val info: 'a switch_state -> fields:string list -> raw_opam:bool -> where:bool -> ?normalise:bool -> ?show_empty:bool -> atom list -> unit (** Prints the value of an opam field in a shortened way (with [prettify] -- the default -- puts lists of strings in a format that is easier to read *) val mini_field_printer: ?prettify:bool -> ?normalise:bool -> value -> string val string_of_formula: selector OpamFormula.formula -> string opam-2.0.5/src/client/opamInitDefaults.mli0000644000175000017500000000235213511367404017500 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** This module defines a few defaults, used at 'opam init', that bind opam to its default OCaml repository at https://opam.ocaml.org. All can be overridden through the init command flags or an init config file. *) open OpamTypes (** Url of the default Opam repository *) val repository_url: url val default_compiler: formula val eval_variables: (OpamVariable.t * string list * string) list (** Default initial configuration file for use by [opam init] if nothing is supplied. *) val init_config: ?sandboxing:bool -> unit -> OpamFile.InitConfig.t opam-2.0.5/src/client/opamConfigCommand.mli0000644000175000017500000000451613511367404017615 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Functions handling the "opam config" subcommand *) open OpamTypes open OpamStateTypes (** Display the current environment. Booleans csh, sexp and fish set an alternative output (unspecified if more than one is true, sh-style by default). [inplace_path] changes how the PATH variable is updated when there is already an opam entry: either at the same rank, or pushed in front. *) val env: 'a global_state -> switch -> ?set_opamroot:bool -> ?set_opamswitch:bool -> csh:bool -> sexp:bool -> fish:bool -> inplace_path:bool -> unit (** Like [env] but allows one to specify the precise env to print rather than compute it from a switch state *) val print_eval_env: csh:bool -> sexp:bool -> fish:bool -> env -> unit (** Display the content of all available variables; global summary if the list is empty, package name "-" is understood as global configuration *) val list: 'a global_state -> name list -> unit (** Display the content of a given variable *) val variable: 'a global_state -> full_variable -> unit (** Substitute files *) val subst: 'a global_state -> basename list -> unit (** Prints expansion of variables in string *) val expand: 'a global_state -> string -> unit (** Sets or unsets switch config variables *) val set: full_variable -> string option -> unit (** Sets or unsets global config variables *) val set_global: full_variable -> string option -> unit (** Execute a command in a subshell, after variable expansion *) val exec: [< unlocked ] global_state -> ?set_opamroot:bool -> ?set_opamswitch:bool -> inplace_path:bool -> string list -> unit opam-2.0.5/src/client/Opam.Runtime.x86.manifest0000644000175000017500000000054213511367404020216 0ustar nicoonicoo opam-2.0.5/src/client/opamInitDefaults.ml0000644000175000017500000001025313511367404017326 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2016 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes let repository_url = { OpamUrl. transport = "https"; path = "opam.ocaml.org"; hash = None; backend = `http; } let default_compiler = OpamFormula.ors [ OpamFormula.Atom (OpamPackage.Name.of_string "ocaml-system", OpamFormula.Atom (`Geq, OpamPackage.Version.of_string "4.02.3")); OpamFormula.Atom (OpamPackage.Name.of_string "ocaml-base-compiler", OpamFormula.Empty); ] let eval_variables = [ OpamVariable.of_string "sys-ocaml-version", ["ocamlc"; "-vnum"], "OCaml version present on your system independently of opam, if any"; ] let os_filter os = FOp (FIdent ([], OpamVariable.of_string "os", None), `Eq, FString os) let linux_filter = os_filter "linux" let macos_filter = os_filter "macos" let openbsd_filter = os_filter "openbsd" let freebsd_filter = os_filter "freebsd" let sandbox_filter = FOr (linux_filter, macos_filter) let gpatch_filter = FOr (openbsd_filter, freebsd_filter) let patch_filter = FNot gpatch_filter let gtar_filter = openbsd_filter let tar_filter = FNot gtar_filter let wrappers ~sandboxing () = let cmd t = [ CString "%{hooks}%/sandbox.sh", None; CString t, None; ] in let w = OpamFile.Wrappers.empty in if sandboxing then { w with OpamFile.Wrappers. wrap_build = [cmd "build", Some sandbox_filter]; wrap_install = [cmd "install", Some sandbox_filter]; wrap_remove = [cmd "remove", Some sandbox_filter]; } else w let bwrap_cmd = "bwrap" let bwrap_filter = linux_filter let bwrap_string () = Printf.sprintf "Sandboxing tool %s was not found. You should install 'bubblewrap'. \ See http://opam.ocaml.org/doc/2.0/FAQ.html#Why-opam-asks-me-to-install-bwrap." bwrap_cmd let fetch_cmd_user () = let open OpamStd.Option.Op in match OpamStd.Env.getopt "OPAMCURL", OpamStd.Env.getopt "OPAMFETCH" >>| fun s -> OpamStd.String.split s ' ' with | Some cmd, _ | _, Some (cmd::_) -> Some cmd | _ -> None let dl_tools () = match fetch_cmd_user () with | None -> ["curl"; "wget"] | Some cmd -> [cmd] let dl_tool () = match fetch_cmd_user () with | None -> None | Some cmd -> Some [(CString cmd), None] let recommended_tools () = let make = OpamStateConfig.(Lazy.force !r.makecmd) in [ [make], None, None; ["m4"], None, None; ["cc"], None, None; ] let required_tools ~sandboxing () = [ dl_tools(), Some "A download tool is required, check env variables OPAMCURL or OPAMFETCH", None; ["diff"], None, None; ["patch"], None, Some patch_filter; ["gpatch"], None, Some gpatch_filter; ["tar"], None, Some tar_filter; ["gtar"], None, Some gtar_filter; ["unzip"], None, None; ] @ if sandboxing then [ [bwrap_cmd], Some (bwrap_string()), Some bwrap_filter; ["sandbox-exec"], None, Some macos_filter; ] else [] let init_scripts () = [ ("sandbox.sh", OpamScript.bwrap), Some bwrap_filter; ("sandbox.sh", OpamScript.sandbox_exec), Some macos_filter; ] module I = OpamFile.InitConfig let (@|) g f = OpamStd.Op.(g @* f) () let init_config ?(sandboxing=true) () = I.empty |> I.with_repositories [OpamRepositoryName.of_string "default", (repository_url, None)] |> I.with_default_compiler default_compiler |> I.with_eval_variables eval_variables |> I.with_wrappers @| wrappers ~sandboxing |> I.with_recommended_tools @| recommended_tools |> I.with_required_tools @| required_tools ~sandboxing |> I.with_init_scripts @| init_scripts |> I.with_dl_tool @| dl_tool opam-2.0.5/src/client/default-manifest.xmlf0000644000175000017500000000221013511367404017636 0ustar nicoonicoo opam-2.0.5/src/client/opamRepositoryCommand.mli0000644000175000017500000000474413511367404020572 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Functions handling the "opam repository" subcommand *) open OpamTypes open OpamStateTypes (** List the selected repositories in the global default and/or selected switches. *) val list: 'a repos_state -> global:bool -> switches:switch list -> short:bool -> unit (** Lists all configured repositories, and, if not [short], the switches they are selected in. *) val list_all: 'a repos_state -> short:bool -> unit (** Add a new repository to ~/.opam/repos, without updating any selections *) val add: rw repos_state -> repository_name -> url -> trust_anchors option -> rw repos_state (** Remove a repository from ~/.opam/repos, without updating any selections *) val remove: rw repos_state -> repository_name -> rw repos_state (** Updates the global switch selection, used as default for switches that don't specify their selections (e.g. newly created switches) *) val update_global_selection: rw global_state -> (repository_name list -> repository_name list) -> rw global_state (** Updates the specified selections using the given functions, taking locks as required *) val update_selection: 'a global_state -> global:bool -> switches:switch list -> (repository_name list -> repository_name list) -> 'a global_state (** Change the registered address of a repo *) val set_url: rw repos_state -> repository_name -> url -> trust_anchors option -> rw repos_state (** Update the given repositories, as per [OpamUpdate.repositories], checks for their version and runs the upgrade script locally if they are for an earlier opam. Returns [true] if no update or upgrade errors were encountered. *) val update_with_auto_upgrade: rw repos_state -> repository_name list -> repository_name list * rw repos_state opam-2.0.5/src/client/opamAdminCommand.mli0000644000175000017500000000165513511367404017441 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2017 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) val admin_command_doc: string val admin_subcommands: (unit Cmdliner.Term.t * Cmdliner.Term.info) list val default_subcommand: unit Cmdliner.Term.t * Cmdliner.Term.info opam-2.0.5/src/client/opamClient.mli0000644000175000017500000001216713511367404016330 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** High-level execution of user-facing functions like install and upgrade, and wrappers around the pinning commands *) open OpamTypes open OpamStateTypes (** Initialize the client to a consistent state. *) val init: init_config:OpamFile.InitConfig.t -> interactive:bool -> ?repo:repository -> ?bypass_checks:bool -> ?dot_profile:filename -> ?update_config:bool -> ?env_hook:bool -> ?completion:bool -> shell -> rw global_state * unlocked repos_state * formula (* (\** Gets the initial config (opamrc) to be used *\) * val get_init_config: * no_default_config_file:bool -> * add_config_file:OpamUrl.t -> * OpamFile.InitConfig.t *) (** Re-runs the extra tools checks, updates the configuration from [init_config] (defaults to [OpamInitDefaults.init_config]) for the settings that are unset, and updates all repositories *) val reinit: ?init_config:OpamFile.InitConfig.t -> interactive:bool -> ?dot_profile:filename -> ?update_config:bool -> ?env_hook:bool -> ?completion:bool -> OpamFile.Config.t -> shell -> unit (** Install the given list of packages. [add_to_roots], if given, specifies that given packages should be added or removed from the roots. [autoupdate] defaults to the list of atoms, and can be used to restrict the atoms which are updated if pinned. *) val install: rw switch_state -> ?autoupdate:atom list -> ?add_to_roots:bool -> ?deps_only:bool -> ?assume_built:bool -> atom list -> rw switch_state (** Low-level version of [reinstall], bypassing the package name sanitization and dev package update, and offering more control *) val install_t: rw switch_state -> ?ask:bool -> atom list -> bool option -> deps_only:bool -> assume_built:bool -> rw switch_state (** Reinstall the given set of packages. *) val reinstall: rw switch_state -> ?assume_built:bool -> atom list -> rw switch_state (** Low-level version of [reinstall], bypassing the package name sanitization and dev package update, and offering more control *) val reinstall_t: rw switch_state -> ?ask:bool -> ?force:bool -> assume_built:bool -> atom list -> rw switch_state (** Update the local mirrors for the repositories and/or development packages. Returns [(success, changes, rt)], where [success] is [true] only if all updates were successful, [changes] is true if any upstream had updates, and [rt] is the updated repository state. *) val update: 'a global_state -> repos_only:bool -> dev_only:bool -> ?all:bool -> string list -> bool * bool * unlocked repos_state (** Upgrade the switch, that is, move packages to their more recent available versions. The specified atoms are kept installed (or newly installed after a confirmation). The upgrade concerns them only unless [all] is specified. *) val upgrade: rw switch_state -> ?check:bool -> all:bool -> atom list -> rw switch_state (** Low-level version of [upgrade], bypassing the package name sanitization and dev package update, and offering more control. [terse] avoids the verbose message when we are at a local maximum, but there are possible upgrades *) val upgrade_t: ?strict_upgrade:bool -> ?auto_install:bool -> ?ask:bool -> ?check:bool -> ?terse:bool -> all:bool -> atom list -> rw switch_state -> rw switch_state (** Recovers from an inconsistent universe *) val fixup: rw switch_state -> rw switch_state (** Remove the given list of packages. *) val remove: rw switch_state -> autoremove:bool -> force:bool -> atom list -> rw switch_state module PIN: sig (** Set a package pinning. If [action], prompt for install/reinstall as appropriate after pinning. *) val pin: rw switch_state -> OpamPackage.Name.t -> ?edit:bool -> ?version:version -> ?action:bool -> [< `Source of url | `Version of version | `Dev_upstream | `None ] -> rw switch_state val edit: rw switch_state -> ?action:bool -> ?version:version -> OpamPackage.Name.t -> rw switch_state val unpin: rw switch_state -> ?action:bool -> OpamPackage.Name.t list -> rw switch_state (** List the current pinned packages. *) val list: 'a switch_state -> short:bool -> unit (** Runs an install/upgrade on the listed packages if necessary. [post_pin_action st was_pinned names] takes the set of packages pinned beforehand, and a list of newly pinned packages *) val post_pin_action: rw switch_state -> package_set -> name list -> rw switch_state end opam-2.0.5/src/client/opamCommands.ml0000644000175000017500000037336713511367404016516 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Cmdliner open OpamArg open OpamTypes open OpamStateTypes open OpamTypesBase open OpamStd.Op let self_upgrade_exe opamroot = OpamFilename.Op.(opamroot // "opam", opamroot // "opam.version") let self_upgrade_bootstrapping_value = "bootstrapping" let switch_to_updated_self debug opamroot = let updated_self, updated_self_version = self_upgrade_exe opamroot in let updated_self_str = OpamFilename.to_string updated_self in let updated_self_version_str = OpamFilename.to_string updated_self_version in if updated_self_str <> Sys.executable_name && OpamFilename.exists updated_self && OpamFilename.is_exec updated_self && OpamFilename.exists updated_self_version then let no_version = OpamVersion.of_string "" in let update_version = try let s = OpamSystem.read updated_self_version_str in let s = let len = String.length s in if len > 0 && s.[len-1] = '\n' then String.sub s 0 (len-1) else s in OpamVersion.of_string s with e -> OpamStd.Exn.fatal e; no_version in if update_version = no_version then OpamConsole.error "%s exists but cannot be read, disabling self-upgrade." updated_self_version_str else if OpamVersion.compare update_version OpamVersion.current <= 0 then OpamConsole.warning "Obsolete opam self-upgrade package v.%s found, \ not using it (current system version is %s)." (OpamVersion.to_string update_version) (OpamVersion.to_string OpamVersion.current) else ( if OpamVersion.git () <> None then OpamConsole.warning "Using opam self-upgrade to %s while the system \ opam is a development version (%s)" (OpamVersion.to_string update_version) (OpamVersion.to_string (OpamVersion.full ())); (if debug || (OpamConsole.debug ()) then OpamConsole.errmsg "!! %s found, switching to it !!\n" updated_self_str; let env = Array.append [|"OPAMNOSELFUPGRADE="^ self_upgrade_bootstrapping_value|] (Unix.environment ()) in try OpamStd.Sys.exec_at_exit (); Unix.execve updated_self_str Sys.argv env with e -> OpamStd.Exn.fatal e; OpamConsole.error "Couldn't run the upgraded opam %s found at %s. \ Continuing with %s from the system." (OpamVersion.to_string update_version) updated_self_str (OpamVersion.to_string OpamVersion.current))) let global_options = let no_self_upgrade = mk_flag ~section:global_option_section ["no-self-upgrade"] "Opam will replace itself with a newer binary found \ at $(b,OPAMROOT/opam) if present. This disables this behaviour." in let self_upgrade no_self_upgrade options = let self_upgrade_status = if OpamStd.Config.env_string "NOSELFUPGRADE" = Some self_upgrade_bootstrapping_value then `Running else if no_self_upgrade then `Disable else if OpamStd.Config.env_bool "NOSELFUPGRADE" = Some true then `Disable else `None in if self_upgrade_status = `None then switch_to_updated_self OpamStd.Option.Op.(options.debug_level ++ OpamStd.Config.env_level "DEBUG" +! 0 > 0) (OpamStateConfig.opamroot ?root_dir:options.opt_root ()); let root_is_ok = OpamStd.Option.default false (OpamStd.Config.env_bool "ROOTISOK") in if not (options.safe_mode || root_is_ok) && Unix.getuid () = 0 then OpamConsole.warning "Running as root is not recommended"; options, self_upgrade_status in Term.(const self_upgrade $ no_self_upgrade $ global_options) let apply_global_options (options,self_upgrade) = apply_global_options options; try let argv0 = OpamFilename.of_string Sys.executable_name in if self_upgrade <> `Running && OpamFilename.starts_with OpamStateConfig.(!r.root_dir) argv0 && not !OpamCoreConfig.r.OpamCoreConfig.safe_mode then OpamConsole.warning "You should not be running opam from within %s. \ Copying %s to your PATH first is advised." (OpamFilename.Dir.to_string OpamStateConfig.(!r.root_dir)) (OpamFilename.to_string argv0) with e -> OpamStd.Exn.fatal e let self_upgrade_status global_options = snd global_options type command = unit Term.t * Term.info let get_init_config ~no_sandboxing ~no_default_config_file ~add_config_file = let builtin_config = OpamInitDefaults.init_config ~sandboxing:(not no_sandboxing) () in let config_files = (if no_default_config_file then [] else List.filter OpamFile.exists (OpamPath.init_config_files ())) @ List.map (fun url -> match OpamUrl.local_file url with | Some f -> OpamFile.make f | None -> let f = OpamFilename.of_string (OpamSystem.temp_file "conf") in OpamProcess.Job.run (OpamDownload.download_as ~overwrite:false url f); let hash = OpamHash.compute ~kind:`SHA256 (OpamFilename.to_string f) in if OpamConsole.confirm "Using configuration file from %s. \ Please verify the following SHA256:\n %s\n\ Is this correct?" (OpamUrl.to_string url) (OpamHash.contents hash) then OpamFile.make f else OpamStd.Sys.exit_because `Aborted ) add_config_file in try let others = match config_files with | [] -> "" | [file] -> OpamFile.to_string file ^ " and then from " | _ -> (OpamStd.List.concat_map ~nil:"" ~right:", and finally from " ", then " OpamFile.to_string (List.rev config_files)) in OpamConsole.note "Will configure from %sbuilt-in defaults." others; List.fold_left (fun acc f -> OpamFile.InitConfig.add acc (OpamFile.InitConfig.read f)) builtin_config config_files with e -> OpamConsole.error "Error in configuration file, fix it, use '--no-opamrc', or check \ your '--config FILE' arguments:"; OpamConsole.errmsg "%s\n" (Printexc.to_string e); OpamStd.Sys.exit_because `Configuration_error (* INIT *) let init_doc = "Initialize opam state, or set init options." let init = let doc = init_doc in let man = [ `S "DESCRIPTION"; `P "Initialise the opam state, or update opam init options"; `P "The $(b,init) command initialises a local \"opam root\" (by default, \ $(i,~/.opam/)) that holds opam's data and packages. This is a \ necessary step for normal operation of opam. The initial software \ repositories are fetched, and an initial 'switch' can also be \ installed, according to the configuration and options. These can be \ afterwards configured using $(b,opam switch) and $(b,opam \ repository)."; `P "The initial repository and defaults can be set through a \ configuration file found at $(i,~/.opamrc) or $(i,/etc/opamrc)."; `P "Additionally, this command allows one to customise some aspects of opam's \ shell integration, when run initially (avoiding the interactive \ dialog), but also at any later time."; `S "ARGUMENTS"; `S "OPTIONS"; `S "CONFIGURATION FILE"; `P "Any field from the built-in initial configuration can be overridden \ through $(i,~/.opamrc), $(i,/etc/opamrc), or a file supplied with \ $(i,--config). The default configuration for this version of opam \ can be obtained using $(b,--show-default-opamrc)."; `S OpamArg.build_option_section; ] in let compiler = mk_opt ["c";"compiler"] "PACKAGE" "Set the compiler to install (when creating an initial switch)" Arg.(some string) None in let no_compiler = mk_flag ["bare"] "Initialise the opam state, but don't setup any compiler switch yet." in let repo_name = let doc = Arg.info [] ~docv:"NAME" ~doc: "Name of the initial repository, when creating a new opam root." in Arg.(value & pos ~rev:true 1 repository_name OpamRepositoryName.default & doc) in let repo_url = let doc = Arg.info [] ~docv:"ADDRESS" ~doc: "Address of the initial package repository, when creating a new opam \ root." in Arg.(value & pos ~rev:true 0 (some string) None & doc) in let interactive = Arg.(value & vflag None [ Some false, info ["a";"auto-setup"] ~doc: "Automatically do a full setup, including adding a line to your \ shell init files."; Some true, info ["i";"interactive"] ~doc: "Run the setup interactively (this is the default for an initial \ run, or when no more specific options are specified)"; ]) in let update_config = Arg.(value & vflag None [ Some true, info ["shell-setup"] ~doc: "Automatically setup the user shell configuration for opam, e.g. \ adding a line to the `~/.profile' file."; Some false, info ["n";"no-setup"] ~doc: "Do not update the user shell configuration to setup opam. Also \ implies $(b,--disable-shell-hook), unless $(b,--interactive) or \ specified otherwise"; ]) in let setup_completion = Arg.(value & vflag None [ Some true, info ["enable-completion"] ~doc: "Setup shell completion in opam init scripts, for supported \ shells."; Some false, info ["disable-completion"] ~doc: "Disable shell completion in opam init scripts."; ]) in let env_hook = Arg.(value & vflag None [ Some true, info ["enable-shell-hook"] ~doc: "Setup opam init scripts to register a shell hook that will \ automatically keep the shell environment up-to-date at every \ prompt."; Some false, info ["disable-shell-hook"] ~doc: "Disable registration of a shell hook in opam init scripts."; ]) in let config_file = mk_opt_all ["config"] "FILE" "Use the given init config file. If repeated, latest has the highest \ priority ($(b,i.e.) each field gets its value from where it was defined \ last). Specifying a URL pointing to a config file instead is \ allowed." OpamArg.url in let no_config_file = mk_flag ["no-opamrc"] "Don't read `/etc/opamrc' or `~/.opamrc': use the default settings and \ the files specified through $(b,--config) only" in let reinit = mk_flag ["reinit"] "Re-run the initial checks and setup, according to opamrc, even if this \ is not a new opam root" in let show_default_opamrc = mk_flag ["show-default-opamrc"] "Print the built-in default configuration to stdout and exit" in let bypass_checks = mk_flag ["bypass-checks"] "Skip checks on required or recommended tools, and assume everything is \ fine" in let no_sandboxing = mk_flag ["disable-sandboxing"] "Use a default configuration with sandboxing disabled (note that this \ may be overridden by `opamrc' if $(b,--no-opamrc) is not specified or \ $(b,--config) is used). Use this at your own risk, without sandboxing \ it is possible for a broken package script to delete all your files." in let init global_options build_options repo_kind repo_name repo_url interactive update_config completion env_hook no_sandboxing shell dot_profile_o compiler no_compiler config_file no_config_file reinit show_opamrc bypass_checks = apply_global_options global_options; apply_build_options build_options; (* If show option is set, dump opamrc and exit *) if show_opamrc then (OpamFile.InitConfig.write_to_channel stdout @@ OpamInitDefaults.init_config ~sandboxing:(not no_sandboxing) (); OpamStd.Sys.exit_because `Success); (* Else continue init *) if compiler <> None && no_compiler then OpamConsole.error_and_exit `Bad_arguments "Options --bare and --compiler are incompatible"; let root = OpamStateConfig.(!r.root_dir) in let config_f = OpamPath.config root in let already_init = OpamFile.exists config_f in let interactive, update_config, completion, env_hook = match interactive with | Some false -> OpamStd.Option.Op.( false, update_config ++ Some true, completion ++ Some true, env_hook ++ Some true ) | None -> (not already_init || update_config = None && completion = None && env_hook = None), update_config, completion, OpamStd.Option.Op.(env_hook ++ update_config) | Some true -> if update_config = None && completion = None && env_hook = None then true, None, None, None else let reconfirm = function | None | Some false -> Some false | Some true -> None in true, reconfirm update_config, reconfirm completion, reconfirm env_hook in let shell = match shell with | Some s -> s | None -> OpamStd.Sys.guess_shell_compat () in let dot_profile = match dot_profile_o with | Some n -> n | None -> OpamFilename.of_string (OpamStd.Sys.guess_dot_profile shell) in if already_init then if reinit then let init_config = get_init_config ~no_sandboxing ~no_default_config_file:no_config_file ~add_config_file:config_file in OpamClient.reinit ~init_config ~interactive ~dot_profile ?update_config ?env_hook ?completion (OpamFile.Config.safe_read config_f) shell else OpamEnv.setup root ~interactive ~dot_profile ?update_config ?env_hook ?completion shell else let init_config = get_init_config ~no_sandboxing ~no_default_config_file:no_config_file ~add_config_file:config_file in let repo = OpamStd.Option.map (fun url -> let repo_url = OpamUrl.parse ?backend:repo_kind url in let repo_root = OpamRepositoryPath.create (OpamStateConfig.(!r.root_dir)) repo_name in { repo_root; repo_name; repo_url; repo_trust = None }) repo_url in let gt, rt, default_compiler = OpamClient.init ~init_config ~interactive ?repo ~bypass_checks ~dot_profile ?update_config ?env_hook ?completion shell in if no_compiler then () else match compiler with | Some comp when String.length comp <> 0-> let packages = OpamSwitchCommand.guess_compiler_package rt comp in OpamConsole.header_msg "Creating initial switch (%s)" (OpamFormula.string_of_atoms packages); OpamSwitchCommand.install gt ~rt ~packages ~update_config:true (OpamSwitch.of_string comp) |> ignore | _ as nocomp -> if nocomp <> None then OpamConsole.warning "No compiler specified, a default compiler will be selected."; let candidates = OpamFormula.to_dnf default_compiler in let all_packages = OpamSwitchCommand.get_compiler_packages rt in let compiler_packages = try Some (List.find (fun atoms -> let names = List.map fst atoms in let pkgs = OpamFormula.packages_of_atoms all_packages atoms in List.for_all (OpamPackage.has_name pkgs) names) candidates) with Not_found -> None in match compiler_packages with | Some packages -> OpamConsole.header_msg "Creating initial switch (%s)" (OpamFormula.string_of_atoms packages); OpamSwitchCommand.install gt ~rt ~packages ~update_config:true (OpamSwitch.of_string "default") |> ignore | None -> OpamConsole.note "No compiler selected, and no available default switch found: \ no switch has been created.\n\ Use 'opam switch create ' to get started." in Term.(const init $global_options $build_options $repo_kind_flag $repo_name $repo_url $interactive $update_config $setup_completion $env_hook $no_sandboxing $shell_opt $dot_profile_flag $compiler $no_compiler $config_file $no_config_file $reinit $show_default_opamrc $bypass_checks), term_info "init" ~doc ~man (* LIST *) let list_doc = "Display the list of available packages." let list ?(force_search=false) () = let doc = list_doc in let selection_docs = OpamArg.package_selection_section in let display_docs = OpamArg.package_listing_section in let man = [ `S "DESCRIPTION"; `P "List selections of opam packages."; `P "Without argument, the command displays the list of currently installed \ packages. With pattern arguments, lists all available packages \ matching one of the patterns."; `P "Unless the $(b,--short) switch is used, the output format displays one \ package per line, and each line contains the name of the package, the \ installed version or `--' if the package is not installed, and a short \ description. In color mode, manually installed packages (as opposed to \ automatically installed ones because of dependencies) are underlined."; `P ("See section $(b,"^selection_docs^") for all the ways to select the \ packages to be displayed, and section $(b,"^display_docs^") to \ customise the output format."); `P "For a more detailed description of packages, see $(b,opam show). For \ extended search capabilities within the packages' metadata, see \ $(b,opam search)."; `S "ARGUMENTS"; `S selection_docs; `S display_docs; ] in let pattern_list = arg_list "PATTERNS" "Package patterns with globs. Unless $(b,--search) is specified, they \ match againsta $(b,NAME) or $(b,NAME.VERSION)" Arg.string in let state_selector = let docs = selection_docs in Arg.(value & vflag_all [] [ OpamListCommand.Any, info ~docs ["A";"all"] ~doc:"Include all, even uninstalled or unavailable packages"; OpamListCommand.Installed, info ~docs ["i";"installed"] ~doc:"List installed packages only. This is the default when no \ further arguments are supplied"; OpamListCommand.Root, info ~docs ["roots";"installed-roots"] ~doc:"List only packages that were explicitly installed, excluding \ the ones installed as dependencies"; OpamListCommand.Available, info ~docs ["a";"available"] ~doc:"List only packages that are available on the current system"; OpamListCommand.Installable, info ~docs ["installable"] ~doc:"List only packages that can be installed on the current switch \ (this calls the solver and may be more costly; a package \ depending on an unavailable package may be available, but is \ never installable)"; OpamListCommand.Compiler, info ~docs ["base"] ~doc:"List only the immutable base of the current switch (i.e. \ compiler packages)"; OpamListCommand.Pinned, info ~docs ["pinned"] ~doc:"List only the pinned packages"; ]) in let search = if force_search then Term.const true else mk_flag ["search"] ~section:selection_docs "Match $(i,PATTERNS) against the full descriptions of packages, and \ require all of them to match, instead of requiring at least one to \ match against package names (unless $(b,--or) is also specified)." in let repos = mk_opt ["repos"] "REPOS" ~section:selection_docs "Include only packages that took their origin from one of the given \ repositories (unless $(i,no-switch) is also specified, this excludes \ pinned packages)." Arg.(some & list & repository_name) None in let owns_file = let doc = "Finds installed packages responsible for installing the given file" in Arg.(value & opt (some OpamArg.filename) None & info ~doc ~docv:"FILE" ~docs:selection_docs ["owns-file"]) in let no_switch = mk_flag ["no-switch"] ~section:selection_docs "List what is available from the repositories, without consideration for \ the current (or any other) switch (installed or pinned packages, etc.)" in let disjunction = mk_flag ["or"] ~section:selection_docs "Instead of selecting packages that match $(i,all) the criteria, select \ packages that match $(i,any) of them" in let depexts = mk_flag ["e";"external";"depexts"] ~section:display_docs "Instead of displaying the packages, display their external dependencies \ that are associated with the current system. This excludes other \ display options. Rather than using this directly, you should probably \ head for the `depext' plugin, that will use your system package \ management system to handle the installation of the dependencies. Run \ `opam depext'." in let vars = mk_opt ["vars"] "[VAR=STR,...]" ~section:display_docs "Define the given variable bindings. Typically useful with \ $(b,--external) to override the values for $(i,arch), $(i,os), \ $(i,os-distribution), $(i,os-version), $(i,os-family)." OpamArg.variable_bindings [] in let silent = mk_flag ["silent"] "Don't write anything in the output, exit with return code 0 if the list \ is not empty, 1 otherwise." in let list global_options selection state_selector no_switch depexts vars repos owns_file disjunction search silent format packages = apply_global_options global_options; let no_switch = no_switch || OpamStateConfig.get_switch_opt () = None in let format = let force_all_versions = not search && state_selector = [] && match packages with | [single] -> let nameglob = match OpamStd.String.cut_at single '.' with | None -> single | Some (n, _v) -> n in (try ignore (OpamPackage.Name.of_string nameglob); true with Failure _ -> false) | _ -> false in format ~force_all_versions in let join = if disjunction then OpamFormula.ors else OpamFormula.ands in let state_selector = if state_selector = [] then if no_switch || search || owns_file <> None then Empty else if packages = [] && selection = [] then Atom OpamListCommand.Installed else Or (Atom OpamListCommand.Installed, Atom OpamListCommand.Available) else join (List.map (fun x -> Atom x) state_selector) in let pattern_selector = if search then join (List.map (fun p -> Atom (OpamListCommand.(Pattern (default_pattern_selector, p)))) packages) else OpamListCommand.pattern_selector packages in let filter = OpamFormula.ands [ state_selector; join (pattern_selector :: (if no_switch then Empty else match repos with None -> Empty | Some repos -> Atom (OpamListCommand.From_repository repos)) :: OpamStd.Option.Op. ((owns_file >>| fun f -> Atom (OpamListCommand.Owns_file f)) +! Empty) :: List.map (fun x -> Atom x) selection) ] in OpamGlobalState.with_ `Lock_none @@ fun gt -> let st = let rt = OpamRepositoryState.load `Lock_none gt in if no_switch then OpamSwitchState.load_virtual ?repos_list:repos gt rt else OpamSwitchState.load `Lock_none gt rt (OpamStateConfig.get_switch ()) in let st = let open OpamFile.Switch_config in let conf = st.switch_config in { st with switch_config = { conf with variables = conf.variables @ List.map (fun (var, v) -> var, S v) vars } } in if not depexts && not format.OpamListCommand.short && filter <> OpamFormula.Empty && not silent then OpamConsole.msg "# Packages matching: %s\n" (OpamListCommand.string_of_formula filter); let all = OpamPackage.Set.union st.packages st.installed in let results = OpamListCommand.filter ~base:all st filter in if not depexts then (if not silent then OpamListCommand.display st format results else if OpamPackage.Set.is_empty results then OpamStd.Sys.exit_because `False) else let results_depexts = OpamListCommand.get_depexts st results in if not silent then OpamListCommand.print_depexts results_depexts else if OpamStd.String.Set.is_empty results_depexts then OpamStd.Sys.exit_because `False in Term.(const list $global_options $package_selection $state_selector $no_switch $depexts $vars $repos $owns_file $disjunction $search $silent $package_listing $pattern_list), term_info "list" ~doc ~man (* SHOW *) let show_doc = "Display information about specific packages." let show = let doc = show_doc in let man = [ `S "DESCRIPTION"; `P "This command displays the information block for the selected \ package(s)."; `P "The information block consists of the name of the package, \ the installed version if this package is installed in the currently \ selected compiler, the list of available (installable) versions, and a \ complete description."; `P "$(b,opam list) can be used to display the list of \ available packages as well as a short description for each."; `P "Paths to package definition files or to directories containing package \ definitions can also be specified, in which case the corresponding \ metadata will be shown." ] in let fields = let doc = Arg.info ~docv:"FIELDS" ~doc:("Only display the values of these fields. Fields can be selected \ among "^ OpamStd.List.concat_map ", " (Printf.sprintf "$(i,%s)" @* snd) OpamListCommand.field_names ^". Multiple fields can be separated with commas, in which case \ field titles will be printed; the raw value of any opam-file \ field can be queried by suffixing a colon character (:), e.g. \ $(b,--field=depopts:).") ["f";"field"] in Arg.(value & opt (list string) [] & doc) in let show_empty = mk_flag ["empty-fields"] "Show fields that are empty. This is implied when $(b,--field) is \ given." in let raw = mk_flag ["raw"] "Print the raw opam file for this package" in let where = mk_flag ["where"] "Print the location of the opam file used for this package" in let list_files = mk_flag ["list-files"] "List the files installed by the package. Equivalent to \ $(b,--field=installed-files), and only available for installed \ packages" in let file = let doc = Arg.info ~docv:"FILE" ~doc:"DEPRECATED: use an explicit path argument as package instead. \ Get package information from the given FILE instead of from \ known packages. This implies $(b,--raw) unless $(b,--fields) is \ used. Only raw opam-file fields can be queried." ["file"] in Arg.(value & opt (some existing_filename_or_dash) None & doc) in let normalise = mk_flag ["normalise"] "Print the values of opam fields normalised (no newlines, no implicit \ brackets)" in let no_lint = mk_flag ["no-lint"] "Don't output linting warnings or errors when reading from files" in let pkg_info global_options fields show_empty raw where list_files file normalise no_lint atom_locs = apply_global_options global_options; match file, atom_locs with | None, [] -> `Error (true, "required argument PACKAGES is missing") | Some _, _::_ -> `Error (true, "arguments PACKAGES and `--file' can't be specified together") | None, atom_locs -> let fields, show_empty = if list_files then fields @ [OpamListCommand.(string_of_field Installed_files)], show_empty else fields, show_empty || fields <> [] in OpamGlobalState.with_ `Lock_none @@ fun gt -> let st = OpamListCommand.get_switch_state gt in let st, atoms = OpamAuxCommands.simulate_autopin ~quiet:no_lint ~for_view:true st atom_locs in OpamListCommand.info st ~fields ~raw_opam:raw ~where ~normalise ~show_empty atoms; `Ok () | Some f, [] -> let opam = match f with | Some f -> OpamFile.OPAM.read (OpamFile.make f) | None -> OpamFile.OPAM.read_from_channel stdin in if not no_lint then OpamFile.OPAM.print_errors opam; if where then (OpamConsole.msg "%s\n" (match f with Some f -> OpamFilename.(Dir.to_string (dirname f)) | None -> "."); `Ok ()) else let opam_content_list = OpamFile.OPAM.to_list opam in let get_field f = let f = OpamStd.String.remove_suffix ~suffix:":" f in try OpamListCommand.mini_field_printer ~prettify:true ~normalise (List.assoc f opam_content_list) with Not_found -> "" in match fields with | [] -> OpamFile.OPAM.write_to_channel stdout opam; `Ok () | [f] -> OpamConsole.msg "%s\n" (get_field f); `Ok () | flds -> let tbl = List.map (fun fld -> [ OpamConsole.colorise `blue (OpamStd.String.remove_suffix ~suffix:":" fld ^ ":"); get_field fld ]) flds in OpamStd.Format.align_table tbl |> OpamConsole.print_table stdout ~sep:" "; `Ok () in Term.(ret (const pkg_info $global_options $fields $show_empty $raw $where $list_files $file $normalise $no_lint $atom_or_local_list)), term_info "show" ~doc ~man module Common_config_flags = struct let sexp = mk_flag ["sexp"] "Print environment as an s-expression rather than in shell format" let inplace_path = mk_flag ["inplace-path"] "When updating the $(i,PATH) variable, replace any pre-existing opam \ path in-place rather than putting the new path in front. This means \ programs installed in opam that were shadowed will remain so after \ $(b,opam env)" let set_opamroot = mk_flag ["set-root"] "With the $(b,env) and $(b,exec) subcommands, also sets the \ $(i,OPAMROOT) variable, making sure further calls to opam will use the \ same root." let set_opamswitch = mk_flag ["set-switch"] "With the $(b,env) and $(b,exec) subcommands, also sets the \ $(i,OPAMSWITCH) variable, making sure further calls to opam will use \ the same switch as this one." end (* CONFIG *) let config_doc = "Display configuration options for packages." let config = let doc = config_doc in let commands = [ "env", `env, [], "Returns the bindings for the environment variables set in the current \ switch, e.g. PATH, in a format intended to be evaluated by a shell. With \ $(i,-v), add comments documenting the reason or package of origin for \ each binding. This is most usefully used as $(b,eval \\$(opam config \ env\\)) to have further shell commands be evaluated in the proper opam \ context. Can also be accessed through $(b,opam env)."; "revert-env", `revert_env, [], "Reverts environment changes made by opam, e.g. $(b,eval \\$(opam config \ revert-env)) undoes what $(b,eval \\$(opam config env\\)) did, as much as \ possible."; "exec", `exec, ["[--] COMMAND"; "[ARG]..."], "Execute $(i,COMMAND) with the correct environment variables. This command \ can be used to cross-compile between switches using $(b,opam config exec \ --switch=SWITCH -- COMMAND ARG1 ... ARGn). Opam expansion takes place in \ command and args. If no switch is present on the command line or in the \ $(i,OPAMSWITCH) environment variable, $(i,OPAMSWITCH) is not set in \ $(i,COMMAND)'s environment. Can also be accessed through $(b,opam exec)."; "var", `var, ["VAR"], "Return the value associated with variable $(i,VAR). Package variables can \ be accessed with the syntax $(i,pkg:var). Can also be accessed through \ $(b,opam var)"; "list", `list, ["[PACKAGE]..."], "Without argument, prints a documented list of all available variables. \ With $(i,PACKAGE), lists all the variables available for these packages. \ Use $(i,-) to include global configuration variables for this switch."; "set", `set, ["VAR";"VALUE"], "Set the given opam variable for the current switch. Warning: changing a \ configured path will not move any files! This command does not perform \ any variable expansion."; "unset", `unset, ["VAR"], "Unset the given opam variable for the current switch. Warning: \ unsetting built-in configuration variables can cause problems!"; "set-global", `set_global, ["VAR";"VALUE"], "Set the given variable globally in the opam root, to be visible in all \ switches"; "unset-global", `unset_global, ["VAR"], "Unset the given global variable"; "expand", `expand, ["STRING"], "Expand variable interpolations in the given string"; "subst", `subst, ["FILE..."], "Substitute variables in the given files. The strings $(i,%{var}%) are \ replaced by the value of variable $(i,var) (see $(b,var))."; "report", `report, [], "Prints a summary of your setup, useful for bug-reports."; "cudf-universe",`cudf, ["[FILE]"], "Outputs the current available package universe in CUDF format."; "pef-universe", `pef, ["[FILE]"], "Outputs the current package universe in PEF format."; ] in let man = [ `S "DESCRIPTION"; `P "This command uses opam state to output information on how to use \ installed libraries, update the $(b,PATH), and substitute \ variables used in opam packages."; `P "Apart from $(b,opam config env), most of these commands are used \ by opam internally, and are of limited interest for the casual \ user."; ] @ mk_subdoc commands @ [`S "OPTIONS"] in let command, params = mk_subcommands commands in let open Common_config_flags in let config global_options command shell sexp inplace_path set_opamroot set_opamswitch params = apply_global_options global_options; let shell = match shell with | Some s -> s | None -> OpamStd.Sys.guess_shell_compat () in match command, params with | Some `env, [] -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (match OpamStateConfig.get_switch_opt () with | None -> `Ok () | Some sw -> `Ok (OpamConfigCommand.env gt sw ~set_opamroot ~set_opamswitch ~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish) ~inplace_path)) | Some `revert_env, [] -> `Ok (OpamConfigCommand.print_eval_env ~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish) (OpamEnv.add [] [])) | Some `exec, (_::_ as c) -> OpamGlobalState.with_ `Lock_none @@ fun gt -> `Ok (OpamConfigCommand.exec gt ~set_opamroot ~set_opamswitch ~inplace_path c) | Some `list, params -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (try `Ok (OpamConfigCommand.list gt (List.map OpamPackage.Name.of_string params)) with Failure msg -> `Error (false, msg)) | Some `set, [var; value] -> `Ok (OpamConfigCommand.set (OpamVariable.Full.of_string var) (Some value)) | Some `unset, [var] -> `Ok (OpamConfigCommand.set (OpamVariable.Full.of_string var) None) | Some `set_global, [var; value] -> `Ok (OpamConfigCommand.set_global (OpamVariable.Full.of_string var) (Some value)) | Some `unset_global, [var] -> `Ok (OpamConfigCommand.set_global (OpamVariable.Full.of_string var) None) | Some `expand, [str] -> OpamGlobalState.with_ `Lock_none @@ fun gt -> `Ok (OpamConfigCommand.expand gt str) | Some `var, [var] -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (try `Ok (OpamConfigCommand.variable gt (OpamVariable.Full.of_string var)) with Failure msg -> `Error (false, msg)) | Some `subst, (_::_ as files) -> OpamGlobalState.with_ `Lock_none @@ fun gt -> `Ok (OpamConfigCommand.subst gt (List.map OpamFilename.Base.of_string files)) | Some `pef, params -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_none gt @@ fun st -> (match params with | [] | ["-"] -> OpamSwitchState.dump_pef_state st stdout; `Ok () | [file] -> let oc = open_out file in OpamSwitchState.dump_pef_state st oc; close_out oc; `Ok () | _ -> bad_subcommand commands ("config", command, params)) | Some `cudf, params -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_none gt @@ fun opam_state -> let opam_univ = OpamSwitchState.universe opam_state ~requested:(OpamPackage.names_of_packages opam_state.packages) Query in let dump oc = OpamSolver.dump_universe opam_univ oc in (match params with | [] -> `Ok (dump stdout) | [file] -> let oc = open_out file in dump oc; close_out oc; `Ok () | _ -> bad_subcommand commands ("config", command, params)) | Some `report, [] -> ( let print label fmt = OpamConsole.msg ("# %-17s "^^fmt^^"\n") label in OpamConsole.msg "# opam config report\n"; print "opam-version" "%s " (OpamVersion.to_string (OpamVersion.full ())); print "self-upgrade" "%s" (if self_upgrade_status global_options = `Running then OpamFilename.prettify (fst (self_upgrade_exe (OpamStateConfig.(!r.root_dir)))) else "no"); print "system" "arch=%s os=%s os-distribution=%s os-version=%s" OpamStd.Option.Op.(OpamSysPoll.arch () +! "unknown") OpamStd.Option.Op.(OpamSysPoll.os () +! "unknown") OpamStd.Option.Op.(OpamSysPoll.os_distribution () +! "unknown") OpamStd.Option.Op.(OpamSysPoll.os_version () +! "unknown"); try OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_none gt @@ fun state -> let module Solver = (val OpamSolverConfig.(Lazy.force !r.solver)) in print "solver" "%s" (OpamCudfSolver.get_name (module Solver)); print "install-criteria" "%s" (OpamSolverConfig.criteria `Default); print "upgrade-criteria" "%s" (OpamSolverConfig.criteria `Upgrade); let nprint label n = if n <> 0 then [Printf.sprintf "%d (%s)" n label] else [] in print "jobs" "%d" (Lazy.force OpamStateConfig.(!r.jobs)); print "repositories" "%s" (let repos = state.switch_repos.repositories in let default, nhttp, nlocal, nvcs = OpamRepositoryName.Map.fold (fun _ repo (dft, nhttp, nlocal, nvcs) -> let dft = if OpamUrl.root repo.repo_url = OpamUrl.root OpamInitDefaults.repository_url then OpamFile.Repo.safe_read (OpamRepositoryPath.repo repo.repo_root) |> OpamFile.Repo.stamp else dft in match repo.repo_url.OpamUrl.backend with | `http -> dft, nhttp+1, nlocal, nvcs | `rsync -> dft, nhttp, nlocal+1, nvcs | _ -> dft, nhttp, nlocal, nvcs+1) repos (None,0,0,0) in String.concat ", " (nprint "http" nhttp @ nprint "local" nlocal @ nprint "version-controlled" nvcs) ^ match default with | Some v -> Printf.sprintf " (default repo at %s)" v | None -> "" ); print "pinned" "%s" (if OpamPackage.Set.is_empty state.pinned then "0" else let pinnings = OpamPackage.Set.fold (fun nv acc -> let opam = OpamSwitchState.opam state nv in let kind = if Some opam = OpamPackage.Map.find_opt nv state.repos_package_index then "version" else OpamStd.Option.to_string ~none:"local" (fun u -> OpamUrl.string_of_backend u.OpamUrl.backend) (OpamFile.OPAM.get_url opam) in OpamStd.String.Map.update kind succ 0 acc) state.pinned OpamStd.String.Map.empty in String.concat ", " (List.flatten (List.map (fun (k,v) -> nprint k v) (OpamStd.String.Map.bindings pinnings))) ); print "current-switch" "%s" (OpamSwitch.to_string state.switch); if List.mem "." (OpamStd.Sys.split_path_variable (Sys.getenv "PATH")) then OpamConsole.warning "PATH contains '.' : this is a likely cause of trouble."; `Ok () with e -> print "read-state" "%s" (Printexc.to_string e); `Ok ()) | command, params -> bad_subcommand commands ("config", command, params) in Term.ret ( Term.(const config $global_options $command $shell_opt $sexp $inplace_path $set_opamroot $set_opamswitch $params) ), term_info "config" ~doc ~man (* VAR *) let var_doc = "Prints the value associated with a given variable" let var = let doc = var_doc in let man = [ `S "DESCRIPTION"; `P "With a $(i,VAR) argument, prints the value associated with $(i,VAR). \ Without argument, lists the opam variables currently defined. This \ command is a shortcut to `opam config var` and `opam config list`."; ] in let varname = Arg.(value & pos 0 (some string) None & info ~docv:"VAR" []) in let package = Arg.(value & opt (some package_name) None & info ~docv:"PACKAGE" ["package"] ~doc:"List all variables defined for the given package") in let print_var global_options package var = apply_global_options global_options; match var, package with | None, None -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (try `Ok (OpamConfigCommand.list gt []) with Failure msg -> `Error (false, msg)) | None, Some pkg -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (try `Ok (OpamConfigCommand.list gt [pkg]) with Failure msg -> `Error (false, msg)) | Some v, None -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (try `Ok (OpamConfigCommand.variable gt (OpamVariable.Full.of_string v)) with Failure msg -> `Error (false, msg)) | Some _, Some _ -> `Error (true, "--package can't be specified with a var argument, use \ 'pkg:var' instead.") in Term.ret ( Term.(const print_var $global_options $package $varname) ), term_info "var" ~doc ~man (* EXEC *) let exec_doc = "Executes a command in the proper opam environment" let exec = let doc = exec_doc in let man = [ `S "DESCRIPTION"; `P "Execute $(i,COMMAND) with the correct environment variables. This \ command can be used to cross-compile between switches using $(b,opam \ config exec --switch=SWITCH -- COMMAND ARG1 ... ARGn). Opam expansion \ takes place in command and args. If no switch is present on the \ command line or in the $(i,OPAMSWITCH) environment variable, \ $(i,OPAMSWITCH) is not set in $(i,COMMAND)'s environment."; `P "This is a shortcut, and equivalent to $(b,opam config exec)."; ] in let cmd = Arg.(non_empty & pos_all string [] & info ~docv:"COMMAND [ARG]..." []) in let exec global_options inplace_path set_opamroot set_opamswitch cmd = apply_global_options global_options; OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamConfigCommand.exec gt ~set_opamroot ~set_opamswitch ~inplace_path cmd in let open Common_config_flags in Term.(const exec $global_options $inplace_path $set_opamroot $set_opamswitch $cmd), term_info "exec" ~doc ~man (* ENV *) let env_doc = "Prints appropriate shell variable assignments to stdout" let env = let doc = env_doc in let man = [ `S "DESCRIPTION"; `P "Returns the bindings for the environment variables set in the current \ switch, e.g. PATH, in a format intended to be evaluated by a shell. \ With $(i,-v), add comments documenting the reason or package of origin \ for each binding. This is most usefully used as $(b,eval \\$(opam \ env\\)) to have further shell commands be evaluated in the proper opam \ context."; `P "This is a shortcut, and equivalent to $(b,opam config env)."; ] in let revert = mk_flag ["revert"] "Output the environment with updates done by opam reverted instead." in let env global_options shell sexp inplace_path set_opamroot set_opamswitch revert = apply_global_options global_options; let shell = match shell with | Some s -> s | None -> OpamStd.Sys.guess_shell_compat () in match revert with | false -> OpamGlobalState.with_ `Lock_none @@ fun gt -> (match OpamStateConfig.get_switch_opt () with | None -> () | Some sw -> OpamConfigCommand.env gt sw ~set_opamroot ~set_opamswitch ~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish) ~inplace_path) | true -> OpamConfigCommand.print_eval_env ~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish) (OpamEnv.add [] []) in let open Common_config_flags in Term.(const env $global_options $shell_opt $sexp $inplace_path $set_opamroot $set_opamswitch$revert), term_info "env" ~doc ~man (* INSTALL *) let install_doc = "Install a list of packages." let install = let doc = install_doc in let man = [ `S "DESCRIPTION"; `P "This command installs one or more packages inside the currently \ selected switch (see $(b,opam switch)). Once installed, you can remove \ packages with $(b,opam remove), upgrade them with $(b,opam upgrade), \ and list them with $(b,opam list). See $(b,opam pin) as well to manage \ package versions, reroute existing packages or add packages that are \ not defined in the repositories."; `P "All required dependencies of the selected packages will be installed \ first. Any already installed packages having dependencies, or optional \ dependencies to the changed packages will be recompiled. The proposed \ solution may also imply removing incompatible or conflicting \ packages."; `P "If paths are provided as argument instead of packages, they are \ assumed to point to either project source directories containing one \ or more package definitions ($(i,opam) files), or directly to \ $(i,opam) files. Then the corresponding packages will be pinned to \ their local directory and installed (unless $(b,--deps-only) was \ specified)."; `S "ARGUMENTS"; `S "OPTIONS"; `S OpamArg.build_option_section; ] in let add_to_roots = let root = Some true, Arg.info ["set-root"] ~doc:"Mark given packages as installed roots. This is the default \ for newly manually-installed packages." in let unroot = Some false, Arg.info ["unset-root"] ~doc:"Mark given packages as \"installed automatically\"." in Arg.(value & vflag None[root; unroot]) in let deps_only = Arg.(value & flag & info ["deps-only"] ~doc:"Install all its dependencies, but don't actually install the \ package.") in let restore = Arg.(value & flag & info ["restore"] ~doc:"Attempt to restore packages that were marked for installation \ but have been removed due to errors") in let destdir = mk_opt ["destdir"] "DIR" "Copy the files installed by the given package within the current opam \ switch below the prefix $(i,DIR), respecting their hierarchy, after \ installation. Caution, calling this can overwrite, but never remove \ files, even if they were installed by a previous use of $(b,--destdir), \ e.g. on a previous version of the same package. See $(b,opam remove \ --destdir) to revert." Arg.(some dirname) None in let install global_options build_options add_to_roots deps_only restore destdir assume_built atoms_or_locals = apply_global_options global_options; apply_build_options build_options; if atoms_or_locals = [] && not restore then `Error (true, "required argument PACKAGES is missing") else OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let pure_atoms = OpamStd.List.filter_map (function `Atom a -> Some a | _ -> None) atoms_or_locals in let atoms_or_locals = if restore then let to_restore = OpamPackage.Set.diff st.installed_roots st.installed in if OpamPackage.Set.is_empty to_restore then OpamConsole.msg "No packages to restore found\n" else OpamConsole.msg "Packages to be restored: %s\n" (OpamPackage.Name.Set.to_string (OpamPackage.names_of_packages to_restore)); atoms_or_locals @ List.map (fun p -> `Atom (OpamSolution.atom_of_package p)) (OpamPackage.Set.elements to_restore) else atoms_or_locals in if atoms_or_locals = [] then `Ok () else let st, atoms = OpamAuxCommands.autopin st ~simulate:deps_only atoms_or_locals in if atoms = [] then (OpamConsole.msg "Nothing to do\n"; OpamStd.Sys.exit_because `Success); let st = OpamClient.install st atoms ~autoupdate:pure_atoms ?add_to_roots ~deps_only ~assume_built in match destdir with | None -> `Ok () | Some dest -> let packages = OpamFormula.packages_of_atoms st.installed atoms in OpamAuxCommands.copy_files_to_destdir st dest packages; `Ok () in Term.ret Term.(const install $global_options $build_options $add_to_roots $deps_only $restore $destdir $assume_built $atom_or_local_list), term_info "install" ~doc ~man (* REMOVE *) let remove_doc = "Remove a list of packages." let remove = let doc = remove_doc in let man = [ `S "DESCRIPTION"; `P "This command uninstalls one or more packages currently \ installed in the currently selected compiler switch. To remove packages \ installed in another compiler, you need to switch compilers using \ $(b,opam switch) or use the $(b,--switch) flag. This command is the \ inverse of $(b,opam-install)."; `P "If a directory name is specified as package, packages pinned to that \ directory are both unpinned and removed."; `S "ARGUMENTS"; `S "OPTIONS"; `S OpamArg.build_option_section; ] in let autoremove = mk_flag ["a";"auto-remove"] "Remove all the packages which have not been explicitly installed and \ which are not necessary anymore. It is possible to prevent the removal \ of an already-installed package by running $(b,opam install \ --set-root). This flag can also be set using the $(b,\\$OPAMAUTOREMOVE) \ configuration variable." in let force = mk_flag ["force"] "Execute the remove commands of given packages directly, even if they are \ not considered installed by opam." in let destdir = mk_opt ["destdir"] "DIR" "Instead of uninstalling the packages, reverts the action of $(b,opam \ install --destdir): remove files corresponding to what the listed \ packages installed to the current switch from the given $(i,DIR). Note \ that the package needs to still be installed to the same version that \ was used for $(b,install --destdir) for this to work reliably. The \ packages are not removed from the current opam switch when this is \ specified." Arg.(some dirname) None in let remove global_options build_options autoremove force destdir atom_locs = apply_global_options global_options; apply_build_options build_options; OpamGlobalState.with_ `Lock_none @@ fun gt -> match destdir with | Some d -> OpamSwitchState.with_ `Lock_none gt @@ fun st -> let atoms = OpamAuxCommands.resolve_locals_pinned st atom_locs in let packages = OpamFormula.packages_of_atoms st.installed atoms in let uninst = List.filter (fun (name, _) -> not (OpamPackage.has_name packages name)) atoms in if uninst <> [] then OpamConsole.warning "Can't remove the following packages from the given destdir, they \ need to be installed in opam: %s" (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom uninst); OpamAuxCommands.remove_files_from_destdir st d packages | None -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let pure_atoms, pin_atoms = List.partition (function `Atom _ -> true | _ -> false) atom_locs in let pin_atoms = OpamAuxCommands.resolve_locals_pinned st pin_atoms in let st = if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) then st else OpamPinCommand.unpin st (List.map fst pin_atoms) in let atoms = List.map (function `Atom a -> a | _ -> assert false) pure_atoms @ pin_atoms in ignore @@ OpamClient.remove st ~autoremove ~force atoms in Term.(const remove $global_options $build_options $autoremove $force $destdir $atom_or_dir_list), term_info "remove" ~doc ~man (* REINSTALL *) let reinstall = let doc = "Reinstall a list of packages." in let man = [ `S "DESCRIPTION"; `P "This command removes the given packages and the ones that depend on \ them, and reinstalls the same versions. Without arguments, assume \ $(b,--pending) and reinstall any package with upstream changes."; `P "If a directory is specified as argument, anything that is pinned to \ that directory is selected for reinstall."; `S "ARGUMENTS"; `S "OPTIONS"; `S OpamArg.build_option_section; ] in let cmd = Arg.(value & vflag `Default [ `Pending, info ["pending"] ~doc:"Perform pending reinstallations, i.e. reinstallations of \ packages that have changed since installed"; `List_pending, info ["list-pending"] ~doc:"List packages that have been changed since installed and are \ marked for reinstallation"; `Forget_pending, info ["forget-pending"] ~doc:"Forget about pending reinstallations of listed packages. This \ implies making opam assume that your packages were installed \ with a newer version of their metadata, so only use this if \ you know what you are doing, and the actual changes you are \ overriding." ]) in let reinstall global_options build_options assume_built atoms_locs cmd = apply_global_options global_options; apply_build_options build_options; OpamGlobalState.with_ `Lock_none @@ fun gt -> match cmd, atoms_locs with | `Default, (_::_ as atom_locs) -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> ignore @@ OpamClient.reinstall st ~assume_built (OpamAuxCommands.resolve_locals_pinned st atom_locs); `Ok () | `Pending, [] | `Default, [] -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let atoms = OpamSolution.eq_atoms_of_packages st.reinstall in ignore @@ OpamClient.reinstall st atoms; `Ok () | `List_pending, [] -> OpamSwitchState.with_ `Lock_none gt @@ fun st -> OpamListCommand.display st { OpamListCommand.default_package_listing_format with OpamListCommand. columns = [OpamListCommand.Package]; short = true; header = false; order = `Dependency; } st.reinstall; `Ok () | `Forget_pending, atom_locs -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let atoms = OpamAuxCommands.resolve_locals_pinned st atom_locs in let to_forget = match atoms with | [] -> st.reinstall | atoms -> OpamFormula.packages_of_atoms st.reinstall atoms in OpamPackage.Set.iter (fun nv -> try let installed = OpamPackage.Map.find nv st.installed_opams in let upstream = OpamPackage.Map.find nv st.opams in if not (OpamFile.OPAM.effectively_equal installed upstream) && OpamConsole.confirm "Metadata of %s were updated. Force-update, without performing \ the reinstallation?" (OpamPackage.to_string nv) then OpamSwitchAction.install_metadata st nv with Not_found -> ()) to_forget; let reinstall = OpamPackage.Set.Op.(st.reinstall -- to_forget) in ignore @@ OpamSwitchAction.update_switch_state ~reinstall st; `Ok () | _, _::_ -> `Error (true, "Package arguments not allowed with this option") in Term.(ret (const reinstall $global_options $build_options $assume_built $atom_or_dir_list $cmd)), term_info "reinstall" ~doc ~man (* UPDATE *) let update_doc = "Update the list of available packages." let update = let doc = update_doc in let man = [ `S "DESCRIPTION"; `P "Update the package definitions. This fetches the newest version of the \ repositories configured through $(b, opam repository), and the sources \ of installed development packages and packages pinned in the current \ switch. To use the updated sources and definitions, use \ $(b,opam upgrade)."; ] in let repos_only = mk_flag ["R"; "repositories"] "Update repositories (skipping development packages unless \ $(b,--development) is also specified)." in let dev_only = mk_flag ["development"] "Update development packages (skipping repositories unless \ $(b,--repositories) is also specified)." in let upgrade = mk_flag ["u";"upgrade"] "Automatically run $(b,opam upgrade) after the update." in let name_list = arg_list "NAMES" "List of repository or development package names to update." Arg.string in let all = mk_flag ["a"; "all"] "Update all configured repositories, not only what is set in the current \ switch" in let check = mk_flag ["check"] "Do the update, then return with code 0 if there were any upstream \ changes, 1 if there were none. Repositories or development packages \ that failed to update are considered without changes. With \ $(b,--upgrade), behaves like $(b,opam upgrade --check), that is, \ returns 0 only if there are currently availbale updates." in let update global_options jobs names repos_only dev_only all check upgrade = apply_global_options global_options; OpamStateConfig.update ?jobs:OpamStd.Option.Op.(jobs >>| fun j -> lazy j) (); OpamClientConfig.update (); OpamGlobalState.with_ `Lock_write @@ fun gt -> let success, changed, rt = OpamClient.update gt ~repos_only:(repos_only && not dev_only) ~dev_only:(dev_only && not repos_only) ~all names in if upgrade then OpamSwitchState.with_ `Lock_write gt ~rt @@ fun st -> OpamConsole.msg "\n"; ignore @@ OpamClient.upgrade st ~check ~all:true [] else if check then OpamStd.Sys.exit_because (if changed then `Success else `False) else if changed then OpamConsole.msg "Now run 'opam upgrade' to apply any package updates.\n"; if not success then OpamStd.Sys.exit_because `Sync_error in Term.(const update $global_options $jobs_flag $name_list $repos_only $dev_only $all $check $upgrade), term_info "update" ~doc ~man (* UPGRADE *) let upgrade_doc = "Upgrade the installed package to latest version." let upgrade = let doc = upgrade_doc in let man = [ `S "DESCRIPTION"; `P "This command upgrades the installed packages to their latest available \ versions. More precisely, this command calls the dependency solver to \ find a consistent state where $(i,most) of the installed packages are \ upgraded to their latest versions."; `P "If a directory is specified as argument, anything that is pinned to \ that directory is selected for upgrade."; `S "ARGUMENTS"; `S "OPTIONS"; `S OpamArg.build_option_section; ] in let fixup = mk_flag ["fixup"] "Recover from a broken state (eg. missing dependencies, two conflicting \ packages installed together...)." in let check = mk_flag ["check"] "Don't run the upgrade: just check if anything could be upgraded. \ Returns 0 if that is the case, 1 if there is nothing that can be \ upgraded." in let all = mk_flag ["a";"all"] "Run an upgrade of all installed packages. This is the default if \ $(i,PACKAGES) was not specified, and can be useful with $(i,PACKAGES) \ to upgrade while ensuring that some packages get or remain installed." in let upgrade global_options build_options fixup check all atom_locs = apply_global_options global_options; apply_build_options build_options; let all = all || atom_locs = [] in OpamGlobalState.with_ `Lock_none @@ fun gt -> if fixup then if atom_locs <> [] || check then `Error (true, Printf.sprintf "--fixup doesn't allow extra arguments") else OpamSwitchState.with_ `Lock_write gt @@ fun st -> ignore @@ OpamClient.fixup st; `Ok () else OpamSwitchState.with_ `Lock_write gt @@ fun st -> let atoms = OpamAuxCommands.resolve_locals_pinned st atom_locs in ignore @@ OpamClient.upgrade st ~check ~all atoms; `Ok () in Term.(ret (const upgrade $global_options $build_options $fixup $check $all $atom_or_dir_list)), term_info "upgrade" ~doc ~man (* REPOSITORY *) let repository_doc = "Manage opam repositories." let repository = let doc = repository_doc in let scope_section = "SCOPE SPECIFICATION OPTIONS" in let commands = [ "add", `add, ["NAME"; "[ADDRESS]"; "[QUORUM]"; "[FINGERPRINTS]"], "Adds under $(i,NAME) the repository at address $(i,ADDRESS) to the list \ of configured repositories, if not already registered, and sets this \ repository for use in the current switch (or the specified scope). \ $(i,ADDRESS) is required if the repository name is not already \ registered, and is otherwise an error if different from the registered \ address. The quorum is a positive integer that determines the validation \ threshold for signed repositories, with fingerprints the trust anchors \ for said validation."; " ", `add, [], (* using an unbreakable space here will indent the text paragraph at the level of the previous labelled paragraph, which is what we want for our note. *) "$(b,Note:) By default, the repository is only added to the current \ switch. To add a switch to other repositories, you need to use the \ $(b,--all) or $(b,--set-default) options (see below). If you want to \ enable a repository only to install of of its switches, you may be \ looking for $(b,opam switch create --repositories=REPOS)."; "remove", `remove, ["NAME..."], "Unselects the given repositories so that they will not be used to get \ package definitions anymore. With $(b,--all), makes opam forget about \ these repositories completely."; "set-repos", `set_repos, ["NAME..."], "Explicitly selects the list of repositories to look up package \ definitions from, in the specified priority order (overriding previous \ selection and ranks), according to the specified scope."; "set-url", `set_url, ["NAME"; "ADDRESS"; "[QUORUM]"; "[FINGERPRINTS]"], "Updates the URL and trust anchors associated with a given repository \ name. Note that if you don't specify $(i,[QUORUM]) and \ $(i,[FINGERPRINTS]), any previous settings will be erased."; "list", `list, [], "Lists the currently selected repositories in priority order from rank 1. \ With $(b,--all), lists all configured repositories and the switches where \ they are active."; "priority", `priority, ["NAME"; "RANK"], "Synonym to $(b,add NAME --rank RANK)"; ] in let man = [ `S "DESCRIPTION"; `P "This command is used to manage package repositories. Repositories can \ be registered through subcommands $(b,add), $(b,remove) and \ $(b,set-url), and are updated from their URLs using $(b,opam update). \ Their names are global for all switches, and each switch has its own \ selection of repositories where it gets package definitions from."; `P ("Main commands $(b,add), $(b,remove) and $(b,set-repos) act only on \ the current switch, unless differently specified using options \ explained in $(b,"^scope_section^")."); `P "Without a subcommand, or with the subcommand $(b,list), lists selected \ repositories, or all configured repositories with $(b,--all)."; ] @ mk_subdoc ~defaults:["","list"] commands @ [ `S scope_section; `P "These flags allow one to choose which selections are changed by $(b,add), \ $(b,remove), $(b,set-repos). If no flag in this section is specified \ the updated selections default to the current switch. Multiple scopes \ can be selected, e.g. $(b,--this-switch --set-default)."; `S "OPTIONS"; ] in let command, params = mk_subcommands commands in let scope = let scope_info ?docv flags doc = Arg.info ~docs:scope_section ~doc ?docv flags in let flags = Arg.vflag_all [] [ `No_selection, scope_info ["dont-select"] "Don't update any selections"; `Current_switch, scope_info ["this-switch"] "Act on the selections for the current switch (this is the default)"; `Default, scope_info ["set-default"] "Act on the default repository selection that is used for newly \ created switches"; `All, scope_info ["all-switches";"a"] "Act on the selections of all configured switches"; ] in let switches = Arg.opt Arg.(list string) [] (scope_info ["on-switches"] ~docv:"SWITCHES" "Act on the selections of the given list of switches") in let switches = Term.(const (List.map (fun s -> `Switch (OpamSwitch.of_string s))) $ Arg.value switches) in Term.(const (fun l1 l2 -> match l1@l2 with [] -> [`Current_switch] | l -> l) $ Arg.value flags $ switches) in let rank = Arg.(value & opt int 1 & info ~docv:"RANK" ["rank"] ~doc: "Set the rank of the repository in the list of configured \ repositories. Package definitions are looked in the repositories \ in increasing rank order, therefore 1 is the highest priority. \ Negative ints can be used to select from the lowest priority, -1 \ being last. $(b,set-repos) can otherwise be used to explicitly \ set the repository list at once.") in let repository global_options command kind short scope rank params = apply_global_options global_options; let global = List.mem `Default scope in let command, params, rank = match command, params, rank with | Some `priority, [name; rank], 1 -> (try Some `add, [name], int_of_string rank with Failure _ -> OpamConsole.error_and_exit `Bad_arguments "Invalid rank specification %S" rank) | Some `priority, [], rank -> Some `add, [], rank | command, params, rank -> command, params, rank in let update_repos new_repo repos = let rank = if rank < 0 then List.length repos + rank + 1 else rank - 1 in OpamStd.List.insert_at rank new_repo (List.filter (( <> ) new_repo ) repos) in let check_for_repos rt names err = match List.filter (fun n -> not (OpamRepositoryName.Map.mem n rt.repositories)) names with [] -> () | l -> err (OpamStd.List.concat_map " " OpamRepositoryName.to_string l) in OpamGlobalState.with_ `Lock_none @@ fun gt -> let all_switches = OpamFile.Config.installed_switches gt.config in let switches = let all = OpamSwitch.Set.of_list all_switches in List.fold_left (fun acc -> function | `Default | `No_selection -> acc | `All -> all_switches | `Switch sw -> if not (OpamSwitch.Set.mem sw all) && not (OpamSwitch.is_external sw) then OpamConsole.error_and_exit `Not_found "No switch %s found" (OpamSwitch.to_string sw) else if List.mem sw acc then acc else acc @ [sw] | `Current_switch -> match OpamStateConfig.get_switch_opt () with | None -> OpamConsole.warning "No switch is currently set, perhaps you meant \ '--set-default'?"; acc | Some sw -> if List.mem sw acc then acc else acc @ [sw]) [] scope in match command, params with | Some `add, name :: url :: security -> let name = OpamRepositoryName.of_string name in let backend = match kind with | Some _ -> kind | None -> OpamUrl.guess_version_control url in let url = OpamUrl.parse ?backend url in let trust_anchors = match security with | [] -> None | quorum::fingerprints -> try let quorum = int_of_string quorum in if quorum < 0 then failwith "neg" else Some { quorum; fingerprints } with Failure _ -> failwith ("Invalid quorum: "^quorum) in OpamRepositoryState.with_ `Lock_write gt (fun rt -> let rt = OpamRepositoryCommand.add rt name url trust_anchors in let failed, rt = OpamRepositoryCommand.update_with_auto_upgrade rt [name] in if failed <> [] then (let _rt = OpamRepositoryCommand.remove rt name in OpamConsole.error_and_exit `Sync_error "Initial repository fetch failed")); let _gt = OpamRepositoryCommand.update_selection gt ~global ~switches (update_repos name) in if scope = [`Current_switch] then OpamConsole.note "Repository %s has been added to the selections of switch %s \ only.\n\ Run `opam repository add %s --all-switches|--set-default' to use it \ in all existing switches, or in newly created switches, \ respectively.\n" (OpamRepositoryName.to_string name) (OpamSwitch.to_string (OpamStateConfig.get_switch ())) (OpamRepositoryName.to_string name); `Ok () | Some `remove, names -> let names = List.map OpamRepositoryName.of_string names in let rm = List.filter (fun n -> not (List.mem n names)) in let full_wipe = List.mem `All scope in let global = global || full_wipe in let gt = OpamRepositoryCommand.update_selection gt ~global ~switches:switches rm in if full_wipe then OpamRepositoryState.with_ `Lock_write gt @@ fun rt -> check_for_repos rt names (OpamConsole.warning "No configured repositories by these names found: %s"); let _rt = List.fold_left OpamRepositoryCommand.remove rt names in () else if scope = [`Current_switch] then OpamConsole.msg "Repositories removed from the selections of switch %s. \ Use '--all' to forget about them altogether.\n" (OpamSwitch.to_string (OpamStateConfig.get_switch ())); `Ok () | Some `add, [name] -> let name = OpamRepositoryName.of_string name in OpamRepositoryState.with_ `Lock_none gt (fun rt -> check_for_repos rt [name] (OpamConsole.error_and_exit `Not_found "No configured repository '%s' found, you must specify an URL")); let _gt = OpamRepositoryCommand.update_selection gt ~global ~switches (update_repos name) in `Ok () | Some `set_url, (name :: url :: security) -> let name = OpamRepositoryName.of_string name in let backend = match kind with | Some _ -> kind | None -> OpamUrl.guess_version_control url in let url = OpamUrl.parse ?backend url in let trust_anchors = match security with | [] -> None | quorum::fingerprints -> try let quorum = int_of_string quorum in if quorum < 0 then failwith "neg" else Some { quorum; fingerprints } with Failure _ -> failwith ("Invalid quorum: "^quorum) in OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamRepositoryState.with_ `Lock_write gt @@ fun rt -> let rt = OpamRepositoryCommand.set_url rt name url trust_anchors in let _failed, _rt = OpamRepositoryCommand.update_with_auto_upgrade rt [name] in `Ok () | Some `set_repos, names -> let names = List.map OpamRepositoryName.of_string names in OpamGlobalState.with_ `Lock_none @@ fun gt -> let repos = OpamFile.Repos_config.safe_read (OpamPath.repos_config gt.root) in let not_found = List.filter (fun r -> not (OpamRepositoryName.Map.mem r repos)) names in if not_found = [] then let _gt = OpamRepositoryCommand.update_selection gt ~global ~switches (fun _ -> names) in `Ok () else OpamConsole.error_and_exit `Bad_arguments "No configured repositories by these names found: %s" (OpamStd.List.concat_map " " OpamRepositoryName.to_string not_found) | (None | Some `list), [] -> OpamRepositoryState.with_ `Lock_none gt @@ fun rt -> if List.mem `All scope then OpamRepositoryCommand.list_all rt ~short; let global = List.mem `Default scope in let switches = if scope = [] || List.exists (function `Current_switch | `Switch _ -> true | _ -> false) scope then switches else [] in if not short && scope = [`Current_switch] then OpamConsole.note "These are the repositories in use by the current switch. Use \ '--all' to see all configured repositories."; OpamRepositoryCommand.list rt ~global ~switches ~short; `Ok () | command, params -> bad_subcommand commands ("repository", command, params) in Term.ret Term.(const repository $global_options $command $repo_kind_flag $print_short_flag $scope $rank $params), term_info "repository" ~doc ~man (* SWITCH *) (* From a list of strings (either "repo_name" or "repo_name=URL"), configure the repos with URLs if possible, and return the updated repos_state and selection of repositories *) let get_repos_rt gt repos = OpamRepositoryState.with_ `Lock_none gt @@ fun rt -> match repos with | None -> None, rt | Some repos -> let repos = List.map (fun s -> match OpamStd.String.cut_at s '=' with | None -> OpamRepositoryName.of_string s, None | Some (name, url) -> OpamRepositoryName.of_string name, Some url) repos in let new_defs = OpamStd.List.filter_map (function | (_, None) -> None | (n, Some u) -> Some (n, OpamUrl.of_string u)) repos in if List.for_all (fun (name,url) -> match OpamRepositoryName.Map.find_opt name rt.repositories with | Some r -> r.repo_url = url | None -> false) new_defs then Some (List.map fst repos), rt else OpamRepositoryState.with_write_lock rt @@ fun rt -> let rt = List.fold_left (fun rt (name, url) -> OpamConsole.msg "Creating repository %s...\n" (OpamRepositoryName.to_string name); OpamRepositoryCommand.add rt name url None) rt new_defs in let failed, rt = OpamRepositoryCommand.update_with_auto_upgrade rt (List.map fst new_defs) in if failed <> [] then let _rt = List.fold_left OpamRepositoryCommand.remove rt failed in OpamConsole.error_and_exit `Sync_error "Initial fetch of these repositories failed: %s" (OpamStd.List.concat_map ", " OpamRepositoryName.to_string failed) else Some (List.map fst repos), rt let switch_doc = "Manage multiple installation prefixes." let switch = let doc = switch_doc in let commands = [ "create", `install, ["SWITCH"; "[COMPILER]"], "Create a new switch, and install the given compiler there. $(i,SWITCH) \ can be a plain name, or a directory, absolute or relative, in which case \ a local switch is created below the given directory. $(i,COMPILER), if \ omitted, defaults to $(i,SWITCH) if it is a plain name, unless \ $(b,--packages) or $(b,--empty) is specified. When creating a local \ switch, and none of these options are present, the compiler is chosen \ according to the configuration default (see opam-init(1)). If the chosen \ directory contains package definitions, a compatible compiler is searched \ within the default selection, and the packages will automatically get \ installed."; "set", `set, ["SWITCH"], "Set the currently active switch, among the installed switches."; "remove", `remove, ["SWITCH"], "Remove the given switch from disk."; "export", `export, ["FILE"], "Save the current switch state to a file. If $(b,--full) is specified, it \ includes the metadata of all installed packages"; "import", `import, ["FILE"], "Import a saved switch state. If $(b,--switch) is specified and doesn't \ point to an existing switch, the switch will be created for the import."; "reinstall", `reinstall, ["[SWITCH]"], "Reinstall the given compiler switch and all its packages."; "list", `list, [], "Lists installed switches."; "list-available", `list_available, ["[PATTERN]"], "Lists base packages that can be used to create a new switch, i.e. \ packages with the $(i,compiler) flag set. If no pattern is supplied, \ all versions are shown."; "show", `current, [], "Prints the name of the current switch."; "set-base", `set_compiler, ["PACKAGES"], "Sets the packages forming the immutable base for the selected switch, \ overriding the current setting."; "set-description", `set_description, ["STRING"], "Sets the description for the selected switch"; "link", `link, ["SWITCH";"[DIR]"], "Sets a local alias for a given switch, so that the switch gets \ automatically selected whenever in that directory or a descendant."; "install", `install, ["SWITCH"], "Deprecated alias for 'create'." ] in let man = [ `S "DESCRIPTION"; `P "This command is used to manage \"switches\", which are independent \ installation prefixes with their own compiler and sets of installed \ and pinned packages. This is typically useful to have different \ versions of the compiler available at once."; `P "Use $(b,opam switch create) to create a new switch, and $(b,opam \ switch set) to set the currently active switch. Without argument, \ lists installed switches, with one switch argument, defaults to \ $(b,set)."; `P ("Switch handles $(i,SWITCH) can be either a plain name, for switches \ that will be held inside $(i,~/.opam), or a directory name, which in \ that case is the directory where the switch prefix will be installed, as " ^ OpamSwitch.external_dirname ^ ". Opam will automatically select a switch by that name found in the \ current directory or its parents, unless $(i,OPAMSWITCH) is set or \ $(b,--switch) is specified. When creating a directory switch, if \ package definitions are found locally, the user is automatically \ prompted to install them after the switch is created unless \ $(b,--no-install) is specified."); `P "$(b,opam switch set) sets the default switch globally, but it is also \ possible to select a switch in a given shell session, using the \ environment. For that, use $(i,eval \\$(opam env \ --switch=SWITCH --set-switch\\))."; ] @ mk_subdoc ~defaults:["","list";"SWITCH","set"] commands @ [`S "OPTIONS"] @ [`S OpamArg.build_option_section] in let command, params = mk_subcommands_with_default commands in let no_switch = mk_flag ["no-switch"] "Don't automatically select newly installed switches." in let packages = mk_opt ["packages"] "PACKAGES" "When installing a switch, explicitly define the set of packages to set \ as the compiler." Arg.(some (list atom)) None in let empty = mk_flag ["empty"] "Allow creating an empty (without compiler) switch." in let repos = mk_opt ["repositories"] "REPOS" "When creating a new switch, use the given selection of repositories \ instead of the default. $(i,REPOS) should be a comma-separated list of \ either already registered repository names (configured through e.g. \ $(i,opam repository add --dont-select)), or $(b,NAME)=$(b,URL) \ bindings, in which case $(b,NAME) should not be registered already to a \ different URL, and the new repository will be registered. See $(i,opam \ repository) for more details. This option also affects \ $(i,list-available)." Arg.(some (list string)) None in let descr = mk_opt ["description"] "STRING" "Attach the given description to a switch when creating it. Use the \ $(i,set-description) subcommand to modify the description of an \ existing switch." Arg.(some string) None in let full = mk_flag ["full"] "When exporting, include the metadata of all installed packages, \ allowing to re-import even if they don't exist in the repositories (the \ default is to include only the metadata of pinned packages)." in let no_install = mk_flag ["no-install"] "When creating a local switch, don't look for any local package \ definitions to install." in let deps_only = mk_flag ["deps-only"] "When creating a local switch in a project directory (i.e. a directory \ containing opam package definitions), install the dependencies of the \ project but not the project itself." in (* Deprecated options *) let d_alias_of = mk_opt ["A";"alias-of"] "COMP" "This option is deprecated." Arg.(some string) None in let d_no_autoinstall = mk_flag ["no-autoinstall"] "This option is deprecated." in let switch global_options build_options command print_short no_switch packages empty descr full no_install deps_only repos d_alias_of d_no_autoinstall params = OpamArg.deprecated_option d_alias_of None "alias-of" (Some "opam switch "); OpamArg.deprecated_option d_no_autoinstall false "no-autoinstall" None; apply_global_options global_options; apply_build_options build_options; let packages = match packages, empty with | None, true -> Some [] | Some packages, true when packages <> [] -> OpamConsole.error_and_exit `Bad_arguments "Options --packages and --empty may not be specified at the same time" | packages, _ -> packages in let compiler_packages rt ?repos switch compiler_opt = match packages, compiler_opt, OpamSwitch.is_external switch with | None, None, false -> OpamSwitchCommand.guess_compiler_package ?repos rt (OpamSwitch.to_string switch), false | None, None, true -> OpamAuxCommands.get_compatible_compiler ?repos rt (OpamFilename.dirname_dir (OpamSwitch.get_root rt.repos_global.root switch)) | _ -> OpamStd.Option.Op.( ((compiler_opt >>| OpamSwitchCommand.guess_compiler_package ?repos rt) +! []) @ packages +! []), false in let param_compiler = function | [] -> None | [comp] -> Some comp | args -> OpamConsole.error_and_exit `Bad_arguments "Invalid extra arguments %s" (String.concat " " args) in match command, params with | None , [] | Some `list, [] -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchCommand.list gt ~print_short; `Ok () | Some `list_available, pattlist -> OpamGlobalState.with_ `Lock_none @@ fun gt -> let repos, rt = get_repos_rt gt repos in let compilers = OpamSwitchCommand.get_compiler_packages ?repos rt in let st = OpamSwitchState.load_virtual ?repos_list:repos gt rt in OpamConsole.msg "# Listing available compilers from repositories: %s\n" (OpamStd.List.concat_map ", " OpamRepositoryName.to_string (OpamStd.Option.default (OpamGlobalState.repos_list gt) repos)); let filters = List.map (fun patt -> OpamListCommand.Pattern ({ OpamListCommand.default_pattern_selector with OpamListCommand.fields = ["name"; "version"] }, patt)) pattlist in let compilers = OpamListCommand.filter ~base:compilers st (OpamFormula.ands (List.map (fun f -> OpamFormula.Atom f) filters)) in let format = if print_short then OpamListCommand.([ Package ]) else OpamListCommand.([ Name; Version; Synopsis; ]) in let order nv1 nv2 = if nv1.version = nv2.version then OpamPackage.Name.compare nv1.name nv2.name else OpamPackage.Version.compare nv1.version nv2.version in OpamListCommand.display st {OpamListCommand.default_package_listing_format with OpamListCommand. short = print_short; header = not print_short; columns = format; all_versions = true; order = `Custom order; } compilers; `Ok () | Some `install, switch_arg::params -> OpamGlobalState.with_ `Lock_write @@ fun gt -> let repos, rt = get_repos_rt gt repos in let switch = OpamSwitch.of_string switch_arg in let packages, local_compiler = compiler_packages rt ?repos switch (param_compiler params) in let _gt, st = OpamSwitchCommand.install gt ~rt ?synopsis:descr ?repos ~update_config:(not no_switch) ~packages ~local_compiler switch in let st = if not no_install && not empty && OpamSwitch.is_external switch && not local_compiler then let st, atoms = OpamAuxCommands.autopin st ~simulate:deps_only ~quiet:true [`Dirname (OpamFilename.Dir.of_string switch_arg)] in OpamClient.install st atoms ~autoupdate:[] ~add_to_roots:true ~deps_only else st in ignore (OpamSwitchState.unlock st); `Ok () | Some `export, [filename] -> OpamSwitchCommand.export ~full (if filename = "-" then None else Some (OpamFile.make (OpamFilename.of_string filename))); `Ok () | Some `import, [filename] -> OpamGlobalState.with_ `Lock_none @@ fun gt -> let switch = OpamStateConfig.get_switch () in let is_new_switch = not (OpamGlobalState.switch_exists gt switch) in let gt, rt = if is_new_switch then let repos, rt = get_repos_rt gt repos in let (), gt = OpamGlobalState.with_write_lock gt @@ fun gt -> (), OpamSwitchAction.create_empty_switch gt ?repos switch in gt, rt else (if repos <> None then OpamConsole.warning "Switch exists, '--repositories' argument ignored"; gt, OpamRepositoryState.load `Lock_none gt) in OpamSwitchState.with_ `Lock_write gt ~rt ~switch @@ fun st -> let _st = try OpamSwitchCommand.import st (if filename = "-" then None else Some (OpamFile.make (OpamFilename.of_string filename))) with e -> if is_new_switch then OpamConsole.warning "Switch %s may have been left partially installed" (OpamSwitch.to_string switch); raise e in `Ok () | Some `remove, switches -> OpamGlobalState.with_ `Lock_write @@ fun gt -> let _gt = List.fold_left (fun gt switch -> let opam_dir = OpamFilename.Op.( OpamFilename.Dir.of_string switch / OpamSwitch.external_dirname ) in if OpamFilename.is_symlink_dir opam_dir then (OpamFilename.rmdir opam_dir; gt) else OpamSwitchCommand.remove gt (OpamSwitch.of_string switch)) gt switches in `Ok () | Some `reinstall, switch -> let switch = match switch with | [sw] -> OpamSwitch.of_string sw | [] -> OpamStateConfig.get_switch () | _ -> OpamConsole.error_and_exit `Bad_arguments "Only one switch argument is supported" in OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt ~switch @@ fun st -> let _st = OpamSwitchCommand.reinstall st in `Ok () | Some `current, [] -> OpamSwitchCommand.show (); `Ok () | Some `set, [switch] | Some `default switch, [] -> OpamGlobalState.with_ `Lock_write @@ fun gt -> let switch_name = OpamSwitch.of_string switch in OpamSwitchCommand.switch `Lock_none gt switch_name |> ignore; `Ok () | Some `set_compiler, packages -> (try let parse_namev s = match fst OpamArg.package s with | `Ok (name, version_opt) -> name, version_opt | `Error e -> failwith e in let namesv = List.map parse_namev packages in OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let _st = OpamSwitchCommand.set_compiler st namesv in `Ok () with Failure e -> `Error (false, e)) | Some `link, args -> (try let switch, dir = match args with | switch::dir::[] -> OpamSwitch.of_string switch, OpamFilename.Dir.of_string dir | switch::[] -> OpamSwitch.of_string switch, OpamFilename.cwd () | [] -> failwith "Missing SWITCH argument" | _::_::_::_ -> failwith "Extra argument" in let open OpamFilename.Op in let linkname = dir / OpamSwitch.external_dirname in OpamGlobalState.with_ `Lock_none @@ fun gt -> if not (OpamGlobalState.switch_exists gt switch) then OpamConsole.error_and_exit `Not_found "The switch %s was not found" (OpamSwitch.to_string switch); if OpamFilename.is_symlink_dir linkname then OpamFilename.rmdir linkname; if OpamFilename.exists_dir linkname then OpamConsole.error_and_exit `Bad_arguments "There already is a local switch in %s. Remove it and try again." (OpamFilename.Dir.to_string dir); if OpamFilename.exists (dir // OpamSwitch.external_dirname) then OpamConsole.error_and_exit `Bad_arguments "There is a '%s' file in the way. Remove it and try again." (OpamFilename.Dir.to_string linkname); OpamFilename.link_dir ~link:linkname ~target:(OpamPath.Switch.root gt.root switch); OpamConsole.msg "Directory %s set to use switch %s.\n\ Just remove %s to unlink.\n" (OpamConsole.colorise `cyan (OpamFilename.Dir.to_string dir)) (OpamConsole.colorise `bold (OpamSwitch.to_string switch)) (OpamConsole.colorise `cyan (OpamFilename.Dir.to_string linkname)); `Ok () with Failure e -> `Error (true, e)) | Some `set_description, text -> let synopsis = String.concat " " text in OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let config = { st.switch_config with OpamFile.Switch_config.synopsis } in OpamSwitchAction.install_switch_config gt.root st.switch config; `Ok () | command, params -> bad_subcommand commands ("switch", command, params) in Term.(ret (const switch $global_options $build_options $command $print_short_flag $no_switch $packages $empty $descr $full $no_install $deps_only $repos $d_alias_of $d_no_autoinstall $params)), term_info "switch" ~doc ~man (* PIN *) let pin_doc = "Pin a given package to a specific version or source." let pin ?(unpin_only=false) () = let doc = pin_doc in let commands = [ "list", `list, [], "Lists pinned packages."; "add", `add, ["PACKAGE"; "TARGET"], "Pins package $(i,PACKAGE) to $(i,TARGET), which may be a version, a path, \ or a URL.\n\ $(i,PACKAGE) can be omitted if $(i,TARGET) contains one or more \ package descriptions. $(i,TARGET) can be replaced by \ $(b,--dev-repo) if a package by that name is already known. If \ $(i,TARGET) is $(b,-), the package is pinned as a virtual package, \ without any source. opam will infer the kind of pinning from the format \ (and contents, if local) of $(i,TARGET), Use $(b,--kind) or an explicit \ URL to disable that behaviour.\n\ Pins to version control systems may target a specific branch or commit \ using $(b,#branch) e.g. $(b,git://host/me/pkg#testing).\n\ If $(i,PACKAGE) is not a known package name, a new package by that name \ will be locally created.\n\ For source pinnings, the package version may be specified by using the \ format $(i,NAME).$(i,VERSION) for $(i,PACKAGE), in the source opam file, \ or with $(b,edit)."; "remove", `remove, ["NAMES...|TARGET"], "Unpins packages $(i,NAMES), restoring their definition from the \ repository, if any. With a $(i,TARGET), unpins everything that is \ currently pinned to that target."; "edit", `edit, ["NAME"], "Opens an editor giving you the opportunity to change the package \ definition that opam will locally use for package $(i,NAME), including \ its version and source URL. Using the format $(i,NAME.VERSION) will \ update the version in the opam file in advance of editing, without \ changing the actual target. The chosen editor is determined from \ environment variables $(b,OPAM_EDITOR), $(b,VISUAL) or $(b,EDITOR), in \ order."; ] in let man = [ `S "DESCRIPTION"; `P "This command allows local customisation of the packages in a given \ switch. A pinning can either just enforce a given version, or provide \ a local, editable version of the definition of the package. It is also \ possible to create a new package just by pinning a non-existing \ package name."; `P "Any customisation is available through the $(i,edit) subcommand, but \ the command-line gives facility for altering the source URL of the \ package, since it is the most common use: $(i,opam pin add PKG URL) \ modifies package $(i,PKG) to fetch its source from $(i,URL). If a \ package definition is found in the package's source tree, it will be \ used locally."; `P "If (or $(i,-)) is specified, the package is pinned without a source \ archive. The package name can be omitted if the target is a directory \ containing one or more valid package definitions (this allows one to do \ e.g. $(i,opam pin add .) from a source directory."; `P "If $(i,PACKAGE) has the form $(i,name.version), the pinned package \ will be considered as version $(i,version) by opam. Beware that this \ doesn't relate with the version of the source actually used for the \ package."; `P "The default subcommand is $(i,list) if there are no further arguments, \ and $(i,add) otherwise if unambiguous."; ] @ mk_subdoc ~defaults:["","list"] commands @ [ `S "OPTIONS"; `S OpamArg.build_option_section; ] in let command, params = if unpin_only then Term.const (Some `remove), Arg.(value & pos_all string [] & Arg.info []) else mk_subcommands_with_default commands in let edit = mk_flag ["e";"edit"] "With $(i,opam pin add), edit the opam file as with `opam pin edit' \ after pinning." in let kind = let main_kinds = [ "version", `version; "path" , `rsync; "http" , `http; "git" , `git; "darcs" , `darcs; "hg" , `hg; "none" , `none; "auto" , `auto; ] in let help = Printf.sprintf "Sets the kind of pinning. Must be one of %s. \ If unset or $(i,auto), is inferred from the format of the target, \ defaulting to the appropriate version control if one is detected in \ the given directory, or to $(i,path) otherwise. $(i,OPAMPINKINDAUTO) \ can be set to \"0\" to disable automatic detection of version control.\ Use $(i,none) to pin without a target (for virtual packages)." (Arg.doc_alts_enum main_kinds) in let doc = Arg.info ~docv:"KIND" ~doc:help ["k";"kind"] in let kinds = main_kinds @ [ "local" , `rsync; "rsync" , `rsync; ] in Arg.(value & opt (some & enum kinds) None & doc) in let no_act = mk_flag ["n";"no-action"] "Just record the new pinning status, and don't prompt for \ (re)installation or removal of affected packages." in let dev_repo = mk_flag ["dev-repo"] "Pin to the upstream package source for the latest \ development version" in let guess_names url k = let from_opam_files dir = OpamStd.List.filter_map (fun (nameopt, f) -> let opam_opt = OpamFile.OPAM.read_opt f in let name = match nameopt with | None -> OpamStd.Option.replace OpamFile.OPAM.name_opt opam_opt | some -> some in OpamStd.Option.map (fun n -> n, opam_opt) name) (OpamPinned.files_in_source dir) in let basename = match OpamStd.String.split (OpamUrl.basename url) '.' with | [] -> OpamConsole.error_and_exit `Bad_arguments "Can not retrieve a path from '%s'" (OpamUrl.to_string url) | b::_ -> b in let found, cleanup = match OpamUrl.local_dir url with | Some d -> from_opam_files d, None | None -> let pin_cache_dir = OpamRepositoryPath.pin_cache url in let cleanup = fun () -> OpamFilename.rmdir @@ OpamRepositoryPath.pin_cache_dir () in try let open OpamProcess.Job.Op in OpamProcess.Job.run @@ OpamRepository.pull_tree ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function | Not_available (_,u) -> OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u | Result _ | Up_to_date _ -> from_opam_files pin_cache_dir, Some cleanup with e -> OpamStd.Exn.finalise e cleanup in let finalise = OpamStd.Option.default (fun () -> ()) cleanup in OpamStd.Exn.finally finalise @@ fun () -> let names_found = match found with | _::_ -> found | [] -> try [OpamPackage.Name.of_string basename, None] with | Failure _ -> OpamConsole.error_and_exit `Bad_arguments "Could not infer a package name from %s, please specify it on the \ command-line, e.g. 'opam pin NAME TARGET'" (OpamUrl.to_string url) in k names_found in let pin_target kind target = let looks_like_version_re = Re.(compile @@ seq [bos; opt @@ char 'v'; digit; rep @@ diff any (set "/\\"); eos]) in let auto () = if target = "-" then `None else if Re.execp looks_like_version_re target then `Version (OpamPackage.Version.of_string target) else let backend = OpamUrl.guess_version_control target in `Source (OpamUrl.parse ?backend ~handle_suffix:true target) in let target = match kind with | Some `version -> `Version (OpamPackage.Version.of_string target) | Some (#OpamUrl.backend as k) -> `Source (OpamUrl.parse ~backend:k target) | Some `none -> `None | Some `auto -> auto () | None when OpamClientConfig.(!r.pin_kind_auto) -> auto () | None -> `Source (OpamUrl.parse ~handle_suffix:false target) in match target with | `Source url -> `Source (OpamAuxCommands.url_with_local_branch url) | _ -> target in let pin global_options build_options kind edit no_act dev_repo print_short command params = apply_global_options global_options; apply_build_options build_options; let action = not no_act in match command, params with | Some `list, [] | None, [] -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_none gt @@ fun st -> OpamClient.PIN.list st ~short:print_short; `Ok () | Some `remove, (_::_ as arg) -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let err, to_unpin = List.fold_left (fun (err, acc) arg -> let as_url = let url = OpamUrl.of_string arg in OpamPackage.Set.filter (fun nv -> match OpamSwitchState.url st nv with | Some u -> let u = OpamFile.URL.url u in OpamUrl.(u.transport = url.transport && u.path = url.path) | None -> false) st.pinned |> OpamPackage.names_of_packages |> OpamPackage.Name.Set.elements in match as_url with | _::_ -> err, as_url @ acc | [] -> match (fst package_name) arg with | `Ok name -> err, name::acc | `Error _ -> OpamConsole.error "No package pinned to this target found, or invalid package \ name: %s" arg; true, acc) (false,[]) arg in if err then OpamStd.Sys.exit_because `Bad_arguments else (ignore @@ OpamClient.PIN.unpin st ~action to_unpin; `Ok ()) | Some `edit, [nv] -> (match (fst package) nv with | `Ok (name, version) -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> ignore @@ OpamClient.PIN.edit st ~action ?version name; `Ok () | `Error e -> `Error (false, e)) | Some `add, [nv] | Some `default nv, [] when dev_repo -> (match (fst package) nv with | `Ok (name,version) -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let name = OpamSolution.fuzzy_name st name in ignore @@ OpamClient.PIN.pin st name ~edit ?version ~action `Dev_upstream; `Ok () | `Error e -> if command = Some `add then `Error (false, e) else bad_subcommand commands ("pin", command, params)) | Some `add, [arg] | Some `default arg, [] -> (match pin_target kind arg with | `None | `Version _ -> let msg = Printf.sprintf "Ambiguous argument %S, if it is the pinning target, \ you must specify a package name first" arg in `Error (true, msg) | `Source url -> guess_names url @@ fun names -> let names = match names with | _::_::_ -> if OpamConsole.confirm "This will pin the following packages: %s. Continue?" (OpamStd.List.concat_map ", " (fst @> OpamPackage.Name.to_string) names) then names else OpamStd.Sys.exit_because `Aborted | _ -> names in OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> let pinned = st.pinned in let st = List.fold_left (fun st (name, opam_opt) -> OpamStd.Option.iter (fun opam -> let opam_localf = OpamPath.Switch.Overlay.tmp_opam st.switch_global.root st.switch name in if not (OpamFilename.exists (OpamFile.filename opam_localf)) then OpamFile.OPAM.write opam_localf opam) opam_opt; try OpamPinCommand.source_pin st name ~edit (Some url) with | OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted | OpamPinCommand.Nothing_to_do -> st) st names in if action then (ignore @@ OpamClient.PIN.post_pin_action st pinned (List.map fst names); `Ok ()) else `Ok ()) | Some `add, [n; target] | Some `default n, [target] -> (match (fst package) n with | `Ok (name,version) -> let pin = pin_target kind target in OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_write gt @@ fun st -> ignore @@ OpamClient.PIN.pin st name ?version ~edit ~action pin; `Ok () | `Error e -> `Error (false, e)) | command, params -> bad_subcommand commands ("pin", command, params) in Term.ret Term.(const pin $global_options $build_options $kind $edit $no_act $dev_repo $print_short_flag $command $params), term_info "pin" ~doc ~man (* SOURCE *) let source_doc = "Get the source of an opam package." let source = let doc = source_doc in let man = [ `S "DESCRIPTION"; `P "Downloads the source for a given package to a local directory \ for development, bug fixing or documentation purposes." ] in let atom = Arg.(required & pos 0 (some atom) None & info ~docv:"PACKAGE" [] ~doc:"A package name with an optional version constraint") in let dev_repo = mk_flag ["dev-repo"] "Get the latest version-controlled source rather than the \ release archive" in let pin = mk_flag ["pin"] "Pin the package to the downloaded source (see `opam pin')." in let dir = mk_opt ["dir"] "DIR" "The directory where to put the source." Arg.(some dirname) None in let source global_options atom dev_repo pin dir = apply_global_options global_options; OpamGlobalState.with_ `Lock_none @@ fun gt -> (* Fixme: this needs a write lock, because it uses the routines that download to opam's shared switch cache. (it's needed anyway when --pin is used) *) OpamSwitchState.with_ `Lock_write gt @@ fun t -> let nv = try OpamPackage.Set.max_elt (OpamPackage.Set.filter (OpamFormula.check atom) t.packages) with Not_found -> OpamConsole.error_and_exit `Not_found "No package matching %s found." (OpamFormula.short_string_of_atom atom) in let dir = match dir with | Some d -> d | None -> let dirname = if dev_repo then OpamPackage.name_to_string nv else OpamPackage.to_string nv in OpamFilename.Op.(OpamFilename.cwd () / dirname) in let open OpamFilename in if exists_dir dir then OpamConsole.error_and_exit `Bad_arguments "Directory %s already exists. Please remove it or use a different one \ (see option `--dir')" (Dir.to_string dir); let opam = OpamSwitchState.opam t nv in if dev_repo then ( match OpamFile.OPAM.dev_repo opam with | None -> OpamConsole.error_and_exit `Not_found "Version-controlled repo for %s unknown \ (\"dev-repo\" field missing from metadata)" (OpamPackage.to_string nv) | Some url -> mkdir dir; match OpamProcess.Job.run (OpamRepository.pull_tree ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) (OpamPackage.to_string nv) dir [] [url]) with | Not_available (_,u) -> OpamConsole.error_and_exit `Sync_error "%s is not available" u | Result _ | Up_to_date _ -> OpamConsole.formatted_msg "Successfully fetched %s development repo to ./%s/\n" (OpamPackage.name_to_string nv) (OpamPackage.name_to_string nv) ) else ( let job = let open OpamProcess.Job.Op in OpamUpdate.download_package_source t nv dir @@+ function | Some (Not_available (_,s)) -> OpamConsole.error_and_exit `Sync_error "Download failed: %s" s | None | Some (Result () | Up_to_date ()) -> OpamAction.prepare_package_source t nv dir @@| function | None -> OpamConsole.formatted_msg "Successfully extracted to %s\n" (Dir.to_string dir) | Some e -> OpamConsole.warning "Some errors extracting to %s: %s\n" (Dir.to_string dir) (Printexc.to_string e) in OpamProcess.Job.run job; if OpamPinned.find_opam_file_in_source nv.name dir = None then let f = if OpamFilename.exists_dir Op.(dir / "opam") then OpamFile.make Op.(dir / "opam" // "opam") else OpamFile.make Op.(dir // "opam") in OpamFile.OPAM.write f (OpamFile.OPAM.with_substs [] @@ OpamFile.OPAM.with_patches [] @@ opam) ); if pin then let backend = if dev_repo then match OpamFile.OPAM.dev_repo opam with | Some {OpamUrl.backend = #OpamUrl.version_control as kind; _} -> kind | _ -> `rsync else `rsync in let target = `Source (OpamUrl.parse ~backend ("file://"^OpamFilename.Dir.to_string dir)) in ignore @@ OpamClient.PIN.pin t nv.name ~version:nv.version target in Term.(const source $global_options $atom $dev_repo $pin $dir), term_info "source" ~doc ~man (* LINT *) let lint_doc = "Checks and validate package description ('opam') files." let lint = let doc = lint_doc in let man = [ `S "DESCRIPTION"; `P "Given an $(i,opam) file, performs several quality checks on it and \ outputs recommendations, warnings or errors on stderr." ] in let files = Arg.(value & pos_all (existing_filename_dirname_or_dash) [] & info ~docv:"FILES" [] ~doc:"Name of the opam files to check, or directory containing \ them. Current directory if unspecified") in let normalise = mk_flag ["normalise"] "Output a normalised version of the opam file to stdout" in let short = mk_flag ["short";"s"] "Only print the warning/error numbers, space-separated, if any" in let warnings = mk_opt ["warnings";"W"] "WARNS" "Select the warnings to show or hide. $(i,WARNS) should be a \ concatenation of $(b,+N), $(b,-N), $(b,+N..M), $(b,-N..M) to \ respectively enable or disable warning or error number $(b,N) or \ all warnings with numbers between $(b,N) and $(b,M) inclusive.\n\ All warnings are enabled by default, unless $(i,WARNS) starts with \ $(b,+), which disables all but the selected ones." warn_selector [] in let package = mk_opt ["package"] "PKG" "Lint the current definition of the given package instead of specifying \ an opam file directly." Arg.(some package) None in let check_upstream = mk_flag ["check-upstream"] "Check upstream, archive availability and checksum(s)" in let lint global_options files package normalise short warnings_sel check_upstream = apply_global_options global_options; let opam_files_in_dir d = match OpamPinned.files_in_source d with | [] -> OpamConsole.warning "No opam files found in %s" (OpamFilename.Dir.to_string d); [] | l -> List.map (fun (_name,f) -> Some f) l in let files = match files, package with | [], None -> (* Lookup in cwd if nothing was specified *) opam_files_in_dir (OpamFilename.cwd ()) | files, None -> List.map (function | None -> [None] (* this means '-' was specified for stdin *) | Some (OpamFilename.D d) -> opam_files_in_dir d | Some (OpamFilename.F f) -> [Some (OpamFile.make f)]) files |> List.flatten | [], Some pkg -> (OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_none gt @@ fun st -> try let nv = match pkg with | name, Some v -> OpamPackage.create name v | name, None -> OpamSwitchState.get_package st name in let opam = OpamSwitchState.opam st nv in match OpamPinned.orig_opam_file (OpamPackage.name nv) opam with | None -> raise Not_found | some -> [some] with Not_found -> OpamConsole.error_and_exit `Not_found "No opam file found for %s%s" (OpamPackage.Name.to_string (fst pkg)) (match snd pkg with None -> "" | Some v -> "."^OpamPackage.Version.to_string v)) | _::_, Some _ -> OpamConsole.error_and_exit `Bad_arguments "--package and a file argument are incompatible" in let msg = if normalise then OpamConsole.errmsg else OpamConsole.msg in let err = List.fold_left (fun err opam_f -> try let warnings,opam = match opam_f with | Some f -> OpamFileTools.lint_file ~check_upstream f | None -> OpamFileTools.lint_channel ~check_upstream (OpamFile.make (OpamFilename.of_string "-")) stdin in let enabled = let default = match warnings_sel with | (_,true) :: _ -> false | _ -> true in let map = List.fold_left (fun acc (wn, enable) -> OpamStd.IntMap.add wn enable acc) OpamStd.IntMap.empty warnings_sel in fun w -> try OpamStd.IntMap.find w map with Not_found -> default in let warnings = List.filter (fun (n, _, _) -> enabled n) warnings in let failed = List.exists (function _,`Error,_ -> true | _ -> false) warnings in if short then (if warnings <> [] then msg "%s\n" (OpamStd.List.concat_map " " (fun (n,_,_) -> string_of_int n) warnings)) else if warnings = [] then (if not normalise then msg "%s%s\n" (OpamStd.Option.to_string (fun f -> OpamFile.to_string f ^ ": ") opam_f) (OpamConsole.colorise `green "Passed.")) else msg "%s%s\n%s\n" (OpamStd.Option.to_string (fun f -> OpamFile.to_string f ^ ": ") opam_f) (if failed then OpamConsole.colorise `red "Errors." else OpamConsole.colorise `yellow "Warnings.") (OpamFileTools.warns_to_string warnings); if normalise then OpamStd.Option.iter (OpamFile.OPAM.write_to_channel stdout) opam; err || failed with | Parsing.Parse_error | OpamLexer.Error _ | OpamPp.Bad_format _ -> msg "File format error\n"; true) false files in if err then OpamStd.Sys.exit_because `False in Term.(const lint $global_options $files $package $normalise $short $warnings $check_upstream), term_info "lint" ~doc ~man (* CLEAN *) let clean_doc = "Cleans up opam caches" let clean = let doc = clean_doc in let man = [ `S "DESCRIPTION"; `P "Cleans up opam caches, reclaiming some disk space. If no options are \ specified, the default is $(b,--logs --download-cache \ --switch-cleanup)." ] in let dry_run = mk_flag ["dry-run"] "Print the removal commands, but don't execute them" in let download_cache = mk_flag ["c"; "download-cache"] "Clear the cache of downloaded files (\\$OPAMROOT/download-cache), as \ well as the obsolete \\$OPAMROOT/archives, if that exists." in let repos = mk_flag ["unused-repositories"] "Clear any configured repository that is not used by any switch nor the \ default." in let repo_cache = mk_flag ["r"; "repo-cache"] "Clear the repository cache. It will be rebuilt by the next opam command \ that needs it." in let logs = mk_flag ["logs"] "Clear the logs directory." in let switch = mk_flag ["s";"switch-cleanup"] "Run the switch-specific cleanup: clears backups, build dirs, \ uncompressed package sources of non-dev packages, local metadata of \ previously pinned packages, etc." in let all_switches = mk_flag ["a"; "all-switches"] "Run the switch cleanup commands in all switches. Implies $(b,--switch-cleanup)" in let clean global_options dry_run download_cache repos repo_cache logs switch all_switches = apply_global_options global_options; let logs, download_cache, switch = if logs || download_cache || repos || repo_cache || switch || all_switches then logs, download_cache, switch else true, true, true in OpamGlobalState.with_ `Lock_write @@ fun gt -> let root = gt.root in let cleandir d = if dry_run then OpamConsole.msg "rm -rf \"%s\"/*\n" (OpamFilename.Dir.to_string d) else try OpamFilename.cleandir d with OpamSystem.Internal_error msg -> OpamConsole.warning "Error ignored: %s" msg in let rmdir d = if dry_run then OpamConsole.msg "rm -rf \"%s\"\n" (OpamFilename.Dir.to_string d) else try OpamFilename.rmdir d with OpamSystem.Internal_error msg -> OpamConsole.warning "Error ignored: %s" msg in let switches = if all_switches then OpamGlobalState.switches gt else if switch then match OpamStateConfig.get_switch_opt () with | Some s -> [s] | None -> [] else [] in if switches <> [] then (OpamRepositoryState.with_ `Lock_none gt @@ fun rt -> List.iter (fun sw -> OpamSwitchState.with_ `Lock_write gt ~rt ~switch:sw @@ fun st -> OpamConsole.msg "Cleaning up switch %s\n" (OpamSwitch.to_string sw); cleandir (OpamPath.Switch.backup_dir root sw); cleandir (OpamPath.Switch.build_dir root sw); cleandir (OpamPath.Switch.remove_dir root sw); let pinning_overlay_dirs = List.map (fun nv -> OpamPath.Switch.Overlay.package root sw nv.name) (OpamPackage.Set.elements st.pinned) in List.iter (fun d -> if not (List.mem d pinning_overlay_dirs) then rmdir d) (OpamFilename.dirs (OpamPath.Switch.Overlay.dir root sw)); let keep_sources_dir = OpamPackage.Set.elements (OpamPackage.Set.union st.pinned (OpamPackage.Set.filter (OpamSwitchState.is_dev_package st) st.installed)) |> List.map (OpamSwitchState.source_dir st) in OpamFilename.dirs (OpamPath.Switch.sources_dir root sw) |> List.iter (fun d -> if not (List.mem d keep_sources_dir) then rmdir d)) switches); if repos then (OpamFilename.with_flock `Lock_write (OpamPath.repos_lock gt.root) @@ fun _lock -> let repos_config = OpamFile.Repos_config.safe_read (OpamPath.repos_config gt.root) in let all_repos = OpamRepositoryName.Map.keys repos_config |> OpamRepositoryName.Set.of_list in let default_repos = OpamGlobalState.repos_list gt |> OpamRepositoryName.Set.of_list in let unused_repos = List.fold_left (fun repos sw -> let switch_config = OpamFile.Switch_config.safe_read (OpamPath.Switch.switch_config root sw) in let used_repos = OpamStd.Option.default [] switch_config.OpamFile.Switch_config.repos |> OpamRepositoryName.Set.of_list in OpamRepositoryName.Set.diff repos used_repos) (OpamRepositoryName.Set.diff all_repos default_repos) (OpamGlobalState.switches gt) in OpamRepositoryName.Set.iter (fun r -> OpamConsole.msg "Removing repository %s\n" (OpamRepositoryName.to_string r); rmdir (OpamRepositoryPath.create root r)) unused_repos; let repos_config = OpamRepositoryName.Map.filter (fun r _ -> not (OpamRepositoryName.Set.mem r unused_repos)) repos_config in OpamConsole.msg "Updating %s\n" (OpamFile.to_string (OpamPath.repos_config root)); if not dry_run then OpamFile.Repos_config.write (OpamPath.repos_config root) repos_config); if repo_cache then (OpamConsole.msg "Clearing repository cache\n"; if not dry_run then OpamRepositoryState.Cache.remove ()); if download_cache then (OpamConsole.msg "Clearing cache of downloaded files\n"; rmdir (OpamPath.archives_dir root); cleandir (OpamRepositoryPath.download_cache root)); if logs then (OpamConsole.msg "Clearing logs\n"; cleandir (OpamPath.log root)) in Term.(const clean $global_options $dry_run $download_cache $repos $repo_cache $logs $switch $all_switches), term_info "clean" ~doc ~man (* HELP *) let help = let doc = "Display help about opam and opam commands." in let man = [ `S "DESCRIPTION"; `P "Prints help about opam commands."; `P "Use `$(mname) help topics' to get the full list of help topics."; ] in let topic = let doc = Arg.info [] ~docv:"TOPIC" ~doc:"The topic to get help on." in Arg.(value & pos 0 (some string) None & doc ) in let help man_format cmds topic = match topic with | None -> `Help (`Pager, None) | Some topic -> let topics = "topics" :: cmds in let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in match conv topic with | `Error e -> `Error (false, e) | `Ok t when t = "topics" -> List.iter (OpamConsole.msg "%s\n") cmds; `Ok () | `Ok t -> `Help (man_format, Some t) in Term.(ret (const help $Term.man_format $Term.choice_names $topic)), Term.info "help" ~doc ~man let default = let doc = "source-based package management" in let man = [ `S "DESCRIPTION"; `P "Opam is a package manager. It uses the powerful mancoosi tools to \ handle dependencies, including support for version constraints, \ optional dependencies, and conflict management. The default \ configuration binds it to the official package repository for OCaml."; `P "It has support for different remote repositories such as HTTP, rsync, \ git, darcs and mercurial. Everything is installed within a local opam \ directory, that can include multiple installation prefixes with \ different sets of intalled packages."; `P "Use either $(b,opam --help) or $(b,opam help ) \ for more information on a specific command."; `S "COMMANDS"; `S "COMMAND ALIASES"; ] @ help_sections in let usage global_options = apply_global_options global_options; OpamConsole.formatted_msg "usage: opam [--version]\n\ \ [--help]\n\ \ []\n\ \n\ The most commonly used opam commands are:\n\ \ init %s\n\ \ list %s\n\ \ show %s\n\ \ install %s\n\ \ remove %s\n\ \ update %s\n\ \ upgrade %s\n\ \ config %s\n\ \ repository %s\n\ \ switch %s\n\ \ pin %s\n\ \ admin %s\n\ \n\ See 'opam help ' for more information on a specific command.\n" init_doc list_doc show_doc install_doc remove_doc update_doc upgrade_doc config_doc repository_doc switch_doc pin_doc OpamAdminCommand.admin_command_doc in Term.(const usage $global_options), Term.info "opam" ~version:(OpamVersion.to_string OpamVersion.current) ~sdocs:global_option_section ~doc ~man let admin = let doc = "Use 'opam admin' instead (abbreviation not supported)" in Term.(ret (const (`Error (true, doc)))), Term.info "admin" ~doc:OpamAdminCommand.admin_command_doc ~man:[`S "SYNOPSIS"; `P doc] let commands = [ init; list (); make_command_alias (list ~force_search:true ()) ~options:" --search" "search"; show; make_command_alias show "info"; install; remove; make_command_alias remove "uninstall"; reinstall; update; upgrade; config; var; exec; env; repository; make_command_alias repository "remote"; switch; pin (); make_command_alias (pin ~unpin_only:true ()) ~options:" remove" "unpin"; source; lint; clean; admin; help; ] opam-2.0.5/src/client/opamSolution.mli0000644000175000017500000000740113511367404016721 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Interface with the solver, processing of full solutions through actions *) open OpamTypes open OpamStateTypes (** Resolve an user request *) val resolve: 'a switch_state -> user_action -> orphans:package_set -> ?reinstall:package_set -> requested:name_set -> atom request -> (OpamSolver.solution, OpamCudf.conflict) result (** Apply a solution returned by the solver. If [ask] is not specified, prompts the user whenever the solution isn't obvious from the request. [add_roots] defaults to the set of newly installed packages that are part of [requested]. *) val apply: ?ask:bool -> rw switch_state -> user_action -> requested:OpamPackage.Name.Set.t -> ?add_roots:OpamPackage.Name.Set.t -> ?assume_built:bool -> OpamSolver.solution -> rw switch_state * solver_result (** Call the solver to get a solution and then call [apply]. If [ask] is not specified, prompts the user whenever the solution isn't obvious from the request. [add_roots] defaults to the set of newly installed packages that are part of [requested]. *) val resolve_and_apply: ?ask:bool -> rw switch_state -> user_action -> orphans:package_set -> ?reinstall:package_set -> requested:OpamPackage.Name.Set.t -> ?add_roots:OpamPackage.Name.Set.t -> ?assume_built:bool -> atom request -> rw switch_state * solver_result (** Raise an error if no solution is found or in case of error. Unless [quiet] is set, print a message indicating that nothing was done on an empty solution. *) val check_solution: ?quiet:bool -> 'a switch_state -> solver_result -> unit (** {2 Atoms} *) (** Return an atom with a strict version constraint *) val eq_atom: name -> version -> atom (** Return a simple atom, with no version constrain, from a package*) val atom_of_package: package -> atom (** Returns an atom with a strict version constraint from a package *) val eq_atom_of_package: package -> atom (** Return a list of simple atoms (ie. with no version constraints) from a set of packages *) val atoms_of_packages: package_set -> atom list (** Return a list of constrained atoms from a set of packages *) val eq_atoms_of_packages: package_set -> atom list (** Checks that the atoms can possibly be verified (individually) in a package set. Displays an error and exits otherwise. [permissive] just changes the error message. *) val check_availability: ?permissive: bool -> 'a switch_state -> OpamPackage.Set.t -> atom list -> unit (** Matches package names to their existing counterparts, up to capitalisation. If no match exists, returns the name unchanged. *) val fuzzy_name: 'a switch_state -> name -> name (** Takes a "raw" list of atoms (from the user), and match it to existing packages. Match packages with the wrong capitalisation, and raises errors on non-existing packages, and unavailable ones unless [permissive] is set. Exits with a message on error. *) val sanitize_atom_list: ?permissive: bool -> 'a switch_state -> atom list -> atom list (** {2 Stats} *) val sum: stats -> int opam-2.0.5/src/client/opamClientConfig.mli0000644000175000017500000000712713511367404017456 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration options for the client lib (record, global reference, setter, initialisation), plus helper for global setup *) type t = private { print_stats: bool; pin_kind_auto: bool; autoremove: bool; editor: string; keep_build_dir: bool; reuse_build_dir: bool; inplace_build: bool; working_dir: bool; ignore_pin_depends: bool; show: bool; fake: bool; skip_dev_update: bool; json_out: string option; root_is_ok: bool; no_auto_upgrade: bool; } type 'a options_fun = ?print_stats:bool -> ?pin_kind_auto:bool -> ?autoremove:bool -> ?editor:string -> ?keep_build_dir:bool -> ?reuse_build_dir:bool -> ?inplace_build:bool -> ?working_dir:bool -> ?ignore_pin_depends:bool -> ?show:bool -> ?fake:bool -> ?skip_dev_update:bool -> ?json_out:string option -> ?root_is_ok:bool -> ?no_auto_upgrade:bool -> 'a (* constraint 'a = 'b -> 'c *) include OpamStd.Config.Sig with type t := t and type 'a options_fun := 'a options_fun (** Extra files included in [opam search] *) val search_files: string list (** Load the global configuration file (opamroot/config) and initialise all opam sub-libraries, overriding the given arguments *) val opam_init: ?root_dir:OpamTypes.dirname -> ?strict:bool -> ?skip_version_checks:bool -> ?all_parens:bool -> ?log_dir:OpamTypes.dirname -> ?print_stats:bool -> ?pin_kind_auto:bool -> ?autoremove:bool -> ?editor:string -> ?keep_build_dir:bool -> ?reuse_build_dir:bool -> ?inplace_build:bool -> ?working_dir:bool -> ?ignore_pin_depends:bool -> ?show:bool -> ?fake:bool -> ?skip_dev_update:bool -> ?json_out:string option -> ?root_is_ok:bool -> ?no_auto_upgrade:bool -> ?current_switch:OpamSwitch.t -> ?switch_from:[ `Command_line | `Default | `Env ] -> ?jobs:int Lazy.t -> ?dl_jobs:int -> ?build_test:bool -> ?build_doc:bool -> ?dryrun:bool -> ?makecmd:string Lazy.t -> ?ignore_constraints_on:OpamPackage.Name.Set.t -> ?unlock_base:bool -> ?no_env_notice:bool -> ?locked:string option -> ?cudf_file:string option -> ?solver:(module OpamCudfSolver.S) Lazy.t -> ?best_effort:bool -> ?solver_preferences_default:string option Lazy.t -> ?solver_preferences_upgrade:string option Lazy.t -> ?solver_preferences_fixup:string option Lazy.t -> ?solver_preferences_best_effort_prefix: string option Lazy.t -> ?solver_timeout:float option -> ?download_tool:(OpamTypes.arg list * OpamRepositoryConfig.dl_tool_kind) Lazy.t -> ?validation_hook:OpamTypes.arg list option -> ?retries:int -> ?force_checksums:bool option -> ?debug_level:int -> ?verbose_level:int -> ?color:[ `Always | `Auto | `Never ] -> ?utf8:[ `Always | `Auto | `Extended | `Never ] -> ?disp_status_line:[ `Always | `Auto | `Never ] -> ?answer:bool option -> ?safe_mode:bool -> ?keep_log_dir:bool -> ?errlog_length:int -> ?merged_output:bool -> ?use_openssl:bool -> ?precise_tracking:bool -> unit -> unit opam-2.0.5/src/client/opamConfigCommand.ml0000644000175000017500000003310213511367404017435 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) let log fmt = OpamConsole.log "CONFIG" fmt let slog = OpamConsole.slog open OpamTypes open OpamStateTypes let help t = let (%) s col = OpamConsole.colorise col s in OpamConsole.header_msg "Global opam variables"; let all_global_vars = List.fold_left (fun acc (v,doc) -> OpamVariable.Map.add (OpamVariable.of_string v) doc acc) OpamVariable.Map.empty OpamPackageVar.global_variable_names in let all_global_vars = OpamVariable.Map.union (fun _ x -> x) all_global_vars (OpamVariable.Map.map snd t.switch_global.global_variables) in let env = OpamPackageVar.resolve t in List.map (fun (var, doc) -> let content = OpamFilter.ident_string env ~default:"" ([],var,None) in let doc = if doc = OpamGlobalState.inferred_from_system then match OpamStd.Option.Op.( OpamVariable.Map.find_opt var t.switch_global.global_variables >>| fst >>= Lazy.force) with | Some c when (OpamVariable.string_of_variable_contents c) <> content -> "Set through local opam config or env" | _ -> doc else doc in [ OpamVariable.to_string var % `bold; content % `blue; "#"; doc ]) (OpamVariable.Map.bindings all_global_vars) |> OpamStd.Format.align_table |> OpamConsole.print_table stdout ~sep:" "; OpamConsole.header_msg "Configuration variables from the current switch"; let global = t.switch_config in List.map (fun stdpath -> [ OpamTypesBase.string_of_std_path stdpath % `bold; OpamPath.Switch.get_stdpath t.switch_global.root t.switch global stdpath |> OpamFilename.Dir.to_string |> OpamConsole.colorise `blue ]) OpamTypesBase.all_std_paths @ List.map (fun (var,value) -> [ OpamVariable.to_string var % `bold; OpamVariable.string_of_variable_contents value % `blue; ]) (global.OpamFile.Switch_config.variables) |> OpamStd.Format.align_table |> OpamConsole.print_table stdout ~sep:" "; OpamConsole.header_msg "Package variables ('opam config list PKG' to show)"; List.map (fun (var, doc) -> [ ("PKG:"^var) % `bold; ""; "#";doc ]) OpamPackageVar.package_variable_names |> OpamStd.Format.align_table |> OpamConsole.print_table stdout ~sep:" " (* List all the available variables *) let list gt ns = log "config-list"; OpamSwitchState.with_ `Lock_none gt @@ fun t -> if ns = [] then help t else let list_vars name = if OpamPackage.Name.to_string name = "-" then let conf = t.switch_config in List.map (fun (v,c) -> OpamVariable.Full.global v, OpamVariable.string_of_variable_contents c, "") (conf.OpamFile.Switch_config.variables) else try let nv = OpamSwitchState.get_package t name in let opam = OpamSwitchState.opam t nv in let env = OpamPackageVar.resolve ~opam t in let conf = OpamSwitchState.package_config t name in let pkg_vars = OpamStd.List.filter_map (fun (vname, desc) -> let v = OpamVariable.(Full.create name (of_string vname)) in try let c = OpamFilter.ident_string env (OpamFilter.ident_of_var v) in Some (v, c, desc) with Failure _ -> None) OpamPackageVar.package_variable_names in let conf_vars = List.map (fun (v,c) -> OpamVariable.Full.create name v, OpamVariable.string_of_variable_contents c, "") (OpamFile.Dot_config.bindings conf) in pkg_vars @ conf_vars with Not_found -> [] in let vars = List.flatten (List.map list_vars ns) in let (%) s col = OpamConsole.colorise col s in List.map (fun (variable, value, descr) -> [ OpamVariable.Full.to_string variable % `bold; value % `blue; if descr = "" then "" else "# "^descr; ]) vars |> OpamStd.Format.align_table |> OpamConsole.print_table stdout ~sep:" " let rec print_env = function | [] -> () | (k, v, comment) :: r -> if OpamConsole.verbose () then OpamStd.Option.iter (OpamConsole.msg ": %s;\n") comment; if not (List.exists (fun (k1, _, _) -> k = k1) r) || OpamConsole.verbose () then OpamConsole.msg "%s='%s'; export %s;\n" k (OpamStd.Env.escape_single_quotes v) k; print_env r let rec print_csh_env = function | [] -> () | (k, v, comment) :: r -> if OpamConsole.verbose () then OpamStd.Option.iter (OpamConsole.msg ": %s;\n") comment; if not (List.exists (fun (k1, _, _) -> k = k1) r) || OpamConsole.verbose () then OpamConsole.msg "setenv %s '%s';\n" k (OpamStd.Env.escape_single_quotes v); print_csh_env r let print_sexp_env env = let rec aux = function | [] -> () | (k, v, _) :: r -> if not (List.exists (fun (k1, _, _) -> k = k1) r) then OpamConsole.msg " (%S %S)\n" k v; aux r in OpamConsole.msg "(\n"; aux env; OpamConsole.msg ")\n" let rec print_fish_env env = let set_arr_cmd k v = let v = OpamStd.String.split v ':' in OpamConsole.msg "set -gx %s %s;\n" k (OpamStd.List.concat_map " " (fun v -> Printf.sprintf "'%s'" (OpamStd.Env.escape_single_quotes ~using_backslashes:true v)) v) in (* set manpath if and only if fish version >= 2.7 *) let manpath_cmd v = OpamConsole.msg "%s" ( (* test for existence of `argparse` builtin, introduced in fish 2.7 . * use `grep' instead of `builtin string match' so that old fish versions do not * produce unwanted error messages on stderr. * use `grep' inside a `/bin/sh' fragment so that nothing is written to stdout or * stderr if `grep' does not exist. *) "builtin -n | /bin/sh -c 'grep -q \\'^argparse$\\'' 1>/dev/null 2>/dev/null; and " ) ; set_arr_cmd "MANPATH" v in match env with | [] -> () | (k, v, _) :: r -> if not (List.exists (fun (k1, _, _) -> k = k1) r) then (match k with | "PATH" | "CDPATH" -> (* This function assumes that `v` does not include any variable * expansions and that the directory names are written in full. See the * opamState.ml for details *) set_arr_cmd k v | "MANPATH" -> manpath_cmd v | _ -> OpamConsole.msg "set -gx %s '%s';\n" k (OpamStd.Env.escape_single_quotes ~using_backslashes:true v)); print_fish_env r let print_eval_env ~csh ~sexp ~fish env = if sexp then print_sexp_env env else if csh then print_csh_env env else if fish then print_fish_env env else print_env env let env gt switch ?(set_opamroot=false) ?(set_opamswitch=false) ~csh ~sexp ~fish ~inplace_path = log "config-env"; let opamroot_not_current = let current = gt.root in let default = OpamStateConfig.(default.root_dir) in match OpamStd.Config.env_string "ROOT" with | None -> current <> default | Some r -> OpamFilename.Dir.of_string r <> current in let opamswitch_not_current = let default = OpamStd.Option.Op.(++) (OpamStateConfig.get_current_switch_from_cwd gt.root) (OpamFile.Config.switch gt.config) in match OpamStd.Config.env_string "SWITCH" with | None -> Some (OpamStateConfig.resolve_local_switch gt.root switch) <> default | Some s -> OpamStateConfig.resolve_local_switch gt.root (OpamSwitch.of_string s) <> OpamStateConfig.resolve_local_switch gt.root switch in if opamroot_not_current && not set_opamroot then OpamConsole.note "To make opam select %s as its root in the current shell, add %s or set \ %s" (OpamFilename.Dir.to_string gt.root) (OpamConsole.colorise `bold "--set-root") (OpamConsole.colorise `bold "OPAMROOT"); if opamswitch_not_current && not set_opamswitch then OpamConsole.note "To make opam select the switch %s in the current shell, add %s or set \ %s" (OpamSwitch.to_string switch) (OpamConsole.colorise `bold "--set-switch") (OpamConsole.colorise `bold "OPAMSWITCH"); let force_path = not inplace_path in let env = let env_file = OpamPath.Switch.environment gt.root switch in if not (OpamFile.exists env_file) then (OpamSwitchState.with_ `Lock_none gt @@ fun st -> let upd = OpamEnv.updates ~set_opamroot ~set_opamswitch ~force_path st in log "Missing environment file, regenerates it"; if not (OpamCoreConfig.(!r.safe_mode)) then (let _st = OpamSwitchState.with_write_lock st @@ fun _st -> (OpamFile.Environment.write env_file upd), _st in ()); OpamEnv.add [] upd) else OpamEnv.get_opam_raw ~set_opamroot ~set_opamswitch ~force_path gt.root switch in print_eval_env ~csh ~sexp ~fish env let subst gt fs = log "config-substitute"; OpamSwitchState.with_ `Lock_none gt @@ fun st -> List.iter (OpamFilter.expand_interpolations_in_file (OpamPackageVar.resolve st)) fs let expand gt str = log "config-expand"; OpamSwitchState.with_ `Lock_none gt @@ fun st -> OpamConsole.msg "%s\n" (OpamFilter.expand_string ~default:(fun _ -> "") (OpamPackageVar.resolve st) str) let set var value = if not (OpamVariable.Full.is_global var) then OpamConsole.error_and_exit `Bad_arguments "Only global variables may be set using this command"; let root = OpamStateConfig.(!r.root_dir) in let switch = OpamStateConfig.get_switch () in OpamFilename.with_flock `Lock_write (OpamPath.Switch.lock root switch) @@ fun _ -> let var = OpamVariable.Full.variable var in let config_f = OpamPath.Switch.switch_config root switch in let config = OpamFile.Switch_config.read config_f in let oldval = OpamFile.Switch_config.variable config var in let newval = OpamStd.Option.map (fun s -> S s) value in if oldval = newval then OpamConsole.note "No change for \"%s\"" (OpamVariable.to_string var) else let () = match oldval, newval with | Some old, Some _ -> OpamConsole.note "Overriding value of \"%s\": was \"%s\"" (OpamVariable.to_string var) (OpamVariable.string_of_variable_contents old) | _ -> () in let variables = config.OpamFile.Switch_config.variables in let variables = match newval with | None -> List.remove_assoc var variables | Some v -> OpamStd.List.update_assoc var v variables in OpamFile.Switch_config.write config_f {config with OpamFile.Switch_config.variables} let set_global var value = if not (OpamVariable.Full.is_global var) then OpamConsole.error_and_exit `Bad_arguments "Only global variables may be set using this command"; OpamGlobalState.with_ `Lock_write @@ fun gt -> let var = OpamVariable.Full.variable var in let config = gt.config |> OpamFile.Config.with_global_variables (let vars = List.filter (fun (k,_,_) -> k <> var) (OpamFile.Config.global_variables gt.config) in match value with | Some v -> (var, S v, "Set through 'opam config set-global'") :: vars | None -> vars) |> OpamFile.Config.with_eval_variables (List.filter (fun (k,_,_) -> k <> var) (OpamFile.Config.eval_variables gt.config)) in OpamGlobalState.write { gt with config } let variable gt v = let raw_switch_content = match OpamStateConfig.get_switch_opt () with | Some switch -> let switch_config = OpamFile.Switch_config.safe_read (OpamPath.Switch.switch_config gt.root switch) in OpamPackageVar.resolve_switch_raw gt switch switch_config v | None -> None in let switch_content = match raw_switch_content with | None when not (OpamVariable.Full.is_global v) -> OpamSwitchState.with_ `Lock_none gt @@ fun st -> OpamPackageVar.resolve st v | rsc -> rsc in let content = match switch_content with | Some _ as some -> some | None -> OpamPackageVar.resolve_global gt v in match content with | Some c -> OpamConsole.msg "%s\n" (OpamVariable.string_of_variable_contents c) | None -> OpamConsole.error_and_exit `Not_found "Variable %s not found" (OpamVariable.Full.to_string v) let exec gt ?set_opamroot ?set_opamswitch ~inplace_path command = log "config-exec command=%a" (slog (String.concat " ")) command; OpamSwitchState.with_ `Lock_none gt @@ fun st -> let cmd, args = match List.map (OpamFilter.expand_string ~default:(fun _ -> "") (OpamPackageVar.resolve st)) command with | [] -> OpamSystem.internal_error "Empty command" | h::_ as l -> h, Array.of_list l in let env = OpamTypesBase.env_array (OpamEnv.get_full ?set_opamroot ?set_opamswitch ~force_path:(not inplace_path) st) in match OpamSystem.resolve_command ~env cmd with | Some cmd -> raise (OpamStd.Sys.Exec (cmd, args, env)) | None -> raise (OpamStd.Sys.Exit 127) opam-2.0.5/src/client/Opam.Runtime.amd64.manifest0000644000175000017500000000054513511367404020507 0ustar nicoonicoo opam-2.0.5/src/client/opamAdminCheck.ml0000644000175000017500000004073313511367404016727 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2017-2018 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamPackage.Set.Op let env ~with_test ~with_doc ~dev nv v = match OpamVariable.Full.scope v, OpamVariable.(to_string (Full.variable v)) with | (OpamVariable.Full.Global | OpamVariable.Full.Self), "name" -> Some (S (OpamPackage.Name.to_string nv.name)) | (OpamVariable.Full.Global | OpamVariable.Full.Self), "version" -> Some (S (OpamPackage.Version.to_string nv.version)) | OpamVariable.Full.Global, "opam-version" -> Some (S OpamVersion.(to_string current)) | OpamVariable.Full.Global, "with-test" -> Some (B with_test) | OpamVariable.Full.Global, "dev" -> Some (B dev) | OpamVariable.Full.Global, "with-doc" -> Some (B with_doc) | _ -> None let get_universe ~with_test ~with_doc ~dev opams = let env = env ~with_test ~with_doc ~dev in let packages = OpamPackage.keys opams in { u_packages = packages; u_action = Query; u_installed = OpamPackage.Set.empty; u_available = packages; u_depends = OpamPackage.Map.mapi (fun nv o -> OpamFile.OPAM.depends o |> OpamFilter.partial_filter_formula (env nv)) opams; u_depopts = OpamPackage.Map.mapi (fun nv o -> OpamFile.OPAM.depopts o |> OpamFilter.partial_filter_formula (env nv)) opams; u_conflicts = OpamPackage.Map.mapi (fun nv o -> OpamFile.OPAM.conflicts o |> OpamFilter.filter_formula ~default:false (env nv)) opams; u_installed_roots = OpamPackage.Set.empty; u_pinned = OpamPackage.Set.empty; u_base = OpamPackage.Set.empty; u_attrs = []; u_reinstall = OpamPackage.Set.empty; } let installability_check univ = let packages = univ.u_packages in let graph = OpamCudf.Graph.of_universe @@ OpamSolver.load_cudf_universe ~depopts:false ~build:true ~post:true univ packages () in let filter_roots g packages = let has_pkg p = OpamPackage.Set.mem (OpamCudf.cudf2opam p) packages in OpamCudf.Graph.fold_vertex (fun p acc -> if has_pkg p && not (List.exists has_pkg (OpamCudf.Graph.succ g p)) then OpamPackage.Set.add (OpamCudf.cudf2opam p) acc else acc) g OpamPackage.Set.empty in let installable = OpamSolver.installable univ in let uninstallable = packages -- installable in let unav_roots = filter_roots graph uninstallable in unav_roots, uninstallable let formula_of_pkglist packages = function | [] -> OpamFormula.Empty | [p] -> let nv = OpamCudf.cudf2opam p in Atom (nv.name, Atom (`Eq, nv.version)) | p::ps -> let name = (OpamCudf.cudf2opam p).name in let nvs = List.map OpamCudf.cudf2opam (p::ps) in Atom (name, OpamFormula.formula_of_version_set (OpamPackage.versions_of_name packages name) (OpamPackage.versions_of_packages (OpamPackage.Set.of_list nvs))) let cycle_check univ = let cudf_univ = OpamSolver.load_cudf_universe ~depopts:true ~build:true ~post:false univ univ.u_packages () in let graph = OpamCudf.Graph.of_universe cudf_univ |> OpamCudf.Graph.mirror in (* conflicts break cycles *) let conflicts = Algo.Defaultgraphs.PackageGraph.conflict_graph cudf_univ in let module CGraph = Algo.Defaultgraphs.PackageGraph.UG in CGraph.iter_edges (fun nv1 nv2 -> OpamCudf.Graph.remove_edge graph nv1 nv2; OpamCudf.Graph.remove_edge graph nv2 nv1) conflicts; let scc = let module Comp = Graph.Components.Make(OpamCudf.Graph) in Comp.scc_list graph |> List.filter (function [] | [_] -> false | _ -> true) in let node_map, cy = List.fold_left (fun (node_map, acc) pkgs -> let univ = Cudf.load_universe pkgs in let g = OpamCudf.Graph.of_universe univ in let conflicts = Algo.Defaultgraphs.PackageGraph.conflict_graph univ in (* Simplify the graph by merging all equivalent versions of each package *) (* (note: this is not completely accurate, as dependencies might be conjunctions or disjunctions, information which is lost in the dependency graph) *) (* let count = OpamCudf.Graph.nb_vertex g in *) let node_map = Cudf.fold_packages_by_name (fun node_map _ pkgs -> let id p = let f pl = List.sort compare @@ List.map (Cudf.uid_by_package univ) pl in f (OpamCudf.Graph.pred g p), f (OpamCudf.Graph.succ g p), f (CGraph.succ conflicts p) in let ids = List.fold_left (fun acc p -> OpamCudf.Map.add p (id p) acc) OpamCudf.Map.empty pkgs in let rec gather node_map = function | [] -> node_map | p::pkgs -> let pid = OpamCudf.Map.find p ids in let ps, pkgs = List.partition (fun p1 -> OpamCudf.Map.find p1 ids = pid) pkgs in List.iter (OpamCudf.Graph.remove_vertex g) ps; let node_map = OpamCudf.Map.add p (p::ps) node_map in gather node_map pkgs in gather node_map pkgs) node_map univ in (* OpamConsole.msg * "Number of vertices: before merge %d, after merge %d\n" * count (OpamCudf.Graph.nb_vertex g); *) let it = ref 0 in let rec extract_cycles acc rpath v g = incr it; let rec find_pref acc v = function | [] -> None | v1::r -> if Cudf.(=%) v v1 then Some (v1::acc) else if CGraph.mem_edge conflicts v v1 then None else find_pref (v1::acc) v r in match find_pref [] v rpath with | Some cy -> cy :: acc | None -> let rpath = v::rpath in (* split into sub-graphs for each successor *) List.fold_left (fun acc s -> extract_cycles acc rpath s g) acc (OpamCudf.Graph.succ g v) in let p0 = List.find (OpamCudf.Graph.mem_vertex g) pkgs in let r = extract_cycles acc [] p0 g in (* OpamConsole.msg "Iterations: %d\n" !it; *) node_map, r ) (OpamCudf.Map.empty, []) scc in (* OpamConsole.msg "all cycles: %d\n" (List.length cy); *) let rec has_conflict = function | [] | [_] -> false | p::r -> List.exists (CGraph.mem_edge conflicts p) r || has_conflict r in let cy = List.rev cy |> List.filter (fun c -> not (has_conflict c)) in let cycle_packages = List.fold_left (List.fold_left (fun acc p -> List.fold_left (fun acc p -> OpamPackage.Set.add (OpamCudf.cudf2opam p) acc) acc (OpamCudf.Map.find p node_map))) OpamPackage.Set.empty cy in let cycle_formulas = cy |> List.map @@ List.map @@ fun p -> formula_of_pkglist univ.u_packages (OpamCudf.Map.find p node_map) in cycle_packages, cycle_formulas let print_cycles cy = let arrow = OpamConsole.colorise `yellow @@ if OpamConsole.utf8 () then " \xe2\x86\x92 " (* U+2192 *) else " -> " in OpamStd.Format.itemize ~bullet:(OpamConsole.colorise `bold " * ") (OpamStd.List.concat_map arrow OpamFormula.to_string) cy (* Obsolete packages check *) module PkgSet = OpamPackage.Set module PkgMap = OpamPackage.Map module PkgSetSet = OpamStd.Set.Make(PkgSet) (* module PkgSetMap = OpamStd.Map.Make(PkgSet) *) let pkg_deps univ package = let deps = try OpamFilter.filter_deps ~build:true ~post:true ~default:true (OpamPackage.Map.find package univ.u_depends) with Not_found -> Empty in let sets_formula = OpamFormula.map (fun (name, vconstr) -> OpamPackage.Version.Set.filter (OpamFormula.check_version_formula vconstr) (OpamPackage.versions_of_name univ.u_packages name) |> OpamPackage.Name.Map.singleton name |> OpamPackage.of_map |> fun s -> Atom (PkgSetSet.singleton s)) deps in let product ss1 ss2 = PkgSetSet.fold (fun s1 -> PkgSetSet.union (PkgSetSet.map (PkgSet.union s1) ss2)) ss1 PkgSetSet.empty in let depsets = (* PkgSetSet-encoded CNF *) match OpamFormula.map_up_formula (function | Atom s -> Atom s | And (Atom s1, Atom s2) -> Atom (PkgSetSet.union s1 s2) | Or (Atom s1, Atom s2) -> Atom (product s1 s2) | And _ | Or _ -> assert false | Block x -> x | Empty -> Atom (PkgSetSet.empty)) sets_formula with | And _ | Or _ | Block _ | Empty -> assert false | Atom depsets -> depsets in let inferred_conflicts = (* Versions that may be present in some disjunctions but will always be rejected. We filter them out to get more accurate reverse deps *) PkgSetSet.fold (fun dset acc -> try let n = (PkgSet.choose dset).name in if PkgSet.for_all (fun p -> p.name = n) dset then acc ++ (OpamPackage.packages_of_name univ.u_packages n -- dset) else acc with Not_found -> acc) depsets PkgSet.empty in PkgSetSet.map (fun s -> s -- inferred_conflicts) depsets let more_restrictive_deps_than deps1 deps2 = PkgSetSet.for_all (fun disj2 -> PkgSetSet.exists (fun disj1 -> PkgSet.subset disj1 disj2) deps1) deps2 (* Aggregates all versionned packages with an exclusive version relationship (when b.vb1 can only be installed with a.va1, and the only version of b that can be installed with a.va1 is vb1). An aggregate should not contain more than one version per package name. *) let aggregate packages deps revdeps = if OpamStd.Config.env_bool "NOAGGREGATE" = Some true then PkgSet.fold (fun nv -> PkgSetSet.add (PkgSet.singleton nv)) packages PkgSetSet.empty else let friends p (deps, revdeps) = (* dependencies which have a 1-1 version relationship *) try PkgMap.find p deps |> OpamPackage.to_map |> OpamPackage.Name.Map.filter (fun _ vs -> OpamPackage.Version.Set.is_singleton vs) |> OpamPackage.of_map |> PkgSet.filter (fun d -> OpamPackage.packages_of_name (PkgMap.find d revdeps) p.name = PkgSet.singleton p) with Not_found -> PkgSet.empty in let rec all_friends acc p = let acc = PkgSet.add p acc in PkgSet.fold (fun p acc -> all_friends acc p) (friends p (deps, revdeps) ++ friends p (revdeps, deps) -- acc) acc in let rec aux acc packages = if PkgSet.is_empty packages then acc else let p = PkgSet.choose packages in let fr = all_friends PkgSet.empty p in aux (PkgSetSet.add fr acc) (packages -- fr) in aux PkgSetSet.empty packages (* we work on aggregates of packages (expected to be a.g. different names with the same version), encode their dependencies as CNF mapped to sets, i.e. sets of sets from each of which one package must be present. Then, we detect aggregates with an inferior version, and equivalent or less restrictive dependencies: their members are obsolete *) let get_obsolete univ opams = let deps_map = (* pkg -> setset-encoded CNF *) PkgSet.fold (fun p -> PkgMap.add p (pkg_deps univ p)) univ.u_packages PkgMap.empty in let simple_deps = (* pkg -> set *) PkgMap.map (fun deps -> PkgSetSet.fold PkgSet.union deps PkgSet.empty) deps_map in let revdeps_map = (* pkg -> set *) PkgMap.fold (fun pkg -> PkgSet.fold (fun d -> PkgMap.update d (PkgSet.add pkg) PkgSet.empty)) simple_deps PkgMap.empty in let aggregates = aggregate univ.u_packages simple_deps revdeps_map in let aggregate_deps pkgs = PkgSet.fold (fun pkg -> PkgSetSet.union (PkgMap.find pkg deps_map)) pkgs PkgSetSet.empty |> PkgSetSet.map (fun ps -> ps -- pkgs) in let aggregate_revdeps pkgs = PkgSet.fold (fun pkg acc -> try PkgSet.union (PkgMap.find pkg revdeps_map) acc with Not_found -> acc) pkgs PkgSet.empty -- pkgs in let aggregate_nextv pkgs = let ps = OpamPackage.packages_of_names univ.u_packages (OpamPackage.names_of_packages pkgs) in PkgSet.map (fun p -> match PkgSet.split p ps with | (_, true, s1) -> let next = PkgSet.min_elt s1 in if next.name = p.name then next else raise Not_found | _ -> raise Not_found) pkgs in PkgSetSet.fold (fun pkgs acc -> let is_obsolete = not @@ PkgSet.exists (fun p -> OpamFile.OPAM.has_flag Pkgflag_Compiler (OpamPackage.Map.find p opams)) pkgs && try let next = aggregate_nextv pkgs in more_restrictive_deps_than (aggregate_deps pkgs) (aggregate_deps next) && let next_rd = aggregate_revdeps next in not (OpamPackage.Set.is_empty next_rd) && PkgSet.subset (aggregate_revdeps pkgs) next_rd with Not_found -> false in if is_obsolete then acc ++ pkgs else acc) aggregates PkgSet.empty let check ~quiet ~installability ~cycles ~obsolete ~ignore_test repo_root = let repo = OpamRepositoryBackend.local repo_root in let pkg_prefixes = OpamRepository.packages_with_prefixes repo in let opams = OpamPackage.Map.fold (fun nv prefix acc -> let opam_file = OpamRepositoryPath.opam repo_root prefix nv in match OpamFile.OPAM.read_opt opam_file with | Some o -> OpamPackage.Map.add nv o acc | None -> OpamConsole.warning "Error while reading %s" (OpamFile.to_string opam_file); acc) pkg_prefixes OpamPackage.Map.empty in let univ = get_universe ~with_test:(not ignore_test) ~with_doc:(not ignore_test) ~dev:false opams in (* Installability check *) let unav_roots, uninstallable = if not installability then PkgSet.empty, PkgSet.empty else ( if not quiet then OpamConsole.msg "Checking installability of every package. This may \ take a few minutes...\n"; installability_check univ ) in if not quiet then if not (PkgSet.is_empty uninstallable) then OpamConsole.error "These packages are not installable (%d):\n%s%s" (PkgSet.cardinal unav_roots) (OpamStd.List.concat_map " " OpamPackage.to_string (PkgSet.elements unav_roots)) (let unav_others = uninstallable -- unav_roots in if PkgSet.is_empty unav_others then "" else "\n(the following depend on them and are also unavailable:\n"^ (OpamStd.List.concat_map " " OpamPackage.to_string (PkgSet.elements unav_others))^")"); (* Cyclic dependency checks *) let cycle_packages, cycle_formulas = if not cycles then PkgSet.empty, [] else cycle_check univ in if not quiet && cycle_formulas <> [] then (OpamConsole.error "Dependency cycles detected:"; OpamConsole.errmsg "%s" @@ print_cycles cycle_formulas); (* Obsolescence checks *) let obsolete_packages = if not obsolete then PkgSet.empty else get_obsolete univ opams in if not quiet && not( PkgSet.is_empty obsolete_packages) then (OpamConsole.error "Obsolete packages detected:"; OpamConsole.errmsg "%s" (OpamStd.Format.itemize (fun (n, vs) -> Printf.sprintf "%s %s" (OpamConsole.colorise `bold (OpamPackage.Name.to_string n)) (OpamStd.List.concat_map ", " (fun v -> OpamConsole.colorise `magenta (OpamPackage.Version.to_string v)) (OpamPackage.Version.Set.elements vs))) (OpamPackage.Name.Map.bindings (OpamPackage.to_map obsolete_packages)))); univ.u_packages, unav_roots, uninstallable, cycle_packages, obsolete_packages opam-2.0.5/src/client/opamAction.ml0000644000175000017500000007460413511367404016162 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) let log ?level fmt = OpamConsole.log ?level "ACTION" fmt let slog = OpamConsole.slog open OpamTypes open OpamFilename.Op open OpamStateTypes open OpamProcess.Job.Op module PackageActionGraph = OpamSolver.ActionGraph (* Install the package files *) let process_dot_install st nv build_dir = let root = st.switch_global.root in if OpamStateConfig.(!r.dryrun) then OpamConsole.msg "Installing %s.\n" (OpamPackage.to_string nv) else if OpamFilename.exists_dir build_dir then OpamFilename.in_dir build_dir (fun () -> log "Installing %s.\n" (OpamPackage.to_string nv); let name = nv.name in let config_f = OpamPath.Builddir.config build_dir nv in let config = OpamFile.Dot_config.read_opt config_f in let install_f = OpamPath.Builddir.install build_dir nv in let install = OpamFile.Dot_install.safe_read install_f in (* .install *) let install_f = OpamPath.Switch.install root st.switch name in if install <> OpamFile.Dot_install.empty then OpamFile.Dot_install.write install_f install; (* .config *) (match config with | Some config -> let dot_config = OpamPath.Switch.config root st.switch name in OpamFile.Dot_config.write dot_config config | None -> ()); let warnings = ref [] in let check ~src ~dst base = let src_file = OpamFilename.create src base.c in if base.optional && not (OpamFilename.exists src_file) then log "Not installing %a is not present and optional." (slog OpamFilename.to_string) src_file; if not base.optional && not (OpamFilename.exists src_file) then ( warnings := (dst, base.c) :: !warnings ); OpamFilename.exists src_file in (* Install a list of files *) let install_files exec dst_fn files_fn = let dst_dir = dst_fn root st.switch name in let files = files_fn install in if not (OpamFilename.exists_dir dst_dir) && files <> [] then ( log "creating %a" (slog OpamFilename.Dir.to_string) dst_dir; OpamFilename.mkdir dst_dir; ); List.iter (fun (base, dst) -> let src_file = OpamFilename.create build_dir base.c in let dst_file = match dst with | None -> OpamFilename.create dst_dir (OpamFilename.basename src_file) | Some d -> OpamFilename.create dst_dir d in if check ~src:build_dir ~dst:dst_dir base then OpamFilename.install ~exec ~src:src_file ~dst:dst_file (); ) files in let module P = OpamPath.Switch in let module I = OpamFile.Dot_install in let instdir_gen fpath r s _ = fpath r s st.switch_config in let instdir_pkg fpath r s n = fpath r s st.switch_config n in (* bin *) install_files true (instdir_gen P.bin) I.bin; (* sbin *) install_files true (instdir_gen P.sbin) I.sbin; (* lib *) install_files false (instdir_pkg P.lib) I.lib; install_files true (instdir_pkg P.lib) I.libexec; install_files false (instdir_gen P.lib_dir) I.lib_root; install_files true (instdir_gen P.lib_dir) I.libexec_root; (* toplevel *) install_files false (instdir_gen P.toplevel) I.toplevel; install_files true (instdir_gen P.stublibs) I.stublibs; (* Man pages *) install_files false (instdir_gen P.man_dir) I.man; (* Shared files *) install_files false (instdir_pkg P.share) I.share; install_files false (instdir_gen P.share_dir) I.share_root; (* Etc files *) install_files false (instdir_pkg P.etc) I.etc; (* Documentation files *) install_files false (instdir_pkg P.doc) I.doc; (* misc *) List.iter (fun (src, dst) -> let src_file = OpamFilename.create (OpamFilename.cwd ()) src.c in if OpamFilename.exists dst && OpamConsole.confirm "Overwriting %s?" (OpamFilename.to_string dst) then OpamFilename.install ~src:src_file ~dst () else begin OpamConsole.msg "Installing %s to %s.\n" (OpamFilename.Base.to_string src.c) (OpamFilename.to_string dst); if OpamConsole.confirm "Continue?" then OpamFilename.install ~src:src_file ~dst () end ) (I.misc install); if !warnings <> [] then ( let print (dir, base) = Printf.sprintf " - %s to %s\n" (OpamFilename.to_string (OpamFilename.create build_dir base)) (OpamFilename.Dir.to_string dir) in OpamConsole.error "Installation of %s failed" (OpamPackage.to_string nv); let msg = Printf.sprintf "Some files in %s couldn't be installed:\n%s" (OpamFile.to_string install_f) (String.concat "" (List.map print !warnings)) in failwith msg ) ) let download_package st nv = log "download_package: %a" (slog OpamPackage.to_string) nv; if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.fake) then Done None else let dir = OpamSwitchState.source_dir st nv in if OpamPackage.Set.mem nv st.pinned && OpamFilename.exists_dir dir && OpamStd.Option.Op.( OpamPinned.find_opam_file_in_source nv.name dir >>= OpamFile.OPAM.read_opt >>= OpamFile.OPAM.version_opt) = Some nv.version then Done None else (OpamUpdate.cleanup_source st (OpamPackage.Map.find_opt nv st.installed_opams) (OpamSwitchState.opam st nv); OpamProcess.Job.catch (fun e -> let na = match e with | OpamDownload.Download_fail (s,l) -> (s,l) | e -> (None, Printexc.to_string e) in Done (Some na)) @@ fun () -> OpamUpdate.download_package_source st nv dir @@| function | Some (Not_available (s,l)) -> Some (s,l) | None | Some (Up_to_date () | Result ()) -> None) (* Prepare the package build: * apply the patches * substitute the files *) let prepare_package_build st nv dir = let opam = OpamSwitchState.opam st nv in let patches = OpamFile.OPAM.patches opam in let rec iter_patches f = function | [] -> Done [] | (patchname,filter)::rest -> if OpamFilter.opt_eval_to_bool (OpamPackageVar.resolve ~opam st) filter then OpamFilename.patch (dir // OpamFilename.Base.to_string patchname) dir @@+ function | None -> iter_patches f rest | Some err -> iter_patches f rest @@| fun e -> (patchname, err) :: e else iter_patches f rest in let print_apply basename = log "%s: applying %s.\n" (OpamPackage.name_to_string nv) (OpamFilename.Base.to_string basename); if OpamConsole.verbose () then OpamConsole.msg "[%s: patch] applying %s\n" (OpamConsole.colorise `green (OpamPackage.name_to_string nv)) (OpamFilename.Base.to_string basename) in if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.fake) then iter_patches print_apply patches @@| fun _ -> None else let subst_patches, subst_others = List.partition (fun f -> List.mem_assoc f patches) (OpamFile.OPAM.substs opam) in let subst_errs = OpamFilename.in_dir dir @@ fun () -> List.fold_left (fun errs f -> try OpamFilter.expand_interpolations_in_file (OpamPackageVar.resolve ~opam st) f; errs with e -> (f, e)::errs) [] subst_patches in (* Apply the patches *) let text = OpamProcess.make_command_text (OpamPackage.Name.to_string nv.name) "patch" in OpamProcess.Job.with_text text @@ iter_patches (fun base -> let patch = dir // OpamFilename.Base.to_string base in print_apply base; OpamFilename.patch patch dir) patches @@+ fun patching_errors -> (* Substitute the configuration files. We should be in the right directory to get the correct absolute path for the substitution files (see [substitute_file] and [OpamFilename.of_basename]. *) let subst_errs = OpamFilename.in_dir dir @@ fun () -> List.fold_left (fun errs f -> try OpamFilter.expand_interpolations_in_file (OpamPackageVar.resolve ~opam st) f; errs with e -> (f, e)::errs) subst_errs subst_others in if patching_errors <> [] || subst_errs <> [] then let msg = (if patching_errors <> [] then Printf.sprintf "These patches didn't apply at %s:\n%s" (OpamFilename.Dir.to_string dir) (OpamStd.Format.itemize (fun (f,err) -> Printf.sprintf "%s: %s" (OpamFilename.Base.to_string f) (Printexc.to_string err)) patching_errors) else "") ^ (if subst_errs <> [] then Printf.sprintf "String expansion failed for these files:\n%s" (OpamStd.Format.itemize (fun (b,err) -> Printf.sprintf "%s.in: %s" (OpamFilename.Base.to_string b) (Printexc.to_string err)) subst_errs) else "") in Done (Some (Failure msg)) else Done None let prepare_package_source st nv dir = log "prepare_package_source: %a at %a" (slog OpamPackage.to_string) nv (slog OpamFilename.Dir.to_string) dir; if OpamStateConfig.(!r.dryrun) then Done None else let opam = OpamSwitchState.opam st nv in let get_extra_sources_job = (* !X The extra sources have normally been prefetched during the dl phase; this is, assuming their metadata contains a hash though. *) let dl_file_job (basename, urlf) = OpamProcess.Job.catch (fun e -> Done (Some e)) @@ fun () -> OpamRepository.pull_file ~cache_dir:(OpamRepositoryPath.download_cache st.switch_global.root) ~silent_hits:true (OpamPackage.to_string nv ^ "/" ^ OpamFilename.Base.to_string basename) (OpamFilename.create dir basename) (OpamFile.URL.checksum urlf) (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| function | Result () | Up_to_date () -> None | Not_available (_,msg) -> Some (Failure msg) in List.fold_left (fun job dl -> job @@+ function | None -> dl_file_job dl | some_err -> Done some_err) (Done None) (OpamFile.OPAM.extra_sources opam) in let check_extra_files = try List.iter (fun (src,base,hash) -> if not (OpamHash.check_file (OpamFilename.to_string src) hash) then failwith (Printf.sprintf "Bad hash for %s" (OpamFilename.to_string src)) else OpamFilename.copy ~src ~dst:(OpamFilename.create dir base)) (OpamFile.OPAM.get_extra_files opam); None with e -> Some e in OpamFilename.mkdir dir; get_extra_sources_job @@+ function Some _ as err -> Done err | None -> check_extra_files |> function Some _ as err -> Done err | None -> prepare_package_build st nv dir let compilation_env t opam = OpamEnv.get_full ~force_path:true t ~updates:([ "CDPATH", Eq, "", Some "shell env sanitization"; "MAKEFLAGS", Eq, "", Some "make env sanitization"; "MAKELEVEL", Eq, "", Some "make env sanitization"; "OPAM_PACKAGE_NAME", Eq, OpamPackage.Name.to_string (OpamFile.OPAM.name opam), Some "build environment definition"; "OPAM_PACKAGE_VERSION", Eq, OpamPackage.Version.to_string (OpamFile.OPAM.version opam), Some "build environment definition"; ] @ OpamFile.OPAM.build_env opam) let installed_opam_opt st nv = OpamStd.Option.Op.( OpamPackage.Map.find_opt nv st.installed_opams >>+ fun () -> OpamSwitchState.opam_opt st nv ) let removal_needs_download st nv = match installed_opam_opt st nv with | None -> if not (OpamFile.exists (OpamPath.Switch.changes st.switch_global.root st.switch nv.name)) then OpamConsole.warning "No opam or changes file found to remove package %s. Stale files may \ remain." (OpamPackage.to_string nv); false | Some opam -> not (OpamFile.OPAM.has_flag Pkgflag_LightUninstall opam || OpamFilter.commands (OpamPackageVar.resolve ~opam st) (OpamFile.OPAM.remove opam) = []) let get_wrappers t = OpamFile.Wrappers.add ~outer:(OpamFile.Config.wrappers t.switch_global.config) ~inner:(OpamFile.Switch_config.wrappers t.switch_config) let get_wrapper t opam wrappers ?local getter = let root = t.switch_global.root in let hook_vnam = OpamVariable.of_string "hooks" in let hook_vval = Some (OpamVariable.dirname (OpamPath.hooks_dir root)) in let local_env = match local with | Some e -> OpamVariable.Map.add hook_vnam hook_vval e | None ->OpamVariable.Map.singleton hook_vnam hook_vval in OpamFilter.commands (OpamPackageVar.resolve ~local:local_env ~opam t) (getter wrappers) |> OpamStd.List.filter_map (function | [] -> None | cmd::args -> Some (cmd, args)) let cmd_wrapper t opam wrappers getter cmd args = match get_wrapper t opam wrappers getter @ [cmd, args] with | (cmd, args) :: r -> cmd, args @ List.concat (List.map (fun (c, a) -> c::a) r) | [] -> assert false let opam_local_env_of_status ret = OpamVariable.Map.singleton (OpamVariable.of_string "error-code") (Some (S (match ret with | None -> "0" | Some r -> string_of_int r.OpamProcess.r_code))) let make_command st opam ?dir ?text_command (cmd, args) = let nv = OpamFile.OPAM.package opam in let name = OpamPackage.name_to_string nv in let env = OpamTypesBase.env_array (compilation_env st opam) in let dir = OpamStd.Option.map OpamFilename.Dir.to_string dir in let text = let cmd, args = OpamStd.Option.default (cmd, args) text_command in OpamProcess.make_command_text name ~args cmd in let context = let open OpamStd.Option.Op in String.concat " | " [ OpamVersion.(to_string current); (OpamSysPoll.os () +! "unknown") ^"/"^ (OpamSysPoll.arch () +! "unknown"); (OpamStd.List.concat_map " " OpamPackage.to_string OpamPackage.Set.(elements @@ inter st.compiler_packages st.installed_roots)); if OpamPackage.Set.mem nv st.pinned then match OpamFile.OPAM.get_url opam with | None -> "pinned" | Some u -> let src = OpamPath.Switch.pinned_package st.switch_global.root st.switch nv.name in let rev = OpamProcess.Job.run (OpamRepository.revision src u) in Printf.sprintf "pinned(%s%s)" (OpamUrl.to_string u) (OpamStd.Option.to_string (fun r -> "#"^OpamPackage.Version.to_string r) rev) else match OpamRepositoryState.find_package_opt st.switch_repos (OpamSwitchState.repos_list st) nv with | None -> "no repo" | Some (r, _) -> let rt = st.switch_repos in let repo = OpamRepositoryName.Map.find r rt.repositories in let stamp = OpamFile.Repo.stamp (OpamRepositoryName.Map.find r rt.repos_definitions) in OpamUrl.to_string repo.repo_url ^ OpamStd.Option.to_string (fun s -> "#"^s) stamp ] in OpamSystem.make_command ~env ~name ?dir ~text ~resolve_path:OpamStateConfig.(not !r.dryrun) ~metadata:["context", context] ~verbose:(OpamConsole.verbose ()) cmd args let remove_commands t nv = match installed_opam_opt t nv with | None -> log "No opam file was found for removing %a\n" (slog OpamPackage.to_string) nv; [] | Some opam -> OpamFilter.commands (OpamPackageVar.resolve ~opam t) (OpamFile.OPAM.remove opam) |> OpamStd.List.filter_map (function [] -> None | cmd::args -> Some (cmd,args)) (* Testing wether a package removal will be a NOOP. *) let noop_remove_package t nv = let name = nv.name in let has_remove_commands = remove_commands t nv <> [] in let has_tracked_files = let changes_file = OpamPath.Switch.changes t.switch_global.root t.switch name in match OpamFile.Changes.read_opt changes_file with | Some map -> not (OpamStd.String.Map.is_empty map) | None -> let install_file = OpamPath.Switch.install t.switch_global.root t.switch name in OpamFile.exists install_file in not (has_remove_commands || has_tracked_files) (* Remove a given package *) let remove_package_aux t ?(silent=false) ?changes ?force ?build_dir nv = log "Removing %a" (slog OpamPackage.to_string) nv; let name = nv.name in let root = t.switch_global.root in (* There are three uninstall stages: 1. execute the package's remove script 2. remove remaining files listed in the .install file 3. remove remaining files added in the changes file (or changes parameter) The 3. step alone could be sufficient, but: - changes only revert additions, not any file changes, so 1. is needed - the remove script might take extra actions (stop daemon...) - existing installs don't have .changes files yet - 1st and 2nd steps may help recover partial/failed states *) let dot_install = OpamPath.Switch.install root t.switch name in let changes_file = OpamPath.Switch.changes root t.switch name in let opam = match installed_opam_opt t nv with | Some o -> o | None -> OpamFile.OPAM.create nv in (* Remove the installed plugin, if it matches *) if OpamFile.OPAM.has_flag Pkgflag_Plugin opam then ( let link = OpamPath.plugin_bin root name in let bin = OpamFilename.create (OpamPath.Switch.bin root t.switch t.switch_config) (OpamFilename.basename link) in if OpamFilename.exists link && OpamFilename.readlink link = bin then OpamFilename.remove link ); (* handle .install file *) let uninstall_files () = let install = OpamFile.Dot_install.safe_read dot_install in let remove_files dst_fn files = let files = files install in let dst_dir = dst_fn root t.switch t.switch_config in List.iter (fun (base, dst) -> let dst_file = match dst with | None -> dst_dir // Filename.basename (OpamFilename.Base.to_string base.c) | Some b -> OpamFilename.create dst_dir b in OpamFilename.remove dst_file ) files in let remove_files_and_dir dst_fn files = let dir = dst_fn root t.switch t.switch_config name in remove_files (fun _ _ _ -> dir) files; if OpamFilename.rec_files dir = [] then OpamFilename.rmdir dir in log "Removing files from .install"; remove_files OpamPath.Switch.sbin OpamFile.Dot_install.sbin; remove_files OpamPath.Switch.bin OpamFile.Dot_install.bin; remove_files_and_dir OpamPath.Switch.lib OpamFile.Dot_install.libexec; remove_files_and_dir OpamPath.Switch.lib OpamFile.Dot_install.lib; remove_files OpamPath.Switch.stublibs OpamFile.Dot_install.stublibs; remove_files_and_dir OpamPath.Switch.share OpamFile.Dot_install.share; remove_files OpamPath.Switch.share_dir OpamFile.Dot_install.share_root; remove_files_and_dir OpamPath.Switch.etc OpamFile.Dot_install.etc; remove_files (OpamPath.Switch.man_dir ?num:None) OpamFile.Dot_install.man; remove_files_and_dir OpamPath.Switch.doc OpamFile.Dot_install.doc; (* Remove the misc files *) log "Removing the misc files"; List.iter (fun (_,dst) -> if OpamFilename.exists dst then begin OpamConsole.msg "Removing %s." (OpamFilename.to_string dst); if OpamConsole.confirm "Continue?" then OpamFilename.remove dst end ) (OpamFile.Dot_install.misc install); in let revert_changes () = let changes = match changes with | None -> OpamFile.Changes.read_opt changes_file | some -> some in let title = Printf.sprintf "While removing %s" (OpamPackage.to_string nv) in OpamStd.Option.iter (OpamDirTrack.revert ~title ~verbose:(not silent) ?force (OpamPath.Switch.root root t.switch)) changes in (* Run the remove script *) let build_dir = OpamStd.Option.default_map (OpamFilename.opt_dir (OpamPath.Switch.remove root t.switch nv)) build_dir in let wrappers = get_wrappers t in let mk_cmd = make_command t opam ?dir:build_dir in OpamProcess.Job.of_fun_list ~keep_going:true (List.map (fun cmd () -> mk_cmd cmd) (get_wrapper t opam wrappers OpamFile.Wrappers.pre_remove)) @@+ fun error_pre -> OpamProcess.Job.of_fun_list ~keep_going:true (List.map (fun ((cmd,args) as ca) () -> mk_cmd ~text_command:ca @@ cmd_wrapper t opam wrappers OpamFile.Wrappers.wrap_remove cmd args) (remove_commands t nv)) @@+ fun error -> (* Remove according to the .install file *) if not OpamStateConfig.(!r.dryrun) then ( OpamFilename.remove (OpamFile.filename (OpamPath.Switch.config root t.switch nv.name)); uninstall_files (); OpamFilename.remove (OpamFile.filename dot_install) ); (* Run the post-remove commands *) let local = opam_local_env_of_status OpamStd.Option.Op.(error_pre ++ error >>| snd) in OpamProcess.Job.of_fun_list ~keep_going:true (List.map (fun cmd () -> mk_cmd cmd) (get_wrapper t opam wrappers ~local OpamFile.Wrappers.post_remove)) @@+ fun error_post -> (* Revert remaining changes *) if not OpamStateConfig.(!r.dryrun) then ( revert_changes (); OpamFilename.remove (OpamFile.filename changes_file); ); if silent then Done () else match OpamStd.Option.Op.(error_pre ++ error ++ error_post) with | Some (cmd, e) -> OpamConsole.warning "package uninstall script failed at %s:\n%s" (OpamProcess.string_of_command cmd) (OpamProcess.string_of_result e); Done () | None -> OpamConsole.msg "%s removed %s.%s\n" (if not (OpamConsole.utf8 ()) then "->" else OpamActionGraph.(action_color (`Remove ()) (action_strings (`Remove ())))) (OpamConsole.colorise `bold (OpamPackage.name_to_string nv)) (OpamPackage.version_to_string nv); Done () (* Removes build dir and source cache of package if unneeded *) let cleanup_package_artefacts t nv = log "Cleaning up artefacts of %a" (slog OpamPackage.to_string) nv; let build_dir = OpamPath.Switch.build t.switch_global.root t.switch nv in if not OpamClientConfig.(!r.keep_build_dir) then OpamFilename.rmdir build_dir; let remove_dir = OpamPath.Switch.remove t.switch_global.root t.switch nv in if OpamFilename.exists_dir remove_dir then OpamFilename.rmdir remove_dir; let dev_dir = OpamSwitchState.source_dir t nv in if OpamPackage.Set.mem nv t.installed then (if not (OpamSwitchState.is_dev_package t nv) then OpamFilename.rmdir dev_dir) else (log "Removing the local metadata"; OpamSwitchAction.remove_metadata t (OpamPackage.Set.singleton nv); if not (OpamPackage.Set.mem nv t.pinned) then OpamFilename.rmdir dev_dir) let sources_needed st g = PackageActionGraph.fold_vertex (fun act acc -> match act with | `Remove nv -> if removal_needs_download st nv then OpamPackage.Set.add nv acc else acc | `Install nv -> OpamPackage.Set.add nv acc | _ -> assert false) g OpamPackage.Set.empty let remove_package t ?silent ?changes ?force ?build_dir nv = if OpamClientConfig.(!r.fake) || OpamClientConfig.(!r.show) then Done (OpamConsole.msg "Would remove: %s.\n" (OpamPackage.to_string nv)) else remove_package_aux t ?silent ?changes ?force ?build_dir nv let local_vars ~test ~doc = OpamVariable.Map.of_list [ OpamVariable.of_string "with-test", Some (B test); OpamVariable.of_string "with-doc", Some (B doc); ] let build_package t ?(test=false) ?(doc=false) build_dir nv = let opam = OpamSwitchState.opam t nv in let commands = OpamFilter.commands (OpamPackageVar.resolve ~opam ~local:(local_vars ~test ~doc) t) (OpamFile.OPAM.build opam) @ (if test then OpamFilter.commands (OpamPackageVar.resolve ~opam t) (OpamFile.OPAM.run_test opam) else []) @ (if doc then OpamFilter.commands (OpamPackageVar.resolve ~opam t) (OpamFile.OPAM.deprecated_build_doc opam) else []) |> OpamStd.List.filter_map (function | [] -> None | cmd::args -> Some (cmd, args)) in let name = OpamPackage.name_to_string nv in let wrappers = get_wrappers t in let mk_cmd = make_command t opam ~dir:build_dir in OpamProcess.Job.of_fun_list (List.map (fun cmd () -> mk_cmd cmd) (get_wrapper t opam wrappers OpamFile.Wrappers.pre_build) @ List.map (fun ((cmd,args) as ca) () -> mk_cmd ~text_command:ca @@ cmd_wrapper t opam wrappers OpamFile.Wrappers.wrap_build cmd args) commands) @@+ fun result -> let local = opam_local_env_of_status OpamStd.Option.Op.(result >>| snd) in OpamProcess.Job.of_fun_list ~keep_going:true (List.map (fun cmd () -> mk_cmd cmd) (get_wrapper t opam wrappers ~local OpamFile.Wrappers.post_build)) @@+ fun post_result -> match result, post_result with | Some (cmd, result), _ | None, Some (cmd, result) -> OpamConsole.error "The compilation of %s failed at %S." name (OpamProcess.string_of_command cmd); Done (Some (OpamSystem.Process_error result)) | None, None -> if commands <> [] && OpamConsole.verbose () then OpamConsole.msg "%s compiled %s.%s\n" (if not (OpamConsole.utf8 ()) then "->" else OpamActionGraph. (action_color (`Build ()) (action_strings (`Build ())))) (OpamConsole.colorise `bold name) (OpamPackage.version_to_string nv); Done None (* Assumes the package has already been compiled in its build dir. Does not register the installation in the metadata! *) let install_package t ?(test=false) ?(doc=false) ?build_dir nv = let opam = OpamSwitchState.opam t nv in let commands = OpamFile.OPAM.install opam |> OpamFilter.commands (OpamPackageVar.resolve ~opam ~local:(local_vars ~test ~doc) t) |> OpamStd.List.filter_map (function [] -> None | cmd::args -> Some (cmd, args)) in let name = OpamPackage.name_to_string nv in let dir = match build_dir with | None -> OpamPath.Switch.build t.switch_global.root t.switch nv | Some d -> d in let wrappers = get_wrappers t in let mk_cmd = make_command t opam ~dir in let rec run_commands = function | (cmd,args as ca)::commands -> mk_cmd ~text_command:ca (cmd_wrapper t opam wrappers OpamFile.Wrappers.wrap_install cmd args) @@> fun result -> if OpamFile.OPAM.has_flag Pkgflag_Verbose opam then List.iter (OpamConsole.msg "%s\n") result.OpamProcess.r_stdout; if OpamProcess.is_success result then run_commands commands else ( OpamConsole.error "The installation of %s failed at %S." name (String.concat " " (cmd::args)); Done (Some (OpamSystem.Process_error result)) ) | [] -> Done None in let install_job () = (* let text = OpamProcess.make_command_text name "install" in * OpamProcess.Job.with_text text *) OpamProcess.Job.of_fun_list (List.map (fun cmd () -> mk_cmd cmd) (get_wrapper t opam wrappers OpamFile.Wrappers.pre_install)) @@+ fun error -> (match error with | None -> run_commands commands | Some (_, result) -> Done (Some (OpamSystem.Process_error result))) @@| function | Some e -> Some e | None -> try process_dot_install t nv dir; None with e -> Some e in let post_install error changes = let local = let added = let open OpamDirTrack in OpamStd.List.filter_map (function | name, (Added _|Contents_changed _|Kind_changed _) -> Some name | _ -> None) (OpamStd.String.Map.bindings changes) in opam_local_env_of_status (match error with | Some (OpamSystem.Process_error r) -> Some r | _ -> None) |> OpamVariable.Map.add (OpamVariable.of_string "installed-files") (Some (L added)) in OpamProcess.Job.of_fun_list ~keep_going:true (List.map (fun cmd () -> mk_cmd cmd) (get_wrapper t opam wrappers ~local OpamFile.Wrappers.post_install)) @@+ fun error_post -> match error, error_post with | Some err, _ -> Done (Some err, changes) | None, Some (_cmd, r) -> Done (Some (OpamSystem.Process_error r), changes) | None, None -> Done (None, changes) in let root = t.switch_global.root in let switch_prefix = OpamPath.Switch.root root t.switch in let rel_meta_dir = OpamFilename.(Base.of_string (remove_prefix_dir switch_prefix (OpamPath.Switch.meta root t.switch))) in OpamDirTrack.track switch_prefix ~except:(OpamFilename.Base.Set.singleton rel_meta_dir) install_job @@+ fun (error, changes) -> post_install error changes @@+ function | Some e, changes -> remove_package t ~silent:true ~changes ~build_dir:dir nv @@+ fun () -> OpamStd.Exn.fatal e; Done (Some e) | None, changes -> let changes_f = OpamPath.Switch.changes root t.switch nv.name in OpamFile.Changes.write changes_f changes; OpamConsole.msg "%s installed %s.%s\n" (if not (OpamConsole.utf8 ()) then "->" else OpamActionGraph. (action_color (`Install ()) (action_strings (`Install ())))) (OpamConsole.colorise `bold name) (OpamPackage.version_to_string nv); if OpamFile.OPAM.has_flag Pkgflag_Plugin opam then ( let link = OpamPath.plugin_bin root (OpamPackage.name nv) in let target = OpamFilename.create (OpamPath.Switch.bin root t.switch t.switch_config) (OpamFilename.basename link) in if OpamFilename.exists target then OpamFilename.link ~relative:(not (OpamSwitch.is_external t.switch)) ~target ~link else OpamConsole.warning "%s claims to be a plugin but no %s file was found" name (OpamFilename.to_string target) ); Done None opam-2.0.5/src/client/opamListCommand.ml0000644000175000017500000006407013511367404017153 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat open OpamTypes open OpamStateTypes open OpamStd.Op open OpamPackage.Set.Op let log fmt = OpamConsole.log "LIST" fmt let slog = OpamConsole.slog type dependency_toggles = { recursive: bool; depopts: bool; build: bool; post: bool; test: bool; doc: bool; dev: bool; } let default_dependency_toggles = { recursive = false; depopts = false; build = true; post = false; test = false; doc = false; dev = false; } type pattern_selector = { case_sensitive: bool; exact: bool; glob: bool; fields: string list; ext_fields: bool; } let default_pattern_selector = { case_sensitive = false; exact = false; glob = true; fields = ["name"; "synopsis"; "descr"; "tags"]; ext_fields = false; } type selector = | Any | Installed | Root | Compiler | Available | Installable | Pinned | Depends_on of dependency_toggles * atom list | Required_by of dependency_toggles * atom list | Conflicts_with of package list | Coinstallable_with of dependency_toggles * package list | Solution of dependency_toggles * atom list | Pattern of pattern_selector * string | Atoms of atom list | Flag of package_flag | Tag of string | From_repository of repository_name list | Owns_file of filename let string_of_selector = let (%) s col = OpamConsole.colorise col s in function | Any -> "any" % `cyan | Installed -> "installed" % `cyan | Root -> "root" % `cyan | Compiler -> "base" % `cyan | Available -> "available" % `cyan | Installable -> "installable" % `cyan | Pinned -> "pinned" % `cyan | Depends_on (tog,atoms) -> Printf.sprintf "%s(%s)" ((if tog.recursive then "rec-depends-on" else "depends-on") % `blue) (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom atoms % `bold) | Required_by (tog,atoms) -> Printf.sprintf "%s(%s)" ((if tog.recursive then "rec-required-by" else "required-by") % `blue) (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom atoms % `bold) | Conflicts_with packages -> Printf.sprintf "%s(%s)" ("conflicts" % `blue) ((OpamStd.List.concat_map " " OpamPackage.to_string packages) % `bold) | Coinstallable_with (_,packages) -> Printf.sprintf "%s(%s)" ("coinstallable" % `blue) ((OpamStd.List.concat_map " " OpamPackage.to_string packages) % `bold) | Solution (_tog,atoms) -> Printf.sprintf "%s(%s)" ("solution" % `blue) (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom atoms % `bold) | Pattern (sel,str) -> let str = if sel.exact then str else Printf.sprintf "*%s*" str in let fctname = if sel.glob then "match" else "exact-match" in let fctname = match sel.fields with | [] -> Printf.sprintf "none-%s" fctname | [fld] -> Printf.sprintf "%s-%s" fld fctname | _ -> fctname in Printf.sprintf "%s(%s)" (fctname % `green) (str % `bold) | Atoms atoms -> OpamStd.List.concat_map ~left:"(" ~right:")" " | " (fun a -> OpamFormula.short_string_of_atom a % `bold) atoms | Flag fl -> Printf.sprintf "%s(%s)" ("has-flag" % `green) (OpamTypesBase.string_of_pkg_flag fl % `bold) | Tag t -> Printf.sprintf "%s(%s)" ("has-tag" % `green) (t % `bold) | From_repository r -> Printf.sprintf "%s(%s)" ("from-repository" % `magenta) (OpamStd.List.concat_map " " OpamRepositoryName.to_string r % `bold) | Owns_file f -> Printf.sprintf "%s(%s)" ("owns-file" % `magenta) (OpamFilename.prettify f % `bold) let string_of_formula = OpamFormula.string_of_formula string_of_selector let get_opam st nv = match OpamSwitchState.opam_opt st nv with | Some o -> OpamFile.OPAM.(with_name nv.OpamPackage.name (with_version nv.OpamPackage.version o)) | None -> OpamFile.OPAM.create nv let packages_of_atoms st atoms = atoms |> OpamSolution.sanitize_atom_list ~permissive:true st |> OpamFormula.packages_of_atoms (st.packages ++ st.installed) let package_dependencies st tog nv = get_opam st nv |> OpamPackageVar.all_depends ~build:tog.build ~post:tog.post ~test:tog.test ~doc:tog.doc ~dev:tog.dev ~depopts:tog.depopts st let atom_dependencies st tog atoms = atoms |> OpamFormula.packages_of_atoms (st.packages ++ st.installed) |> fun pkgs -> OpamPackage.Set.fold (fun nv acc -> OpamFormula.ors [acc; package_dependencies st tog nv]) pkgs OpamFormula.Empty let get_universe st tog = OpamSwitchState.universe st ~test:tog.test ~doc:tog.doc ~force_dev_deps:tog.dev ~requested:(OpamPackage.names_of_packages st.packages) Query let rec value_strings value = let module SS = OpamStd.String.Set in match value with | Bool _ | Int _ -> SS.empty | Ident (_, s) -> SS.singleton s | String (_, s) -> SS.singleton s | Relop (_, _, v1, v2) | Logop (_, _, v1, v2) | Env_binding (_, v1, _, v2) -> SS.union (value_strings v1) (value_strings v2) | Prefix_relop (_, _, v) | Pfxop (_, _, v) -> value_strings v | List (_, l) | Group (_, l) -> List.fold_left (fun acc v -> SS.union acc (value_strings v)) SS.empty l | Option (_, v, vl) -> List.fold_left (fun acc v -> SS.union acc (value_strings v)) (value_strings v) vl let pattern_selector patterns = let name_patt = { default_pattern_selector with exact = true; fields = ["name"] } in let version_patt = { default_pattern_selector with exact = true; fields = ["version"] } in OpamFormula.ors (List.map (fun patt -> match OpamStd.String.cut_at patt '.' with | None -> Atom (Pattern (name_patt, patt)) | Some (name, version) -> OpamFormula.ands [Atom (Pattern (name_patt, name)); Atom (Pattern (version_patt, version))]) patterns) let apply_selector ~base st = function | Any -> base | Installed -> st.installed | Root -> st.installed_roots | Compiler -> st.compiler_packages | Available -> Lazy.force st.available_packages | Installable -> OpamSolver.installable (OpamSwitchState.universe st ~requested:OpamPackage.Name.Set.empty Query) | Pinned -> OpamPinned.packages st | (Required_by ({recursive=true; _} as tog, atoms) | Depends_on ({recursive=true; _} as tog, atoms)) as direction -> let deps_fun = match direction with | Required_by _ -> OpamSolver.dependencies | Depends_on _ -> OpamSolver.reverse_dependencies | _ -> assert false in deps_fun ~depopts:tog.depopts ~build:tog.build ~post:tog.post ~installed:false ~unavailable:true (get_universe st tog) (packages_of_atoms st atoms) |> OpamPackage.Set.of_list | Required_by (tog, atoms) -> atom_dependencies st tog atoms |> OpamFormula.packages base | Depends_on (tog, atoms) -> let packages = packages_of_atoms st atoms in OpamPackage.Set.filter (fun nv -> OpamPackage.Set.exists (OpamFormula.verifies (package_dependencies st tog nv)) packages) base | Conflicts_with packages -> OpamSwitchState.conflicts_with st (OpamPackage.Set.of_list packages) (Lazy.force st.available_packages) | Coinstallable_with (tog, packages) -> let universe = get_universe st tog in let set = OpamPackage.Set.of_list packages in let universe = { universe with u_base = set; u_installed = set } in OpamSolver.installable_subset universe base | Solution (tog, atoms) -> let universe = get_universe st tog in let universe = { universe with u_installed = OpamPackage.Set.empty; u_installed_roots = OpamPackage.Set.empty } in (match OpamSolver.resolve universe ~orphans:OpamPackage.Set.empty (OpamSolver.request ~install:atoms ()) with | Success s -> OpamSolver.new_packages s | Conflicts cs -> OpamConsole.error_and_exit `No_solution "No solution%s for %s: %s" (if tog.depopts then " including optional dependencies" else "") (OpamFormula.string_of_atoms atoms) (OpamCudf.string_of_conflict st.packages (OpamSwitchState.unavailable_reason st) cs)) | Pattern (psel, pat) -> let re = if psel.glob then Re.Glob.glob ~expand_braces:true pat else Re.str pat in let re = if psel.case_sensitive then Re.case re else Re.no_case re in let re = if psel.exact then Re.seq [Re.bos; re; Re.eos] else re in let re = Re.compile re in let content_strings nv = let opam = get_opam st nv in if psel.fields = [] then List.map (fun (_,v) -> value_strings v) (OpamFile.OPAM.to_list opam) else try List.map (fun f -> match OpamFile.OPAM.print_field_as_syntax f opam with | None -> OpamStd.String.Set.empty | Some v -> value_strings v) psel.fields with Not_found -> OpamConsole.error_and_exit `Bad_arguments "Unrecognised field in selection %s" (String.concat ", " psel.fields) in OpamPackage.Set.filter (fun nv -> List.exists (OpamStd.String.Set.exists (Re.execp re)) (content_strings nv)) base | Atoms atoms -> OpamFormula.packages_of_atoms base atoms | Flag f -> OpamPackage.Set.filter (fun nv -> get_opam st nv |> OpamFile.OPAM.has_flag f) base | Tag t -> OpamPackage.Set.filter (fun nv -> get_opam st nv |> List.mem t @* OpamFile.OPAM.tags) base | From_repository repos -> let rt = st.switch_repos in let rec aux = function | [] -> OpamPackage.Set.empty | r :: rl -> let packages = OpamPackage.keys (OpamRepositoryName.Map.find r rt.repo_opams) in if List.mem r repos then OpamPackage.Set.union packages (aux rl) else OpamPackage.Set.diff (aux rl) packages in aux (OpamSwitchState.repos_list st) | Owns_file file -> (try let root = st.switch_global.root in let switch = List.find (fun sw -> OpamFilename.remove_prefix (OpamPath.Switch.root root sw) file <> OpamFilename.to_string file) (OpamFile.Config.installed_switches st.switch_global.config) in let rel_name = OpamFilename.remove_prefix (OpamPath.Switch.root root switch) file in let matching_change_files = List.filter (fun change_f -> OpamFilename.check_suffix change_f ".changes" && let changes = OpamFile.Changes.safe_read (OpamFile.make change_f) in OpamStd.String.Map.exists (fun f -> function | OpamDirTrack.Removed -> false | _ -> rel_name = f) changes) (OpamFilename.files (OpamPath.Switch.install_dir root switch)) in let selections = if switch = st.switch then OpamSwitchState.selections st else OpamSwitchState.load_selections st.switch_global switch in List.fold_left (fun acc f -> let name = OpamPackage.Name.of_string @@ OpamFilename.(Base.to_string (basename (chop_extension f))) in try OpamPackage.Set.add (OpamPackage.package_of_name selections.sel_installed name) acc with Not_found -> acc) OpamPackage.Set.empty matching_change_files with Not_found -> log "%a doesn't belong to a known opam switch" (slog OpamFilename.to_string) file; OpamPackage.Set.empty) let rec filter ~base st = function | Empty -> base | Atom select -> apply_selector ~base st select | Block b -> filter ~base st b | And (a, b) -> let base = filter ~base st a in base %% filter ~base st b | Or (a, b) -> filter ~base st a ++ filter ~base st b type output_format = | Name | Version | Package | Synopsis | Synopsis_or_target | Description | Field of string | Installed_version | Pinning_target | Source_hash | Raw | All_installed_versions | Available_versions | All_versions | Repository | Installed_files | VC_ref | Depexts let default_list_format = [Name; Installed_version; Synopsis_or_target] let disp_header = function | Name -> "Name" | Version -> "Version" | Package -> "Package" | Synopsis | Synopsis_or_target -> "Synopsis" | Description -> "Description" | Field s -> String.capitalize_ascii s | Installed_version -> "Installed" | Pinning_target -> "Pin" | Source_hash -> "Source hash" | Raw -> "Metadata" | All_installed_versions -> "Installed versions" | Available_versions -> "Available versions" | All_versions -> "Versions" | Repository -> "Repository" | Installed_files -> "Installed files" | VC_ref -> "VC ref" | Depexts -> "Depexts" let field_names = [ Name, "name"; Version, "version"; Package, "package"; Synopsis, "synopsis"; Synopsis_or_target, "synopsis-or-target"; Description, "description"; Field "", ":"; Installed_version, "installed-version"; Pinning_target, "pin"; Source_hash, "source-hash"; Raw, "opam-file"; All_installed_versions, "all-installed-versions"; Available_versions, "available-versions"; All_versions, "all-versions"; Repository, "repository"; Installed_files, "installed-files"; VC_ref, "vc-ref"; Depexts, "depexts"; ] let string_of_field = function | Field s -> s^":" | f -> List.assoc f field_names let field_of_string = let names_fields = List.map (fun (a,b) -> b, a) field_names in fun s -> if OpamStd.String.ends_with ~suffix:":" s then Field (OpamStd.String.remove_suffix ~suffix:":" s) else try List.assoc s names_fields with Not_found -> OpamConsole.error_and_exit `Bad_arguments "No printer for %S%s" s (if not (OpamStd.String.ends_with ~suffix:":" s) && List.mem_assoc s (OpamFile.OPAM.fields) then Printf.sprintf ". Did you mean the opam field \"%s:\" \ (with a colon)?" s else "") let version_color st nv = let installed = (* (in any switch) *) OpamGlobalState.installed_versions st.switch_global nv.name in let is_available nv = (* Ignore unavailability due to pinning *) try OpamFilter.eval_to_bool ~default:false (OpamPackageVar.resolve_switch_raw ~package:nv st.switch_global st.switch st.switch_config) (OpamFile.OPAM.available (get_opam st nv)) with Not_found -> false in if OpamPackage.Set.mem nv st.installed then [`bold;`magenta] else (if OpamPackage.Map.mem nv installed then [`bold] else []) @ (if is_available nv then [] else [`crossed;`red]) let mini_field_printer ?(prettify=false) ?(normalise=false) = if normalise then OpamPrinter.Normalise.value else function | String (_, s) when prettify -> s | List (_, l) when prettify && List.for_all (function String _ -> true | _ -> false) l -> OpamStd.List.concat_map ", " (function String (_, s) -> s | _ -> assert false) l | List (_, l) -> OpamPrinter.value_list l | f -> OpamPrinter.Normalise.value f let detail_printer ?prettify ?normalise st nv = let open OpamStd.Option.Op in let (%) s cols = OpamConsole.colorise' cols s in let root_sty = if OpamPackage.Set.mem nv st.installed_roots then [`underline] else [] in function | Name -> OpamPackage.Name.to_string nv.name % (`bold :: root_sty) | Version -> OpamPackage.Version.to_string nv.version % version_color st nv | Package -> (OpamPackage.name_to_string nv % (`bold :: root_sty)) ^ ("." ^ OpamPackage.version_to_string nv) % root_sty | Synopsis -> (get_opam st nv |> OpamFile.OPAM.descr >>| OpamFile.Descr.synopsis) +! "" | Synopsis_or_target -> (match OpamPinned.package_opt st nv.name with | Some nv -> let opam = get_opam st nv in if Some opam = OpamPackage.Map.find_opt nv st.repos_package_index then Printf.sprintf "pinned to version %s" (OpamPackage.Version.to_string nv.version % [`blue]) else Printf.sprintf "pinned to version %s at %s" (OpamPackage.Version.to_string nv.version % [`blue]) (OpamStd.Option.to_string ~none:"(local metadata only)" (fun u -> OpamUrl.to_string u % [`underline]) (OpamFile.OPAM.get_url opam)) | None -> (get_opam st nv |> OpamFile.OPAM.descr >>| OpamFile.Descr.synopsis) +! "") | Description -> (get_opam st nv |> OpamFile.OPAM.descr >>| OpamFile.Descr.body) +! "" | Field f -> (try List.assoc f (OpamFile.OPAM.to_list (get_opam st nv)) |> mini_field_printer ?prettify ?normalise with Not_found -> "") | Installed_version -> (try OpamPackage.package_of_name st.installed nv.name |> fun inst_nv -> OpamPackage.version_to_string inst_nv |> fun s -> if OpamPackage.Set.mem inst_nv st.pinned then s % [`blue] else if OpamPackage.has_name st.pinned nv.name then s % [`bold;`red] else if nv <> inst_nv && not (OpamPackage.Set.mem inst_nv st.compiler_packages) then s % [`bold;`yellow] else s % [`magenta] with Not_found -> "--" % [`cyan]) | Pinning_target -> if OpamPackage.Set.mem nv st.pinned then let opam = get_opam st nv in OpamStd.Option.to_string ~none:"--" OpamUrl.to_string (OpamFile.OPAM.get_url opam) else "" | Source_hash -> let hash_opt = let open OpamStd.Option.Op in OpamSwitchState.url st nv >>| OpamFile.URL.url >>= fun url -> OpamSwitchState.source_dir st nv |> OpamFilename.opt_dir >>= fun srcdir -> OpamProcess.Job.run (OpamRepository.revision srcdir url) >>| OpamPackage.Version.to_string in OpamStd.Option.default "" hash_opt | Raw -> OpamFile.OPAM.write_to_string (get_opam st nv) | All_installed_versions -> OpamGlobalState.installed_versions st.switch_global nv.name |> OpamPackage.Map.mapi (fun nv switches -> Printf.sprintf "%s [%s]" (OpamPackage.version_to_string nv % version_color st nv) (String.concat " " (List.map OpamSwitch.to_string switches))) |> OpamPackage.Map.values |> String.concat " " | Available_versions -> let available = OpamPackage.packages_of_name (Lazy.force st.available_packages) nv.name in OpamStd.List.concat_map " " (fun nv -> OpamPackage.Version.to_string nv.version % version_color st nv) (OpamPackage.Set.elements available) | All_versions -> let pkgs = OpamPackage.packages_of_name st.packages nv.name in OpamStd.List.concat_map " " (fun nv -> OpamPackage.Version.to_string nv.version % version_color st nv) (OpamPackage.Set.elements pkgs) | Repository -> OpamRepositoryState.find_package_opt st.switch_repos (OpamSwitchState.repos_list st) nv |> OpamStd.Option.to_string (fun (r, _) -> OpamRepositoryName.to_string r) | Installed_files -> let changes_f = OpamPath.Switch.changes st.switch_global.root st.switch nv.name in (match OpamFile.Changes.read_opt changes_f with | None -> "" | Some c -> OpamStd.Format.itemize ~bullet:"" (fun (file, status) -> OpamFilename.to_string file ^ match status with | `Unchanged -> "" | `Removed -> " (absent)" % [`red] | `Changed -> " (modified since)" % [`yellow]) (OpamDirTrack.check (OpamPath.Switch.root st.switch_global.root st.switch) c)) | VC_ref -> OpamStd.Option.Op.( (OpamSwitchState.url st nv >>| OpamFile.URL.url >>= fun url -> url.OpamUrl.hash) +! "" ) | Depexts -> String.concat " " (OpamStd.String.Set.elements (OpamSwitchState.depexts st nv)) type package_listing_format = { short: bool; header: bool; columns: output_format list; all_versions: bool; wrap: [`Wrap of string | `Truncate | `None] option; separator: string; value_printer: [`Normal | `Pretty | `Normalised]; order: [`Standard | `Dependency | `Custom of package -> package -> int]; } let default_package_listing_format = { short = false; header = true; columns = default_list_format; all_versions = false; wrap = None; separator = " "; value_printer = `Normal; order = `Standard; } let display st format packages = let packages = if format.all_versions then packages else OpamPackage.Name.Set.fold (fun name -> let pkgs = OpamPackage.packages_of_name packages name in let nv = let get = OpamPackage.Set.max_elt in try get (pkgs %% st.installed) with Not_found -> try get (pkgs %% st.pinned) with Not_found -> try get (pkgs %% Lazy.force st.available_packages) with Not_found -> get pkgs in OpamPackage.Set.add nv) (OpamPackage.names_of_packages packages) OpamPackage.Set.empty in let packages = if format.order = `Dependency then let universe = OpamSwitchState.universe st ~requested:(OpamPackage.names_of_packages packages) Query in let deps_packages = OpamSolver.dependencies ~depopts:true ~installed:false ~unavailable:true ~build:true ~post:false universe packages in List.filter (fun nv -> OpamPackage.Set.mem nv packages) deps_packages |> List.rev else match format.order with | `Custom o -> List.sort o (OpamPackage.Set.elements packages) | _ -> OpamPackage.Set.elements packages in let add_head l = if format.header then (List.map (fun f -> "# "^disp_header f) format.columns) :: l else l in let prettify = format.value_printer = `Pretty in let normalise = format.value_printer = `Normalised in if packages = [] then (if format.header then OpamConsole.errmsg "%s\n" (OpamConsole.colorise `red "# No matches found")) else List.rev_map (fun nv -> List.map (detail_printer ~prettify ~normalise st nv) format.columns) packages |> List.rev |> add_head |> OpamStd.Format.align_table |> OpamConsole.print_table ?cut:format.wrap stdout ~sep:format.separator let get_switch_state gt = let rt = OpamRepositoryState.load `Lock_none gt in match OpamStateConfig.get_switch_opt () with | None -> OpamSwitchState.load_virtual gt rt | Some sw -> OpamSwitchState.load `Lock_none gt rt sw let get_depexts st packages = OpamPackage.Name.Set.fold (fun name acc -> let nv = OpamSwitchState.get_package st name in let nv = if OpamPackage.Set.mem nv packages then nv else OpamPackage.Set.max_elt (OpamPackage.packages_of_name packages name) in OpamStd.String.Set.union acc (OpamSwitchState.depexts st nv)) (OpamPackage.names_of_packages packages) OpamStd.String.Set.empty let print_depexts = OpamStd.String.Set.iter (OpamConsole.msg "%s\n") let info st ~fields ~raw_opam ~where ?normalise ?(show_empty=false) atoms = let packages = OpamFormula.packages_of_atoms (st.packages ++ st.installed) atoms in if OpamPackage.Set.is_empty packages then (OpamConsole.error "No package matching %s found" (OpamStd.List.concat_map " or " OpamFormula.short_string_of_atom atoms); OpamStd.Sys.exit_because `Not_found); let fields = List.map field_of_string fields in let all_versions_fields = [ Name; All_installed_versions; All_versions; ] in let one_version_fields = [ Version; Repository; Pinning_target; Source_hash; Field "url.src"; Field "url.checksum"; Field "homepage"; Field "bug-reports"; Field "dev-repo"; Field "authors"; Field "maintainer"; Field "license"; Field "tags"; Field "flags"; Field "depends"; Field "depopts"; Field "conflicts"; Field "conflict-class"; Synopsis; Description; ] in let output_table fields nv = let tbl = List.fold_left (fun acc item -> let contents = detail_printer ?normalise st nv item in if show_empty || contents <> "" then [ OpamConsole.colorise `blue (string_of_field item); contents ] :: acc else acc) [] (List.rev fields) in OpamStd.Format.align_table tbl |> OpamConsole.print_table stdout ~sep:" "; in OpamPackage.names_of_packages packages |> OpamPackage.Name.Set.iter (fun name -> (* Like OpamSwitchState.get_package, but restricted to [packages] *) let nvs = OpamPackage.packages_of_name packages name in let choose = try OpamPackage.Set.choose (nvs %% st.pinned) with Not_found -> try OpamPackage.Set.choose (nvs %% st.installed) with Not_found -> try OpamPackage.Set.max_elt (nvs %% Lazy.force st.available_packages) with Not_found -> OpamPackage.Set.max_elt nvs in let opam = get_opam st choose in OpamFile.OPAM.print_errors opam; if where then OpamConsole.msg "%s\n" (match OpamFile.OPAM.metadata_dir opam with | Some dir -> OpamFilename.Dir.to_string OpamFilename.Op.(dir / "opam") | None -> "") else if raw_opam then OpamFile.OPAM.write_to_channel stdout opam else match fields with | [] -> OpamConsole.header_msg "%s: information on all versions" (OpamPackage.Name.to_string choose.name); output_table all_versions_fields choose; OpamConsole.header_msg "Version-specific details"; output_table one_version_fields choose | [f] -> OpamConsole.msg "%s\n" (detail_printer ?normalise st choose f) | fields -> output_table fields choose ) opam-2.0.5/src/client/opamMain.ml0000644000175000017500000002303613511367404015622 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Cmdliner open OpamTypes open OpamStateTypes open OpamTypesBase open OpamStd.Op (* Handle git-like plugins *) let check_and_run_external_commands () = let plugin_prefix = "opam-" in match Array.to_list Sys.argv with | [] | [_] -> () | _ :: ("-y" | "--yes") :: name :: args | _ :: name :: args -> if not (OpamStd.String.starts_with ~prefix:"-" name) && List.for_all (fun (_,info) -> not (OpamStd.String.starts_with ~prefix:name (Term.name info))) OpamCommands.commands then (* No such command, check if there is a matching plugin *) let command = plugin_prefix ^ name in let answer = match Sys.argv.(1) with | "-y" | "--yes" -> Some true | _ -> OpamStd.Config.env_bool "YES" in OpamStd.Config.init ~answer (); OpamFormatConfig.init (); let root_dir = OpamStateConfig.opamroot () in let has_init = OpamStateConfig.load_defaults root_dir <> None in let plugins_bin = OpamPath.plugins_bin root_dir in let env = if has_init then let updates = ["PATH", PlusEq, OpamFilename.Dir.to_string plugins_bin, None] in OpamStateConfig.init ~root_dir (); match OpamStateConfig.get_switch_opt () with | None -> env_array (OpamEnv.get_pure ~updates ()) | Some sw -> env_array (OpamEnv.full_with_path ~force_path:false ~updates root_dir sw) else Unix.environment () in match OpamSystem.resolve_command ~env command with | Some command -> let argv = Array.of_list (command :: args) in raise (OpamStd.Sys.Exec (command, argv, env)) | None when not has_init -> () | None -> (* Look for a corresponding package *) match OpamStateConfig.get_switch_opt () with | None -> () | Some sw -> OpamGlobalState.with_ `Lock_none @@ fun gt -> OpamSwitchState.with_ `Lock_none gt ~switch:sw @@ fun st -> let prefixed_name = plugin_prefix ^ name in let candidates = OpamPackage.packages_of_names (Lazy.force st.available_packages) (OpamPackage.Name.Set.of_list @@ (OpamStd.List.filter_map (fun s -> try Some (OpamPackage.Name.of_string s) with Failure _ -> None) [ prefixed_name; name ])) in let plugins = OpamPackage.Set.filter (fun nv -> OpamFile.OPAM.has_flag Pkgflag_Plugin (OpamSwitchState.opam st nv)) candidates in let installed = OpamPackage.Set.inter plugins st.installed in if OpamPackage.Set.is_empty candidates then () else if not OpamPackage.Set.(is_empty installed) then (OpamConsole.error "Plugin %s is already installed, but no %s command was found.\n\ Try upgrading, and report to the package maintainer if \ the problem persists." (OpamPackage.to_string (OpamPackage.Set.choose installed)) command; exit (OpamStd.Sys.get_exit_code `Package_operation_error)) else if OpamPackage.Set.is_empty plugins then (OpamConsole.error "%s is not a known command or plugin (package %s does \ not have the 'plugin' flag set)." name (OpamPackage.to_string (OpamPackage.Set.max_elt candidates)); exit (OpamStd.Sys.get_exit_code `Bad_arguments)) else if OpamConsole.confirm "Opam plugin \"%s\" is not installed. \ Install it on the current switch?" name then let nv = try OpamPackage.max_version plugins (OpamPackage.Name.of_string prefixed_name) with Not_found -> OpamPackage.max_version plugins (OpamPackage.Name.of_string name) in OpamRepositoryConfig.init (); OpamSolverConfig.init (); OpamClientConfig.init (); OpamSwitchState.with_ `Lock_write gt (fun st -> ignore @@ OpamClient.install st [OpamSolution.eq_atom_of_package nv] ); match OpamSystem.resolve_command ~env command with | None -> OpamConsole.error_and_exit `Package_operation_error "Plugin %s was installed, but no %s command was found.\n\ This is probably an error in the plugin package." (OpamPackage.to_string nv) command | Some command -> OpamConsole.header_msg "Carrying on to \"%s\"" (String.concat " " (Array.to_list Sys.argv)); OpamConsole.msg "\n"; let argv = Array.of_list (command :: args) in raise (OpamStd.Sys.Exec (command, argv, env)) let rec main_catch_all f = try f () with | OpamStd.Sys.Exit 0 -> () | OpamStd.Sys.Exec (cmd,args,env) -> OpamStd.Sys.exec_at_exit (); Unix.execvpe cmd args env | OpamFormatUpgrade.Upgrade_done conf -> main_catch_all @@ fun () -> OpamConsole.header_msg "Rerunning init and update"; OpamClient.reinit ~interactive:true ~update_config:false conf (OpamStd.Sys.guess_shell_compat ()); OpamConsole.msg "Update done, please now retry your command.\n"; exit (OpamStd.Sys.get_exit_code `Aborted) | e -> flush stdout; flush stderr; if (OpamConsole.verbose ()) then OpamConsole.errmsg "'%s' failed.\n" (String.concat " " (Array.to_list Sys.argv)); let exit_code = match e with | OpamStd.Sys.Exit i -> if (OpamConsole.debug ()) && i <> 0 then OpamConsole.errmsg "%s" (OpamStd.Exn.pretty_backtrace e); i | OpamSystem.Internal_error _ -> OpamConsole.errmsg "%s\n" (Printexc.to_string e); OpamStd.Sys.get_exit_code `Internal_error | OpamSystem.Process_error result -> OpamConsole.errmsg "%s Command %S failed:\n%s\n" (OpamConsole.colorise `red "[ERROR]") (try List.assoc "command" result.OpamProcess.r_info with | Not_found -> "") (Printexc.to_string e); OpamConsole.errmsg "%s" (OpamStd.Exn.pretty_backtrace e); OpamStd.Sys.get_exit_code `Internal_error | Sys.Break | OpamParallel.Errors (_, (_, Sys.Break)::_, _) -> OpamStd.Sys.get_exit_code `User_interrupt | Sys_error e when e = "Broken pipe" -> (* workaround warning 52, this is a fallback (we already handle the signal) and there is no way around at the moment *) 141 | Failure msg -> OpamConsole.errmsg "Fatal error: %s\n" msg; OpamConsole.errmsg "%s" (OpamStd.Exn.pretty_backtrace e); OpamStd.Sys.get_exit_code `Internal_error | _ -> OpamConsole.errmsg "Fatal error:\n%s\n" (Printexc.to_string e); OpamConsole.errmsg "%s" (OpamStd.Exn.pretty_backtrace e); OpamStd.Sys.get_exit_code `Internal_error in exit exit_code let run default commands = OpamStd.Option.iter OpamVersion.set_git OpamGitVersion.version; OpamSystem.init (); main_catch_all @@ fun () -> check_and_run_external_commands (); let admin, argv1 = if Array.length Sys.argv > 1 && Sys.argv.(1) = "admin" then true, Array.init (Array.length Sys.argv - 1) (function | 0 -> Sys.argv.(0) | i -> Sys.argv.(i+1)) else false, Sys.argv in let eval () = if admin then Term.eval_choice ~catch:false ~argv:argv1 OpamAdminCommand.default_subcommand OpamAdminCommand.admin_subcommands else Term.eval_choice ~catch:false ~argv:argv1 default commands in match eval () with | `Error _ -> exit (OpamStd.Sys.get_exit_code `Bad_arguments) | _ -> exit (OpamStd.Sys.get_exit_code `Success) let json_out () = match OpamClientConfig.(!r.json_out) with | None -> () | Some s -> let file_name () = match OpamStd.String.cut_at s '%' with | None -> OpamFilename.of_string s | Some (pfx, sfx) -> let rec getname i = let f = OpamFilename.of_string (Printf.sprintf "%s%d%s" pfx i sfx) in if OpamFilename.exists f then getname (i+1) else f in getname 1 in try let f = OpamFilename.open_out (file_name ()) in OpamJson.flush f; close_out f with e -> OpamConsole.warning "Couldn't write json log: %s" (Printexc.to_string e) let () = OpamStd.Sys.at_exit (fun () -> flush stderr; flush stdout; if OpamClientConfig.(!r.print_stats) then ( OpamFile.Stats.print (); OpamSystem.print_stats (); ); json_out () ); run OpamCommands.default OpamCommands.commands opam-2.0.5/src/client/manifest.sexp.in0000644000175000017500000000002413511367404016633 0ustar nicoonicoo(@CONF_MANIFEST_O@) opam-2.0.5/src/client/opamRepositoryCommand.ml0000644000175000017500000002347413511367404020422 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStateTypes open OpamStd.Op let log fmt = OpamConsole.log "REPOSITORY" fmt let update_global_selection gt update_fun = let repos = OpamFile.Config.repositories gt.config in let config = OpamFile.Config.with_repositories (update_fun repos) gt.config in let gt = { gt with config } in OpamGlobalState.write gt; gt let update_selection gt ~global ~switches update_fun = List.iter (OpamSwitchState.update_repositories gt update_fun) switches; if global then (* ensure all unselected switches aren't modified by changing the default *) (List.iter (fun sw -> if not (List.mem sw switches) then OpamSwitchState.update_repositories gt (fun r -> r) sw) (OpamFile.Config.installed_switches gt.config); let (), gt = OpamGlobalState.with_write_lock gt @@ fun gt -> (), update_global_selection gt update_fun in gt) else gt let update_repos_config rt repositories = (* Remove cached opam files for changed or removed repos *) let repo_opams = OpamRepositoryName.Map.filter (fun name _ -> OpamRepositoryName.Map.find_opt name rt.repositories = OpamRepositoryName.Map.find_opt name repositories) rt.repo_opams in let rt = { rt with repositories; repo_opams } in OpamRepositoryState.Cache.remove (); OpamRepositoryState.write_config rt; rt let add rt name url trust_anchors = log "repository-add"; let root = rt.repos_global.root in let repo_exists = OpamStd.Option.of_Not_found (OpamRepositoryName.Map.find name) rt.repositories in match repo_exists with | Some r when r.repo_url = url && (trust_anchors = r.repo_trust || trust_anchors = None) -> rt | Some r -> OpamConsole.error_and_exit `Bad_arguments "Repository %s is already set up %s. To change that, use 'opam \ repository set-url'." (OpamRepositoryName.to_string name) (if r.repo_url <> url then "and points to "^OpamUrl.to_string r.repo_url else match r.repo_trust with | None -> "without trust anchors" | Some ta -> Printf.sprintf "with trust anchors %s and quorum %d" (OpamStd.List.concat_map ~nil:"()" "," String.escaped ta.fingerprints) ta.quorum) | None -> let repo = { repo_name = name; repo_url = url; repo_root = OpamRepositoryPath.create root name; repo_trust = trust_anchors; } in if OpamFilename.exists OpamFilename.(of_string (Dir.to_string repo.repo_root)) then OpamConsole.error_and_exit `Bad_arguments "Invalid repository name, %s exists" (OpamFilename.Dir.to_string repo.repo_root); if url.OpamUrl.backend = `rsync && OpamUrl.local_dir url <> None && OpamUrl.local_dir (OpamRepositoryPath.Remote.packages_url repo.repo_url) = None && not (OpamConsole.confirm "%S doesn't contain a \"packages\" directory.\n\ Is it really the directory of your repo?" (OpamUrl.to_string url)) then OpamStd.Sys.exit_because `Aborted; OpamProcess.Job.run (OpamRepository.init root name); update_repos_config rt (OpamRepositoryName.Map.add name repo rt.repositories) let remove rt name = log "repository-remove"; let rt = update_repos_config rt (OpamRepositoryName.Map.remove name rt.repositories) in OpamRepositoryState.Cache.save rt; OpamFilename.rmdir (OpamRepositoryPath.create rt.repos_global.root name); rt let set_url rt name url trust_anchors = log "repository-set-url"; let repo = try OpamRepositoryName.Map.find name rt.repositories with Not_found -> OpamConsole.error_and_exit `Not_found "No repository %s found" (OpamRepositoryName.to_string name); in OpamFilename.cleandir (OpamRepositoryPath.create rt.repos_global.root name); let repo = { repo with repo_url = url; repo_trust = trust_anchors; } in update_repos_config rt (OpamRepositoryName.Map.add name repo rt.repositories) let print_selection rt ~short repos_list = if short then List.iter (fun r -> OpamConsole.msg "%s\n" (OpamRepositoryName.to_string r)) repos_list else List.mapi (fun i name -> [ Printf.sprintf "%2d" (i+1); OpamRepositoryName.to_string name |> OpamConsole.colorise `bold; try let r = OpamRepositoryName.Map.find name rt.repositories in if r.repo_url = OpamUrl.empty then "-" else OpamUrl.to_string r.repo_url |> OpamConsole.colorise `underline with Not_found -> "not found" |> OpamConsole.colorise `red ]) repos_list |> OpamStd.Format.align_table |> OpamConsole.print_table stdout ~sep:" " let switch_repos rt sw = let switch_config = OpamFile.Switch_config.safe_read (OpamPath.Switch.switch_config rt.repos_global.root sw) in match switch_config.OpamFile.Switch_config.repos with | None -> OpamGlobalState.repos_list rt.repos_global | Some rl -> rl let list rt ~global ~switches ~short = if global then (let repos = OpamGlobalState.repos_list rt.repos_global in if not short then OpamConsole.header_msg "Default repository configuration (for newly created switches)"; print_selection rt ~short repos); List.iter (fun sw -> if not short then OpamConsole.header_msg "Repository configuration for switch %s" (OpamSwitch.to_string sw); print_selection rt ~short (switch_repos rt sw)) switches let list_all rt ~short = log "repository-list"; if short then OpamRepositoryName.Map.iter (fun r _ -> OpamConsole.msg "%s\n" (OpamRepositoryName.to_string r)) rt.repositories else let repos_switches, _ = List.fold_left (fun (acc,i) repo -> OpamRepositoryName.Map.add repo [None, i] acc, i + 1) (OpamRepositoryName.Map.empty, 1) (OpamGlobalState.repos_list rt.repos_global) in let repos_switches = List.fold_left (fun acc sw -> let acc,_ = List.fold_left (fun (acc,i) repo -> OpamRepositoryName.Map.update repo (fun s -> (Some sw, i)::s) [] acc, i + 1) (acc,1) (switch_repos rt sw) in acc) repos_switches (OpamFile.Config.installed_switches rt.repos_global.config) in let cols = List.map (OpamConsole.colorise `blue) ["# Repository"; "# Url"; "# Switches(rank)"] in let lines = OpamRepositoryName.Map.mapi (fun name repo -> [ OpamRepositoryName.to_string name |> OpamConsole.colorise `bold; OpamUrl.to_string repo.repo_url; OpamStd.List.concat_map " " (fun (sw,i) -> OpamStd.Option.to_string ~none:"" OpamSwitch.to_string sw ^ (Printf.sprintf "(%d)" i |> OpamConsole.colorise `yellow)) (List.rev (try OpamRepositoryName.Map.find name repos_switches with Not_found -> [])); ]) rt.repositories in cols :: OpamRepositoryName.Map.values lines |> OpamStd.Format.align_table |> OpamConsole.print_table stdout ~sep:" " let update_with_auto_upgrade rt repo_names = let repos = List.map (OpamRepositoryState.get_repo rt) repo_names in let failed, rt = OpamUpdate.repositories rt repos in let failed = List.map (fun r -> r.repo_name) failed in if OpamFormatConfig.(!r.skip_version_checks) || OpamClientConfig.(!r.no_auto_upgrade) then failed, rt else let rt, done_upgrade = List.fold_left (fun (rt, done_upgrade) r -> if List.mem r.repo_name failed then rt, done_upgrade else let def = OpamRepositoryName.Map.find r.repo_name rt.repos_definitions in let need_upgrade = match OpamFile.Repo.opam_version def with | None -> OpamConsole.note "Repository at %s doesn't define its version, assuming it's 1.2." (OpamUrl.to_string r.repo_url); true | Some v when OpamVersion.compare v OpamAdminRepoUpgrade.upgradeto_version < 0 -> true | _ -> false in if need_upgrade then (if not done_upgrade then (OpamConsole.header_msg "Upgrading repositories from older opam format"; OpamRepositoryState.Cache.remove ()); OpamConsole.msg "Upgrading repository \"%s\"...\n" (OpamRepositoryName.to_string r.repo_name); OpamAdminRepoUpgrade.do_upgrade r.repo_root; let def = OpamFile.Repo.safe_read (OpamRepositoryPath.repo r.repo_root) |> OpamFile.Repo.with_root_url r.repo_url in let opams = OpamRepositoryState.load_repo_opams r in let rt = { rt with repos_definitions = OpamRepositoryName.Map.add r.repo_name def rt.repos_definitions; repo_opams = OpamRepositoryName.Map.add r.repo_name opams rt.repo_opams; } in rt, true) else rt, done_upgrade) (rt, false) repos in if done_upgrade then OpamRepositoryState.Cache.save rt; failed, rt opam-2.0.5/src/client/opamSolution.ml0000644000175000017500000010317013511367404016550 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) let log fmt = OpamConsole.log "SOLUTION" fmt open OpamTypes open OpamTypesBase open OpamStateTypes open OpamProcess.Job.Op module PackageAction = OpamSolver.Action module PackageActionGraph = OpamSolver.ActionGraph let post_message ?(failed=false) st action = match action, failed with | `Remove _, _ | `Reinstall _, _ | `Build _, false -> () | `Build pkg, true | `Install pkg, _ | `Change (_,_,pkg), _ -> let opam = OpamSwitchState.opam st pkg in let messages = OpamFile.OPAM.post_messages opam in let local_variables = OpamVariable.Map.empty in let local_variables = OpamVariable.Map.add (OpamVariable.of_string "success") (Some (B (not failed))) local_variables in let local_variables = OpamVariable.Map.add (OpamVariable.of_string "failure") (Some (B failed)) local_variables in let messages = let filter_env = OpamPackageVar.resolve ~opam ~local:local_variables st in OpamStd.List.filter_map (fun (message,filter) -> if OpamFilter.opt_eval_to_bool filter_env filter then Some (OpamFilter.expand_string ~default:(fun _ -> "") filter_env message) else None) messages in let mark = OpamConsole.colorise (if failed then `red else `green) "=> " in if messages <> [] then ( OpamConsole.header_msg "%s %s" (OpamPackage.to_string pkg) (if failed then "troubleshooting" else "installed successfully"); List.iter (fun msg -> OpamConsole.formatted_msg ~indent:(OpamStd.Format.visual_length mark) "%s%s\n" mark msg) messages ) let print_depexts_helper st actions = let depexts = List.fold_left (fun depexts -> function | `Build nv -> OpamStd.String.Set.union depexts (OpamSwitchState.depexts st nv) | _ -> depexts) OpamStd.String.Set.empty actions in if not (OpamStd.String.Set.is_empty depexts) then ( OpamConsole.formatted_msg "\nThe packages you requested declare the following system dependencies. \ Please make sure they are installed before retrying:\n"; OpamConsole.formatted_msg ~indent:4 " %s\n\n" (OpamStd.List.concat_map " " (OpamConsole.colorise `bold) (OpamStd.String.Set.elements depexts)) ) let check_solution ?(quiet=false) st = function | No_solution -> OpamConsole.msg "No solution found, exiting\n"; OpamStd.Sys.exit_because `No_solution | Partial_error (success, failed, _remaining) -> List.iter (post_message st) success; List.iter (post_message ~failed:true st) failed; print_depexts_helper st failed; OpamEnv.check_and_print_env_warning st; OpamStd.Sys.exit_because `Package_operation_error | OK actions -> List.iter (post_message st) actions; OpamEnv.check_and_print_env_warning st | Nothing_to_do -> if not quiet then OpamConsole.msg "Nothing to do.\n"; OpamEnv.check_and_print_env_warning st | Aborted -> if not OpamClientConfig.(!r.show) then OpamStd.Sys.exit_because `Aborted let sum stats = stats.s_install + stats.s_reinstall + stats.s_remove + stats.s_upgrade + stats.s_downgrade let eq_atom name version = name, Some (`Eq, version) let eq_atom_of_package nv = eq_atom nv.name nv.version let eq_atoms_of_packages set = List.rev_map eq_atom_of_package (OpamPackage.Set.elements set) let atom_of_package nv = nv.name, None let atoms_of_packages set = List.rev_map (fun n -> n, None) (OpamPackage.Name.Set.elements (OpamPackage.names_of_packages set)) (* unused? let atom_of_name name = name, None *) let check_availability ?permissive t set atoms = let available = OpamPackage.to_map set in let check_atom (name, cstr as atom) = let exists = try OpamPackage.Version.Set.exists (fun v -> OpamFormula.check atom (OpamPackage.create name v)) (OpamPackage.Name.Map.find name available) with Not_found -> false in if exists then None else if permissive = Some true then Some (OpamSwitchState.not_found_message t atom) else let f = name, match cstr with None -> Empty | Some c -> Atom c in Some (Printf.sprintf "%s %s" (OpamFormula.to_string (Atom f)) (OpamSwitchState.unavailable_reason ~default:"unavailable for unknown reasons (this may be a bug in \ opam)" t f)) in let errors = OpamStd.List.filter_map check_atom atoms in if errors <> [] then (List.iter (OpamConsole.error "%s") errors; OpamStd.Sys.exit_because `Not_found) let fuzzy_name t name = let lname = String.lowercase_ascii (OpamPackage.Name.to_string name) in let match_name nv = lname = String.lowercase_ascii (OpamPackage.name_to_string nv) in let matches = OpamPackage.Set.union (OpamPackage.Set.filter match_name t.installed) (OpamPackage.Set.filter match_name t.packages) in let names = OpamPackage.names_of_packages matches in match OpamPackage.Name.Set.elements names with | [name] -> name | _ -> name let sanitize_atom_list ?(permissive=false) t atoms = let atoms = List.map (fun (name,cstr) -> fuzzy_name t name, cstr) atoms in if permissive then check_availability ~permissive t (OpamPackage.Set.union t.packages t.installed) atoms else check_availability t (OpamPackage.Set.union (Lazy.force t.available_packages) t.installed) atoms; atoms (* Pretty-print errors *) let display_error (n, error) = let f action nv = let disp = OpamConsole.header_error "while %s %s" action (OpamPackage.to_string nv) in match error with | Sys.Break | OpamParallel.Aborted -> () | Failure s -> disp "%s" s | OpamSystem.Process_error e -> disp "%s" (OpamProcess.string_of_result e) | e -> disp "%s" (Printexc.to_string e); if OpamConsole.debug () then OpamConsole.errmsg "%s" (OpamStd.Exn.pretty_backtrace e) in match n with | `Change (`Up, _, nv) -> f "upgrading to" nv | `Change (`Down, _, nv) -> f "downgrading to" nv | `Install nv -> f "installing" nv | `Reinstall nv -> f "recompiling" nv | `Remove nv -> f "removing" nv | `Build nv -> f "compiling" nv module Json = struct let output_request request user_action = if OpamClientConfig.(!r.json_out = None) then () else let atoms = List.map (fun a -> `String (OpamFormula.short_string_of_atom a)) in let j = `O [ "action", `String (string_of_user_action user_action); "install", `A (atoms request.wish_install); "remove", `A (atoms request.wish_remove); "upgrade", `A (atoms request.wish_upgrade); "criteria", `String (OpamSolverConfig.criteria request.criteria); ] in OpamJson.append "request" j let output_solution t solution = if OpamClientConfig.(!r.json_out = None) then () else match solution with | Success solution -> let action_graph = OpamSolver.get_atomic_action_graph solution in let to_proceed = PackageActionGraph.Topological.fold (fun a acc -> PackageAction.to_json a :: acc ) action_graph [] in OpamJson.append "solution" (`A (List.rev to_proceed)) | Conflicts cs -> let causes,_,cycles = OpamCudf.strings_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs in let chains = OpamCudf.conflict_chains t.packages cs in let jchains = `A (List.map (fun c -> `A ((List.map (fun f -> `String (OpamFormula.to_string (Atom f))) c))) chains) in let toj l = `A (List.map (fun s -> `String s) l) in OpamJson.append "conflicts" (`O ((if cycles <> [] then ["cycles", toj cycles] else []) @ (if causes <> [] then ["causes", toj causes] else []) @ (if chains <> [] then ["broken-deps", jchains] else []))) let exc e = let lmap f l = List.rev (List.rev_map f l) in if OpamClientConfig.(!r.json_out = None) then `O [] else match e with | OpamSystem.Process_error {OpamProcess.r_code; r_duration; r_info; r_stdout; r_stderr; _} -> `O [ ("process-error", `O ([ ("code", `String (string_of_int r_code)); ("duration", `Float r_duration); ("info", `O (lmap (fun (k,v) -> (k, `String v)) r_info)); ] @ if OpamCoreConfig.(!r.merged_output) then [("output", `A (lmap (fun s -> `String s) r_stdout))] else [("output", `A (lmap (fun s -> `String s) r_stdout)); ("stderr", `A (lmap (fun s -> `String s) r_stderr)); ]))] | OpamSystem.Internal_error s -> `O [ ("internal-error", `String s) ] | e -> `O [ ("exception", `String (Printexc.to_string e)) ] end (* Process the atomic actions in a graph in parallel, respecting graph order, and report to user. Takes a graph of atomic actions *) let parallel_apply t _action ~requested ?add_roots ~assume_built action_graph = log "parallel_apply"; let remove_action_packages = PackageActionGraph.fold_vertex (function `Remove nv -> OpamPackage.Set.add nv | _ -> fun acc -> acc) action_graph OpamPackage.Set.empty in let install_action_packages = PackageActionGraph.fold_vertex (function `Install nv -> OpamPackage.Set.add nv | _ -> fun acc -> acc) action_graph OpamPackage.Set.empty in (* the core set of installed packages that won't change *) let minimal_install = OpamPackage.Set.Op.(t.installed -- remove_action_packages) in let wished_removed = OpamPackage.Set.filter (fun nv -> not (OpamPackage.has_name install_action_packages nv.name)) remove_action_packages in let root_installs = OpamPackage.Name.Set.union (OpamPackage.names_of_packages t.installed_roots) @@ match add_roots with | Some r -> r | None -> OpamPackage.Name.Set.diff (OpamPackage.names_of_packages requested) (OpamPackage.names_of_packages remove_action_packages) in (* We keep an imperative state up-to-date and flush it to disk as soon as an operation terminates *) let t_ref = ref t in let add_to_install nv = let root = OpamPackage.Name.Set.mem nv.name root_installs in t_ref := OpamSwitchAction.add_to_installed !t_ref ~root nv in let remove_from_install ?keep_as_root nv = t_ref := OpamSwitchAction.remove_from_installed ?keep_as_root !t_ref nv in let inplace = if OpamClientConfig.(!r.inplace_build) || assume_built then OpamPackage.Set.fold (fun nv acc -> match OpamStd.Option.Op.(OpamSwitchState.url t nv >>| OpamFile.URL.url >>= OpamUrl.local_dir) with | None -> acc | Some path -> OpamPackage.Map.add nv path acc) requested OpamPackage.Map.empty else OpamPackage.Map.empty in (* 1/ fetch needed package archives *) let failed_downloads = let sources_needed = OpamPackage.Set.Op. (OpamAction.sources_needed t action_graph -- OpamPackage.keys inplace) in let sources_list = OpamPackage.Set.elements sources_needed in if OpamPackage.Set.exists (fun nv -> not (OpamPackage.Set.mem nv t.pinned && OpamFilename.exists_dir (OpamSwitchState.source_dir t nv))) sources_needed then OpamConsole.header_msg "Gathering sources"; let results = OpamParallel.map ~jobs:OpamStateConfig.(!r.dl_jobs) ~command:(OpamAction.download_package t) ~dry_run:OpamStateConfig.(!r.dryrun) sources_list in List.fold_left2 (fun failed nv -> function | None -> failed | Some (s,l) -> OpamPackage.Map.add nv (s,l) failed) OpamPackage.Map.empty sources_list results in if OpamClientConfig.(!r.json_out <> None) && not (OpamPackage.Map.is_empty failed_downloads) then OpamJson.append "download-failures" (`O (List.map (fun (nv,(_,err)) -> OpamPackage.to_string nv, `String err) (OpamPackage.Map.bindings failed_downloads))); let fatal_dl_error = PackageActionGraph.fold_vertex (fun a acc -> acc || match a with | `Remove _ -> false | _ -> OpamPackage.Map.mem (action_contents a) failed_downloads) action_graph false in if fatal_dl_error then OpamConsole.error_and_exit `Sync_error "The sources of the following couldn't be obtained, aborting:\n%s" (OpamStd.Format.itemize (fun (p, (s,l)) -> Printf.sprintf "%s%s" (OpamPackage.to_string p) (if OpamConsole.verbose () then ":\n" ^ l else OpamStd.Option.map_default (fun x -> ": " ^ x) "" s)) (OpamPackage.Map.bindings failed_downloads)) else if not (OpamPackage.Map.is_empty failed_downloads) then OpamConsole.warning "The sources of the following couldn't be obtained, they may be \ uncleanly uninstalled:\n%s" (OpamStd.Format.itemize OpamPackage.to_string (OpamPackage.Map.keys failed_downloads)); (* 2/ process the package actions (installations and removals) *) let action_graph = (* Add build actions *) let noop_remove nv = OpamAction.noop_remove_package t nv in PackageActionGraph.explicit ~noop_remove action_graph in (match OpamSolverConfig.(!r.cudf_file) with | None -> () | Some f -> let filename = Printf.sprintf "%s-actions-explicit.dot" f in let oc = open_out filename in OpamSolver.ActionGraph.Dot.output_graph oc action_graph; close_out oc); let timings = Hashtbl.create 17 in (* the child job to run on each action *) let job ~pred action = let installed, removed, failed = List.fold_left (fun (inst,rem,fail) -> function | _, `Successful (inst1, rem1) -> OpamPackage.Set.Op.(inst ++ inst1, rem ++ rem1, fail) | _, `Error (`Aborted a) -> inst, rem, PackageAction.Set.Op.(a ++ fail) | a, (`Exception _ | `Error _) -> inst, rem, PackageAction.Set.add a fail) (OpamPackage.Set.empty, OpamPackage.Set.empty, PackageAction.Set.empty) pred in if not (PackageAction.Set.is_empty failed) then Done (`Error (`Aborted failed)) (* prerequisite failed *) else let store_time = let t0 = Unix.gettimeofday () in fun () -> Hashtbl.add timings action (Unix.gettimeofday () -. t0) in let not_yet_removed = match action with | `Remove _ -> PackageActionGraph.fold_descendants (function | `Remove nv -> OpamPackage.Set.add nv | _ -> fun acc -> acc) OpamPackage.Set.empty action_graph action | _ -> OpamPackage.Set.empty in let visible_installed = OpamPackage.Set.Op.(minimal_install ++ not_yet_removed ++ installed) in let t = { !t_ref with installed = visible_installed; conf_files = OpamPackage.Map.filter (fun nv _ -> OpamPackage.Set.mem nv visible_installed) !t_ref.conf_files; } in let nv = action_contents action in let source_dir = OpamSwitchState.source_dir t nv in if OpamClientConfig.(!r.fake) then match action with | `Build _ -> Done (`Successful (installed, removed)) | `Install nv -> OpamConsole.msg "Faking installation of %s\n" (OpamPackage.to_string nv); add_to_install nv; Done (`Successful (OpamPackage.Set.add nv installed, removed)) | `Remove nv -> remove_from_install nv; Done (`Successful (installed, OpamPackage.Set.add nv removed)) | _ -> assert false else match action with | `Build nv -> if assume_built && OpamPackage.Set.mem nv requested then (log "Skipping build for %s, just install%s" (OpamPackage.to_string nv) (OpamStd.Option.map_default (fun p -> " from " ^ OpamFilename.Dir.to_string p) "" (OpamPackage.Map.find_opt nv inplace)); Done (`Successful (installed, removed))) else let is_inplace, build_dir = try true, OpamPackage.Map.find nv inplace with Not_found -> let dir = OpamPath.Switch.build t.switch_global.root t.switch nv in if not OpamClientConfig.(!r.reuse_build_dir) then OpamFilename.rmdir dir; false, dir in let test = OpamStateConfig.(!r.build_test) && OpamPackage.Set.mem nv requested in let doc = OpamStateConfig.(!r.build_doc) && OpamPackage.Set.mem nv requested in (if OpamFilename.exists_dir source_dir then (if not is_inplace then OpamFilename.copy_dir ~src:source_dir ~dst:build_dir) else OpamFilename.mkdir build_dir; OpamAction.prepare_package_source t nv build_dir @@+ function | Some exn -> store_time (); Done (`Exception exn) | None -> OpamAction.build_package t ~test ~doc build_dir nv @@+ function | Some exn -> store_time (); Done (`Exception exn) | None -> store_time (); Done (`Successful (installed, removed))) | `Install nv -> let test = OpamStateConfig.(!r.build_test) && OpamPackage.Set.mem nv requested in let doc = OpamStateConfig.(!r.build_doc) && OpamPackage.Set.mem nv requested in let build_dir = OpamPackage.Map.find_opt nv inplace in (OpamAction.install_package t ~test ~doc ?build_dir nv @@+ function | None -> add_to_install nv; store_time (); Done (`Successful (OpamPackage.Set.add nv installed, removed)) | Some exn -> store_time (); Done (`Exception exn)) | `Remove nv -> (if OpamAction.removal_needs_download t nv then let d = OpamPath.Switch.remove t.switch_global.root t.switch nv in OpamFilename.rmdir d; if OpamFilename.exists_dir source_dir then OpamFilename.copy_dir ~src:source_dir ~dst:d else OpamFilename.mkdir d; OpamAction.prepare_package_source t nv d else Done None) @@+ fun _ -> OpamProcess.Job.ignore_errors ~default:() (fun () -> OpamAction.remove_package t nv) @@| fun () -> remove_from_install ~keep_as_root:(not (OpamPackage.Set.mem nv wished_removed)) nv; store_time (); `Successful (installed, OpamPackage.Set.add nv removed) | _ -> assert false in let action_results = OpamConsole.header_msg "Processing actions"; try let installs_removes = PackageActionGraph.fold_vertex (fun a acc -> match a with `Install _ | `Remove _ as i -> i::acc | _ -> acc) action_graph [] in let same_inplace_source = OpamPackage.Map.fold (fun nv dir acc -> OpamFilename.Dir.Map.update dir (fun l -> nv::l) [] acc) inplace OpamFilename.Dir.Map.empty |> OpamFilename.Dir.Map.values in let mutually_exclusive = installs_removes :: OpamStd.List.filter_map (fun excl -> match OpamStd.List.filter_map (fun nv -> let act = `Build nv in if PackageActionGraph.mem_vertex action_graph act then Some act else None) excl with [] | [_] -> None | l -> Some l) same_inplace_source in let results = PackageActionGraph.Parallel.map ~jobs:(Lazy.force OpamStateConfig.(!r.jobs)) ~command:job ~dry_run:OpamStateConfig.(!r.dryrun) ~mutually_exclusive action_graph in if OpamClientConfig.(!r.json_out <> None) then (let j = PackageActionGraph.Topological.fold (fun a acc -> let r = match List.assoc a results with | `Successful _ -> `String "OK" | `Exception e -> Json.exc e | `Error (`Aborted deps) -> let deps = OpamSolver.Action.Set.elements deps in `O ["aborted", `A (List.map OpamSolver.Action.to_json deps)] in let duration = try [ "duration", `Float (Hashtbl.find timings a) ] with Not_found -> [] in `O ([ "action", PackageAction.to_json a; "result", r ] @ duration) :: acc ) action_graph [] in OpamJson.append "results" (`A (List.rev j))); let success, failure, aborted = List.fold_left (fun (success, failure, aborted) -> function | a, `Successful _ -> a::success, failure, aborted | a, `Exception e -> success, (a,e)::failure, aborted | a, `Error (`Aborted _) -> success, failure, a::aborted ) ([], [], []) results in if failure = [] && aborted = [] then `Successful () else ( List.iter display_error failure; `Error (Partial_error (success, List.map fst failure, aborted)) ) with | PackageActionGraph.Parallel.Errors (success, errors, remaining) -> List.iter display_error errors; `Error (Partial_error (success, List.map fst errors, remaining)) | e -> `Exception e in let t = !t_ref in (* 3/ Display errors and finalize *) let cleanup_artefacts graph = PackageActionGraph.iter_vertex (function | `Remove nv when not (OpamPackage.has_name t.pinned nv.name) -> OpamAction.cleanup_package_artefacts t nv (* if reinstalled, only removes build dir *) | `Install nv when not (OpamPackage.has_name t.pinned nv.name) -> let build_dir = OpamPath.Switch.build t.switch_global.root t.switch nv in if not OpamClientConfig.(!r.keep_build_dir) then OpamFilename.rmdir build_dir | `Remove _ | `Install _ | `Build _ -> () | _ -> assert false) graph in match action_results with | `Successful () -> cleanup_artefacts action_graph; OpamConsole.msg "Done.\n"; t, OK (PackageActionGraph.fold_vertex (fun a b -> a::b) action_graph []) | `Exception (OpamStd.Sys.Exit _ | Sys.Break as e) -> OpamConsole.msg "Aborting.\n"; raise e | `Exception (OpamSolver.ActionGraph.Parallel.Cyclic cycles as e) -> OpamConsole.error "Cycles found during dependency resolution:\n%s" (OpamStd.Format.itemize (OpamStd.List.concat_map (OpamConsole.colorise `yellow " -> ") OpamSolver.Action.to_string) cycles); raise e | `Exception (OpamSystem.Process_error _ | Unix.Unix_error _ as e) -> OpamConsole.error "Actions cancelled because of a system error:"; OpamConsole.errmsg "%s\n" (Printexc.to_string e); raise e | `Exception e -> OpamConsole.error "Actions cancelled because of %s" (Printexc.to_string e); raise e | `Error err -> match err with | Aborted -> t, err | Partial_error (successful, failed, remaining) -> (* Cleanup build/install actions when one of them failed, it's verbose and doesn't add information *) let successful = List.filter (function | `Build p when List.mem (`Install p) failed -> false | _ -> true) successful in let remaining = List.filter (function | `Remove p | `Install p when List.mem (`Build p) failed -> false | _ -> true) remaining in let filter_graph l = if l = [] then PackageActionGraph.create () else let g = PackageActionGraph.copy action_graph in PackageActionGraph.iter_vertex (fun v -> if not (List.mem v l) then PackageActionGraph.remove_vertex g v) g; g in let successful = filter_graph successful in cleanup_artefacts successful; let successful = PackageActionGraph.reduce successful in let failed = PackageActionGraph.reduce (filter_graph failed) in let print_actions filter tint header ?empty actions = let actions = PackageActionGraph.fold_vertex (fun v acc -> if filter v then v::acc else acc) actions [] in let actions = List.sort PackageAction.compare actions in if actions <> [] then OpamConsole.(msg "%s%s\n%s%s\n" (colorise tint (Printf.sprintf "%s%s " (utf8_symbol Symbols.box_drawings_light_down_and_right "+") (utf8_symbol Symbols.box_drawings_light_horizontal "-"))) header (OpamStd.Format.itemize ~bullet:(colorise tint (utf8_symbol Symbols.box_drawings_light_vertical "|" ^ " ")) (fun x -> x) (List.map (String.concat " ") @@ OpamStd.Format.align_table (PackageAction.to_aligned_strings actions))) (colorise tint (Printf.sprintf "%s%s " (utf8_symbol Symbols.box_drawings_light_up_and_right "+") (utf8_symbol Symbols.box_drawings_light_horizontal "-")))) else match empty with | Some s -> OpamConsole.(msg "%s%s\n" (colorise tint (Printf.sprintf "%s%s " (utf8_symbol Symbols.box_drawings_light_right "-") (utf8_symbol Symbols.box_drawings_light_horizontal ""))) s) | None -> () in OpamConsole.msg "\n"; OpamConsole.header_msg "Error report"; if OpamConsole.debug () || OpamConsole.verbose () then print_actions (fun _ -> true) `yellow (Printf.sprintf "The following actions were %s" (OpamConsole.colorise `yellow "aborted")) (PackageActionGraph.reduce (filter_graph remaining)); print_actions (fun _ -> true) `red (Printf.sprintf "The following actions %s" (OpamConsole.colorise `red "failed")) failed; print_actions (function `Build _ -> false | _ -> true) `cyan ("The following changes have been performed" ^ if remaining <> [] then " (the rest was aborted)" else "") ~empty:"No changes have been performed" successful; t, err | _ -> assert false let simulate_new_state state t = let installed = OpamSolver.ActionGraph.Topological.fold (fun action installed -> match action with | `Install p | `Change (_,_,p) | `Reinstall p -> OpamPackage.Set.add p installed | `Remove p -> OpamPackage.Set.remove p installed | `Build _ -> installed ) t state.installed in { state with installed } (* Ask confirmation whenever the packages to modify are not exactly the packages in the user request *) let confirmation ?ask requested solution = OpamCoreConfig.(!r.answer = Some true) || match ask with | Some false -> true | Some true -> OpamConsole.confirm "Do you want to continue?" | None -> let open PackageActionGraph in let solution_packages = fold_vertex (fun v acc -> OpamPackage.Name.Set.add (OpamPackage.name (action_contents v)) acc) solution OpamPackage.Name.Set.empty in OpamPackage.Name.Set.equal requested solution_packages || OpamConsole.confirm "Do you want to continue?" let run_hook_job t name ?(local=[]) w = let shell_env = OpamEnv.get_full ~force_path:true t in let mk_cmd = function | cmd :: args -> let text = OpamProcess.make_command_text name ~args cmd in Some (fun () -> OpamSystem.make_command ~verbose:(OpamConsole.verbose ()) ~env:(OpamTypesBase.env_array shell_env) ~name ~text cmd args) | [] -> None in let env v = try Some (List.assoc v local) with Not_found -> OpamPackageVar.resolve_switch t v in OpamProcess.Job.of_fun_list (OpamStd.List.filter_map (fun cmd -> mk_cmd cmd) (OpamFilter.commands env w)) @@+ function | Some (cmd, _err) -> OpamConsole.error "The %s hook failed at %S" name (OpamProcess.string_of_command cmd); Done false | None -> Done true (* Apply a solution *) let apply ?ask t action ~requested ?add_roots ?(assume_built=false) solution = log "apply"; if OpamSolver.solution_is_empty solution then (* The current state satisfies the request contraints *) t, Nothing_to_do else ( (* Otherwise, compute the actions to perform *) let stats = OpamSolver.stats solution in let show_solution = ask <> Some false in let action_graph = OpamSolver.get_atomic_action_graph solution in let new_state = simulate_new_state t action_graph in OpamPackage.Set.iter (fun p -> try OpamFile.OPAM.print_errors (OpamSwitchState.opam new_state p) with Not_found -> OpamConsole.error "No opam file found for %s" (OpamPackage.to_string p)) (OpamSolver.all_packages solution); if show_solution then ( OpamConsole.msg "The following actions %s be %s:\n" (if OpamClientConfig.(!r.show) then "would" else "will") (if OpamStateConfig.(!r.dryrun) then "simulated" else if OpamClientConfig.(!r.fake) then "faked" else "performed"); let messages p = let opam = OpamSwitchState.opam new_state p in let messages = OpamFile.OPAM.messages opam in OpamStd.List.filter_map (fun (s,f) -> if OpamFilter.opt_eval_to_bool (OpamPackageVar.resolve ~opam new_state) f then Some s else None ) messages in let append nv = (* mark pinned packages with a star *) if OpamPackage.Set.mem nv t.pinned then "*" else "" in OpamSolver.print_solution ~messages ~append ~requested ~reinstall:t.reinstall solution; let total_actions = sum stats in if total_actions >= 2 then OpamConsole.msg "===== %s =====\n" (OpamSolver.string_of_stats stats); ); if not OpamClientConfig.(!r.show) && confirmation ?ask requested action_graph then ( let requested = OpamPackage.packages_of_names new_state.installed requested in let run_job = if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.fake) then OpamProcess.Job.dry_run else OpamProcess.Job.run in let var_def name l = OpamVariable.Full.of_string name, L l in let var_def_set name set = var_def name (List.map OpamPackage.to_string (OpamPackage.Set.elements set)) in let depexts = OpamPackage.Set.fold (fun nv depexts -> OpamStd.String.Set.union depexts (OpamSwitchState.depexts t nv)) new_state.installed OpamStd.String.Set.empty in let pre_session = let open OpamPackage.Set.Op in let local = [ var_def_set "installed" new_state.installed; var_def_set "new" (new_state.installed -- t.installed); var_def_set "removed" (t.installed -- new_state.installed); var_def "depexts" (OpamStd.String.Set.elements depexts); ] in run_job @@ run_hook_job t "pre-session" ~local (OpamFile.Wrappers.pre_session (OpamFile.Config.wrappers t.switch_global.config)) in if not pre_session then OpamStd.Sys.exit_because `Configuration_error; let t0 = t in let t, r = parallel_apply t action ~requested ?add_roots ~assume_built action_graph in let success = match r with | OK _ -> true | _ -> false in let post_session = let open OpamPackage.Set.Op in let local = [ var_def_set "installed" t.installed; var_def_set "new" (t.installed -- t0.installed); var_def_set "removed" (t0.installed -- t.installed); OpamVariable.Full.of_string "success", B (success); OpamVariable.Full.of_string "failure", B (not success); ] in run_job @@ run_hook_job t "post-session" ~local (OpamFile.Wrappers.post_session (OpamFile.Config.wrappers t.switch_global.config)) in if not post_session then OpamStd.Sys.exit_because `Configuration_error; t, r ) else t, Aborted ) let resolve t action ~orphans ?reinstall ~requested request = if OpamClientConfig.(!r.json_out <> None) then ( OpamJson.append "command-line" (`A (List.map (fun s -> `String s) (Array.to_list Sys.argv))); OpamJson.append "switch" (OpamSwitch.to_json t.switch) ); Json.output_request request action; let r = OpamSolver.resolve (OpamSwitchState.universe t ~requested ?reinstall action) ~orphans request in Json.output_solution t r; r let resolve_and_apply ?ask t action ~orphans ?reinstall ~requested ?add_roots ?(assume_built=false) request = match resolve t action ~orphans ?reinstall ~requested request with | Conflicts cs -> log "conflict!"; OpamConsole.msg "%s" (OpamCudf.string_of_conflict t.packages (OpamSwitchState.unavailable_reason t) cs); t, No_solution | Success solution -> apply ?ask t action ~requested ?add_roots ~assume_built solution opam-2.0.5/src/repository/0000755000175000017500000000000013511367404014464 5ustar nicoonicooopam-2.0.5/src/repository/opamGit.ml0000644000175000017500000002052113511367404016416 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamFilename.Op open OpamProcess.Job.Op (* let log fmt = OpamConsole.log "GIT" fmt *) module VCS : OpamVCS.VCS = struct let name = `git let exists repo_root = OpamFilename.exists_dir (repo_root / ".git") || OpamFilename.exists (repo_root // ".git") let git repo_root = let dir = OpamFilename.Dir.to_string repo_root in fun ?verbose ?env ?stdout args -> OpamSystem.make_command ~dir ?verbose ?env ?stdout "git" args let init repo_root repo_url = OpamFilename.mkdir repo_root; OpamProcess.Job.of_list [ git repo_root [ "init" ]; (* Enforce this option, it can break our use of git if set *) git repo_root [ "config" ; "--local" ; "fetch.prune"; "false"]; (* We reset diff.noprefix to ensure we get a `-p1` patch and avoid . *) git repo_root [ "config" ; "--local" ; "diff.noprefix"; "false"]; (* Document the remote for user-friendliness (we don't use it) *) git repo_root [ "remote"; "add"; "origin"; OpamUrl.base_url repo_url ]; ] @@+ function | None -> Done () | Some (_,err) -> OpamSystem.process_error err let remote_ref url = match url.OpamUrl.hash with | Some h -> "refs/remotes/opam-ref-"^h | None -> "refs/remotes/opam-ref" let fetch ?cache_dir repo_root repo_url = (match cache_dir with | Some c when OpamUrl.local_dir repo_url = None -> let dir = c / "git" in if not (OpamFilename.exists_dir dir) then (OpamFilename.mkdir dir; git dir [ "init"; "--bare" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done (Some dir)) else Done (Some dir) | _ -> Done None) @@+ fun global_cache -> let origin = OpamUrl.base_url repo_url in let branch = OpamStd.Option.default "HEAD" repo_url.OpamUrl.hash in let opam_ref = remote_ref repo_url in let refspec = Printf.sprintf "+%s:%s" branch opam_ref in git repo_root [ "remote" ; "set-url"; "origin"; origin ] @@> fun _ -> OpamStd.Option.iter (fun cache -> let alternates = repo_root / ".git" / "objects" / "info" // "alternates" in if not (OpamFilename.exists alternates) then OpamFilename.write alternates (OpamFilename.Dir.to_string (cache / "objects"))) global_cache; git repo_root [ "fetch" ; "-q"; origin; "--update-shallow"; refspec ] @@> fun r -> if OpamProcess.check_success_and_cleanup r then let refspec = Printf.sprintf "+%s:refs/remotes/%s" opam_ref (Digest.to_hex (Digest.string (OpamUrl.to_string repo_url))) in match global_cache with | Some cache -> git repo_root [ "push" ; OpamFilename.Dir.to_string cache ; refspec ] @@> fun _ -> Done () | None -> Done () else (* fallback to fetching all first (workaround, git 2.1 fails silently on 'fetch HASH' when HASH isn't available locally already). Also, remove the [--update-shallow] option in case git is so old that it didn't exist yet, as that is not needed in the general case *) git repo_root [ "fetch" ; "-q" ] @@> fun r -> OpamSystem.raise_on_process_error r; (* retry to fetch the specific branch *) git repo_root [ "fetch" ; "-q"; origin; refspec ] @@> fun r -> if OpamProcess.check_success_and_cleanup r then Done () else if OpamStd.String.fold_left (fun acc c -> match acc, c with | true, ('0'..'9' | 'a'..'f' | 'A'..'F') -> true | _ -> false) true branch then (* the above might still fail on raw, untracked hashes: try to bind to the direct refspec, if found *) (git repo_root [ "update-ref" ; opam_ref; branch ] @@> fun r -> if OpamProcess.check_success_and_cleanup r then Done() else (* check if the commit exists *) (git repo_root [ "fetch"; "-q" ] @@> fun r -> OpamSystem.raise_on_process_error r; git repo_root [ "show"; "-s"; "--format=%H"; branch ] @@> fun r -> if OpamProcess.check_success_and_cleanup r then failwith "Commit found, but unreachable: enable uploadpack.allowReachableSHA1InWant on server" else failwith "Commit not found on repository")) else OpamSystem.process_error r let revision repo_root = git repo_root ~verbose:false [ "rev-parse"; "HEAD" ] @@> fun r -> if r.OpamProcess.r_code = 128 then (OpamProcess.cleanup ~force:true r; Done None) else (OpamSystem.raise_on_process_error r; match r.OpamProcess.r_stdout with | [] -> Done None | full::_ -> if String.length full > 8 then Done (Some (String.sub full 0 8)) else Done (Some full)) let reset_tree repo_root repo_url = let rref = remote_ref repo_url in git repo_root [ "reset" ; "--hard"; rref; "--" ] @@> fun r -> if OpamProcess.is_failure r then OpamSystem.internal_error "Git error: %s not found." rref else if OpamFilename.exists (repo_root // ".gitmodules") then git repo_root [ "submodule"; "update"; "--init"; "--recursive" ] @@> fun r -> if OpamProcess.is_failure r then OpamConsole.warning "Git submodule update failed in %s" (OpamFilename.Dir.to_string repo_root); Done () else Done () let patch_applied _ _ = (* This might be a good place to do 'git reset --soft' and check for unstaged changes. See . *) Done () let diff repo_root repo_url = let rref = remote_ref repo_url in let patch_file = OpamSystem.temp_file ~auto_clean: false "git-diff" in let finalise () = OpamSystem.remove_file patch_file in OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () -> git repo_root [ "add"; "." ] @@> fun r -> (* Git diff is to the working dir, but doesn't work properly for unregistered directories. *) OpamSystem.raise_on_process_error r; (* We also reset diff.noprefix here to handle already existing repo. *) git repo_root ~stdout:patch_file [ "-c" ; "diff.noprefix=false" ; "diff" ; "--no-ext-diff" ; "-R" ; "-p" ; rref; "--" ] @@> fun r -> if not (OpamProcess.check_success_and_cleanup r) then (finalise (); OpamSystem.internal_error "Git error: %s not found." rref) else if OpamSystem.file_is_empty patch_file then (finalise (); Done None) else Done (Some (OpamFilename.of_string patch_file)) let is_up_to_date repo_root repo_url = let rref = remote_ref repo_url in git repo_root [ "diff" ; "--no-ext-diff" ; "--quiet" ; rref; "--" ] @@> function | { OpamProcess.r_code = 0; _ } -> Done true | { OpamProcess.r_code = 1; _ } as r -> OpamProcess.cleanup ~force:true r; Done false | r -> OpamSystem.process_error r let versioned_files repo_root = git repo_root ~verbose:false [ "ls-files" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done r.OpamProcess.r_stdout let vc_dir repo_root = OpamFilename.Op.(repo_root / ".git") let current_branch dir = git dir [ "symbolic-ref"; "--quiet"; "--short"; "HEAD" ] @@> function | { OpamProcess.r_code = 0; OpamProcess.r_stdout = [s]; _ } -> Done (Some s) | _ -> Done (Some "HEAD") let is_dirty dir = git dir [ "diff" ; "--no-ext-diff" ; "--quiet" ] @@> function | { OpamProcess.r_code = 0; _ } -> Done false | { OpamProcess.r_code = 1; _ } as r -> OpamProcess.cleanup ~force:true r; Done true | r -> OpamSystem.process_error r end module B = OpamVCS.Make(VCS) opam-2.0.5/src/repository/dune0000644000175000017500000000052013511367404015337 0ustar nicoonicoo(library (name opam_repository) (public_name opam-repository) (synopsis "OCaml Package Manager remote repository handling library") (libraries opam-format) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (wrapped false)) opam-2.0.5/src/repository/opamRepositoryBackend.mli0000644000175000017500000001057513511367404021503 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Signature for repository handlers and some helpers for the repository type *) open OpamTypes (** Type returned by repository updates. *) type update = | Update_full of dirname (** No previous known state, the full contents have been put in the given temporary directory *) | Update_patch of filename (** The given patch file corresponds to the update, i.e. applying it to the local repository with 'patch -p1' would get it to the upstream state *) | Update_empty (** The repository is already up to date *) | Update_err of exn (** Failed to obtain the update *) (** Backend signature *) module type S = sig val name: OpamUrl.backend (** [pull_url local_dir checksum remote_url] pulls the contents of [remote_url] into [local_dir]. Two kinds of results are allowed: - a single file was downloaded, in this case it is placed within [local_dir] and returned as [Some filename] - a directory was retrieved, in this case the contents of [local_dir] have been synchronised with its own, and [None] is returned [checksum] can be used for retrieval but is NOT checked by this function. *) val pull_url: ?cache_dir:dirname -> dirname -> OpamHash.t option -> url -> filename option download OpamProcess.job (** [pull_repo_update] fetches the remote update from [url] to the local repository at [dirname], but does not apply it, allowing for further verifications. The file or directory returned is always temporary and should be cleaned up by the caller. *) val fetch_repo_update: repository_name -> ?cache_dir:dirname -> dirname -> url -> update OpamProcess.job (** [repo_update_complete dirname url] finalizes the update of the repository after verification of the patch returned from [pull_repo_update] with [Update_patch file] is applied. Version control systems, e.g. Mercurial, that track the state of the working directory automatically use this to update internal caches. *) val repo_update_complete: dirname -> url -> unit OpamProcess.job (** Return the (optional) revision of a given repository. Only useful for VCS backends. Is not expected to work with [pull_repo_update], which doesn't update the VCS commit information. *) val revision: dirname -> version option OpamProcess.job (** Like [pull_url], except for locally-bound version control backends, where it should get the latest, uncommitted source. *) val sync_dirty: dirname -> url -> filename option download OpamProcess.job end (** Pretty-print *) val to_string: repository -> string val to_json: repository -> json (** Compare repositories *) val compare: repository -> repository -> int (** Create a local repository on a given path, without remote (only for external tools, not to be mistaken for an opam repo with a local url) *) val local: dirname -> repository (** [check_digest file expected] check that the [file] digest is the one [expected]. *) val check_digest: filename -> OpamHash.t option -> bool (** Adds a label to the given job, for the corresponding repository name and action *) val job_text: repository_name -> string -> 'a OpamProcess.job -> 'a OpamProcess.job (** [get_diff parent_dir subdir1 subdir2] computes the diff between the two subdirs of [parent_dir], returns None if they are equal, and the corresponding patch otherwise. Note: this relies on the [diff -ruN] command, a built-in diff may be more portable -- in particular, [-u], [-N] are not POSIX, and recursive diffs might not be completely reliable. It also assumes text files only, and fails otherwise. *) val get_diff: dirname -> basename -> basename -> filename option OpamProcess.job opam-2.0.5/src/repository/opamHTTP.mli0000644000175000017500000000162113511367404016623 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Main HTTP repository backend, based on Curl *) module B: OpamRepositoryBackend.S open OpamTypes val make_index_tar_gz: dirname -> unit opam-2.0.5/src/repository/opamHg.mli0000644000175000017500000000156613511367404016412 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Mercurial repository backend (based on OpamVCS) *) module VCS: OpamVCS.VCS module B: OpamRepositoryBackend.S opam-2.0.5/src/repository/opamHTTP.ml0000644000175000017500000000751413511367404016461 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStd.Op open OpamProcess.Job.Op let log msg = OpamConsole.log "CURL" msg let slog = OpamConsole.slog let index_archive_name = "index.tar.gz" let remote_index_archive url = OpamUrl.Op.(url / index_archive_name) let sync_state name destdir url = OpamFilename.with_tmp_dir_job @@ fun dir -> let local_index_archive = OpamFilename.Op.(dir // index_archive_name) in OpamDownload.download_as ~quiet:true ~overwrite:true (remote_index_archive url) local_index_archive @@+ fun () -> List.iter OpamFilename.rmdir (OpamFilename.dirs destdir); OpamProcess.Job.with_text (Printf.sprintf "[%s: unpacking]" (OpamConsole.colorise `green (OpamRepositoryName.to_string name))) @@ OpamFilename.extract_in_job local_index_archive destdir @@+ function | None -> Done () | Some err -> raise err module B = struct let name = `http let fetch_repo_update repo_name ?cache_dir:_ repo_root url = log "pull-repo-update"; let quarantine = OpamFilename.Dir.(of_string (to_string repo_root ^ ".new")) in OpamFilename.mkdir quarantine; let finalise () = OpamFilename.rmdir quarantine in OpamProcess.Job.catch (fun e -> finalise (); Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (sync_state repo_name quarantine url) @@+ fun () -> if not (OpamFilename.exists_dir repo_root) || OpamFilename.dir_is_empty repo_root then Done (OpamRepositoryBackend.Update_full quarantine) else OpamProcess.Job.finally finalise @@ fun () -> OpamRepositoryBackend.job_text repo_name "diff" (OpamRepositoryBackend.get_diff (OpamFilename.dirname_dir repo_root) (OpamFilename.basename_dir repo_root) (OpamFilename.basename_dir quarantine)) @@| function | None -> OpamRepositoryBackend.Update_empty | Some patch -> OpamRepositoryBackend.Update_patch patch let repo_update_complete _ _ = Done () let pull_url ?cache_dir:_ dirname checksum remote_url = log "pull-file into %a: %a" (slog OpamFilename.Dir.to_string) dirname (slog OpamUrl.to_string) remote_url; OpamProcess.Job.catch (fun e -> OpamStd.Exn.fatal e; let s,l = let str = Printf.sprintf "%s (%s)" (OpamUrl.to_string remote_url) in match e with | OpamDownload.Download_fail (s,l) -> s, str l | _ -> Some "Download failed", str "download failed" in Done (Not_available (s,l))) @@ fun () -> OpamDownload.download ~quiet:true ~overwrite:true ?checksum remote_url dirname @@+ fun local_file -> Done (Result (Some local_file)) let revision _ = Done None let sync_dirty dir url = pull_url dir None url end (* Helper functions used by opam-admin *) let make_index_tar_gz repo_root = OpamFilename.in_dir repo_root (fun () -> let to_include = [ "version"; "packages"; "repo" ] in match List.filter Sys.file_exists to_include with | [] -> () | d -> OpamSystem.command ("tar" :: "czhf" :: "index.tar.gz" :: d) ) opam-2.0.5/src/repository/opamDownload.mli0000644000175000017500000000300213511367404017606 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration init and handling of downloading commands *) exception Download_fail of string option * string (** downloads a file from an URL, using Curl, Wget, or a custom configured tool, to the given directory. Returns the downloaded filename. @raise Failure if the download failed or if the checksum is specified and doesn't match*) val download: ?quiet:bool -> ?validate:bool -> overwrite:bool -> ?compress:bool -> ?checksum:OpamHash.t -> OpamUrl.t -> OpamFilename.Dir.t -> OpamFilename.t OpamProcess.job (** As [download], but with a specified output filename. *) val download_as: ?quiet:bool -> ?validate:bool -> overwrite:bool -> ?compress:bool -> ?checksum:OpamHash.t -> OpamUrl.t -> OpamFilename.t -> unit OpamProcess.job opam-2.0.5/src/repository/opamRepositoryPath.ml0000644000175000017500000000413613511367404020673 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamFilename.Op let create root name = root / "repo" / OpamRepositoryName.to_string name let download_cache root = root / "download-cache" let pin_cache_dir = let dir = lazy (OpamSystem.mk_temp_dir ~prefix:"opam-pin-cache" () |> OpamFilename.Dir.of_string ) in fun () -> Lazy.force dir let pin_cache u = pin_cache_dir () / (OpamHash.contents @@ OpamHash.compute_from_string ~kind:`SHA512 @@ OpamUrl.to_string u) let repo repo_root = repo_root // "repo" |> OpamFile.make let packages_dir repo_root = repo_root / "packages" let packages repo_root prefix nv = match prefix with | None -> packages_dir repo_root / OpamPackage.to_string nv | Some p -> packages_dir repo_root / p / OpamPackage.to_string nv let opam repo_root prefix nv = packages repo_root prefix nv // "opam" |> OpamFile.make let descr repo_root prefix nv = packages repo_root prefix nv // "descr" |> OpamFile.make let url repo_root prefix nv = packages repo_root prefix nv // "url" |> OpamFile.make let files repo_root prefix nv = packages repo_root prefix nv / "files" module Remote = struct (** URL, not FS paths *) open OpamUrl.Op let repo root_url = root_url / "repo" let packages_url root_url = root_url / "packages" let archive root_url nv = root_url / "archives" / (OpamPackage.to_string nv ^ "+opam.tar.gz") end opam-2.0.5/src/repository/opamDownload.ml0000644000175000017500000001462513511367404017452 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamProcess.Job.Op let log fmt = OpamConsole.log "CURL" fmt exception Download_fail of string option * string let fail (s,l) = raise (Download_fail (s,l)) let user_agent = CString (Printf.sprintf "opam/%s" (OpamVersion.(to_string current))) let curl_args = [ CString "--write-out", None; CString "%%{http_code}\\n", None; CString "--retry", None; CIdent "retry", None; CString "--retry-delay", None; CString "2", None; CString "--compressed", Some (FIdent (OpamFilter.ident_of_string "compress")); CString "--user-agent", None; user_agent, None; CString "-L", None; CString "-o", None; CIdent "out", None; CIdent "url", None; ] let wget_args = [ CString "--content-disposition", None; CString "-t", None; CIdent "retry", None; CString "-O", None; CIdent "out", None; CIdent "url", None; CString "-U", None; user_agent, None; ] let download_args ~url ~out ~retry ?checksum ~compress = let cmd, _ = Lazy.force OpamRepositoryConfig.(!r.download_tool) in let cmd = match cmd with | [(CIdent "wget"), _] -> cmd @ wget_args | [_] -> cmd @ curl_args (* Assume curl if the command is a single arg *) | _ -> cmd in OpamFilter.single_command (fun v -> if not (OpamVariable.Full.is_global v) then None else match OpamVariable.to_string (OpamVariable.Full.variable v) with | "curl" -> Some (S "curl") | "wget" -> Some (S "wget") | "url" -> Some (S (OpamUrl.to_string url)) | "out" -> Some (S out) | "retry" -> Some (S (string_of_int retry)) | "compress" -> Some (B compress) | "opam-version" -> Some (S OpamVersion.(to_string current)) | "checksum" -> OpamStd.Option.map (fun c -> S OpamHash.(to_string c)) checksum | "hashalgo" -> OpamStd.Option.map (fun c -> S OpamHash.(string_of_kind (kind c))) checksum | "hashpath" -> OpamStd.Option.map (fun c -> S (String.concat Filename.dir_sep OpamHash.(to_path c))) checksum | "hashvalue" -> OpamStd.Option.map (fun c -> S OpamHash.(contents c)) checksum | _ -> None) cmd let tool_return url ret = match Lazy.force OpamRepositoryConfig.(!r.download_tool) with | _, `Default -> if OpamProcess.is_failure ret then fail (Some "Download command failed", Printf.sprintf "Download command failed: %s" (OpamProcess.result_summary ret)) else Done () | _, `Curl -> if OpamProcess.is_failure ret then fail (Some "Curl failed", Printf.sprintf "Curl failed: %s" (OpamProcess.result_summary ret)); match ret.OpamProcess.r_stdout with | [] -> fail (Some "curl empty response", Printf.sprintf "curl: empty response while downloading %s" (OpamUrl.to_string url)) | l -> let code = List.hd (List.rev l) in let num = try int_of_string code with Failure _ -> 999 in if num >= 400 then fail (Some ("curl error code " ^ code), Printf.sprintf "curl: code %s while downloading %s" code (OpamUrl.to_string url)) else Done () let download_command ~compress ?checksum ~url ~dst = let cmd, args = match download_args ~url ~out:dst ~retry:OpamRepositoryConfig.(!r.retries) ?checksum ~compress with | cmd::args -> cmd, args | [] -> OpamConsole.error_and_exit `Configuration_error "Empty custom download command" in OpamSystem.make_command cmd args @@> tool_return url let really_download ?(quiet=false) ~overwrite ?(compress=false) ?checksum ?(validate=true) ~url ~dst = assert (url.OpamUrl.backend = `http); let tmp_dst = dst ^ ".part" in if Sys.file_exists tmp_dst then OpamSystem.remove tmp_dst; OpamProcess.Job.catch (function | Failure s as e -> OpamSystem.remove tmp_dst; if not quiet then OpamConsole.error "%s" s; raise e | e -> OpamSystem.remove tmp_dst; OpamStd.Exn.fatal e; log "Could not download file at %s." (OpamUrl.to_string url); raise e) @@ fun () -> download_command ~compress ?checksum ~url ~dst:tmp_dst @@+ fun () -> if not (Sys.file_exists tmp_dst) then fail (Some "Downloaded file not found", "Download command succeeded, but resulting file not found") else if Sys.file_exists dst && not overwrite then OpamSystem.internal_error "The downloaded file will overwrite %s." dst; if validate && OpamRepositoryConfig.(!r.force_checksums <> Some false) then OpamStd.Option.iter (fun cksum -> if not (OpamHash.check_file tmp_dst cksum) then fail (Some "Bad checksum", Printf.sprintf "Bad checksum, expected %s" (OpamHash.to_string cksum))) checksum; OpamSystem.mv tmp_dst dst; Done () let download_as ?quiet ?validate ~overwrite ?compress ?checksum url dst = match OpamUrl.local_file url with | Some src -> if src = dst then Done () else (if OpamFilename.exists dst then if overwrite then OpamFilename.remove dst else OpamSystem.internal_error "The downloaded file will overwrite %s." (OpamFilename.to_string dst); OpamFilename.copy ~src ~dst; Done ()) | None -> OpamFilename.(mkdir (dirname dst)); really_download ?quiet ~overwrite ?compress ?checksum ?validate ~url ~dst:(OpamFilename.to_string dst) let download ?quiet ?validate ~overwrite ?compress ?checksum url dstdir = let dst = OpamFilename.(create dstdir (Base.of_string (OpamUrl.basename url))) in download_as ?quiet ?validate ~overwrite ?compress ?checksum url dst @@| fun () -> dst opam-2.0.5/src/repository/opamDarcs.ml0000644000175000017500000001376213511367404016740 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamFilename.Op open OpamProcess.Job.Op module VCS = struct let name = `darcs let exists repo_root = OpamFilename.exists_dir (repo_root / "_darcs") let darcs repo_root = let dir = OpamFilename.Dir.to_string repo_root in fun ?verbose ?env ?stdout args -> OpamSystem.make_command ~dir ?verbose ?env ?stdout "darcs" args let with_tag repo_url = match repo_url.OpamUrl.hash with | None -> fun cmd -> cmd | Some t -> fun cmd -> cmd @ [ "-t"; t ] let init repo_root _repo_url = OpamFilename.mkdir repo_root; darcs repo_root [ "init" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done () let vc_dir repo_root = repo_root / "_darcs" (* Darcs has no branches, no proper diff, no way to reset, can't return a workdir diff including added/removed files... That makes it hard for handling as a remote, and the following is a bit convoluted. *) let opam_remote_tag = "opam-remote-tag" (* Marks the last fetched state *) let opam_reverse_commit = "opam-revert-laststate" let opam_local_tag = "opam-local-tag" (* Marks the current state, in the form of a reversing patch on top of the fetched state *) let fetch ?cache_dir:_ repo_root repo_url = (* Just do a fresh pull into a temp directory, and replace _darcs/ There is no easy way to diff or make sure darcs forgets about local patches otherwise. *) OpamFilename.with_tmp_dir_job @@ fun d -> let repodir = d / "repo" in darcs repo_root (with_tag repo_url [ "get"; OpamUrl.base_url repo_url; "--repodir"; OpamFilename.Dir.to_string repodir; "--quiet"; "--lazy" ]) (* --no-working-dir would be fine, except it is stored in _darcs/format *) @@> fun r -> OpamSystem.raise_on_process_error r; let darcsdir = vc_dir repo_root in OpamFilename.rmdir darcsdir; OpamFilename.move_dir ~src:(vc_dir repodir) ~dst:darcsdir; (* We put the patch that reverts to the current state on top *) darcs repo_root [ "tag"; opam_remote_tag; "-A"; "opam" ] @@> fun r -> OpamSystem.raise_on_process_error r; darcs repo_root [ "record"; "-l"; "--boring"; "--all"; "-m"; opam_reverse_commit; "-A"; "opam" ] @@> fun _r -> (* May fail if patch empty, it's ok, we keep the two tags for comparison *) darcs repo_root [ "tag"; opam_local_tag; "-A"; "opam" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done () let reset_tree repo_root _repo_url = darcs repo_root [ "obliterate"; "--all"; "-t"; opam_local_tag ] @@> fun r -> OpamSystem.raise_on_process_error r; darcs repo_root [ "obliterate"; "--all"; "-p"; opam_reverse_commit ] @@> fun r -> (* returns 0 even if patch doesn't exist *) OpamSystem.raise_on_process_error r; Done () let patch_applied _ _ = Done () let revision repo_root = (* 'Weak hash' is only supported from 2.10.3, so provide a fallback *) darcs repo_root [ "show"; "repo" ] @@> fun r -> OpamSystem.raise_on_process_error r; try OpamStd.List.find_map (fun s -> match OpamStd.String.rcut_at s ' ' with | Some (label, value) when OpamStd.String.contains ~sub:"Weak Hash" label -> Some (Done (Some value)) | _ -> None) r.OpamProcess.r_stdout with Not_found -> try OpamStd.List.find_map (fun s -> match OpamStd.String.rcut_at s ' ' with | Some (label, value) when OpamStd.String.contains ~sub:"Num Patches" label -> Some (Done (Some (Printf.sprintf "darcs-%s" value))) | _ -> None) r.OpamProcess.r_stdout with Not_found -> Done None let is_up_to_date repo_root _repo_url = darcs repo_root [ "log"; "-p"; opam_reverse_commit; "--last"; "2" ] (* last 2 since the tag counts as one *) @@> function | { OpamProcess.r_code = 0; _ } -> Done false | { OpamProcess.r_code = 1; _ } as r-> OpamProcess.cleanup ~force:true r; Done true | r -> OpamSystem.process_error r let diff repo_root repo_url = is_up_to_date repo_root repo_url @@+ function | true -> Done None | false -> let patch_file = OpamSystem.temp_file ~auto_clean: false "darcs-diff" in let finalise () = OpamSystem.remove_file patch_file in OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () -> darcs repo_root ~stdout:patch_file [ "diff"; "--from-tag"; opam_remote_tag; "--to-tag"; opam_local_tag; "--diff-command"; "diff -ruNa %2 %1"; "--no-pause-for-gui"; ] (* changing 'from' and 'to' doesn't work, so run a reverse diff command instead*) @@> fun r -> OpamSystem.raise_on_process_error r; if OpamSystem.file_is_empty patch_file then (finalise (); Done None) else Done (Some (OpamFilename.of_string patch_file)) let versioned_files repo_root = darcs repo_root [ "show" ; "files" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done r.OpamProcess.r_stdout let current_branch _dir = Done None (* No branches in Darcs *) let is_dirty dir = darcs dir [ "whatsnew"; "--quiet"; "--summary" ] @@> fun r -> Done (OpamProcess.check_success_and_cleanup r) end module B = OpamVCS.Make(VCS) opam-2.0.5/src/repository/opamGit.mli0000644000175000017500000000156013511367404016571 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Git repository backend (based on OpamVCS) *) module VCS: OpamVCS.VCS module B: OpamRepositoryBackend.S opam-2.0.5/src/repository/opamVCS.mli0000644000175000017500000000621213511367404016500 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Layer for handling version control sources through a functor *) open OpamTypes (** Each backend should implement this signature. *) module type VCS = sig val name: OpamUrl.backend (** Test whether the given repository is correctly initialized. *) val exists: dirname -> bool (** Init a repository. *) val init: dirname -> url -> unit OpamProcess.job (** Fetch changes from upstream. This is supposed to put the changes in a staging area. Be aware that the remote URL might have been changed, so make sure to update accordingly. *) val fetch: ?cache_dir:dirname -> dirname -> url -> unit OpamProcess.job (** Reset the master branch of the repository to match the remote repository state. This might still fetch more data (git submodules...), so is unsuitable for running after validation. *) val reset_tree: dirname -> url -> unit OpamProcess.job (** Confirm that applying the patch results in a clean synchronization of the working tree with its repository state. *) val patch_applied: dirname -> url -> unit OpamProcess.job (** Returns the pending modifications in the form of a patch file, or None if [dirname] is up to date with what was last fetched. *) val diff: dirname -> url -> filename option OpamProcess.job (** Returns true if the last fetched state is equal to the current, on-disk state *) val is_up_to_date: dirname -> url -> bool OpamProcess.job (** Returns an backend-specific identifier for the current revision. *) val revision: dirname -> string option OpamProcess.job (** Returns the list of files under version control *) val versioned_files: dirname -> string list OpamProcess.job (** Returns the absolute directory name for vc data (e.g. [.../project/.git]) *) val vc_dir: dirname -> dirname (** Returns the currently selected branch handle. It should be valid as the [hash] field of [OpamUrl.t]. *) val current_branch: dirname -> string option OpamProcess.job (** Returns true if the working tree state is different from the state recorded in the VCS as current. This differs from [is_up_to_date], which compares specifically to the last fetched state. This should always be [false] after [reset] has been called. *) val is_dirty: dirname -> bool OpamProcess.job end (** Create a backend from a [VCS] implementation. *) module Make(VCS: VCS): OpamRepositoryBackend.S opam-2.0.5/src/repository/opamRepository.ml0000644000175000017500000004325313511367404020061 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamProcess.Job.Op let log fmt = OpamConsole.log "REPOSITORY" fmt let slog = OpamConsole.slog let find_backend_by_kind = function | `http -> (module OpamHTTP.B: OpamRepositoryBackend.S) | `rsync -> (module OpamLocal.B: OpamRepositoryBackend.S) | `git -> (module OpamGit.B: OpamRepositoryBackend.S) | `hg -> (module OpamHg.B: OpamRepositoryBackend.S) | `darcs -> (module OpamDarcs.B: OpamRepositoryBackend.S) let find_vcs_backend = function | `git -> (module OpamGit.VCS: OpamVCS.VCS) | `hg -> (module OpamHg.VCS: OpamVCS.VCS) | `darcs -> (module OpamDarcs.VCS: OpamVCS.VCS) let url_backend url = find_backend_by_kind url.OpamUrl.backend let find_backend r = url_backend r.repo_url (* initialize the current directory *) let init root name = log "init local repo mirror at %s" (OpamRepositoryName.to_string name); (* let module B = (val find_backend repo: OpamRepositoryBackend.S) in *) let dir = OpamRepositoryPath.create root name in OpamFilename.cleandir dir; Done () let cache_url root_cache_url checksum = List.fold_left OpamUrl.Op.(/) root_cache_url (OpamHash.to_path checksum) let cache_file cache_dir checksum = let rec aux acc = function | [f] -> OpamFilename.Op.(acc // f) | d::d1 -> aux OpamFilename.Op.(acc / d) d1 | [] -> assert false in aux cache_dir (OpamHash.to_path checksum) let fetch_from_cache = let currently_downloading = ref [] in let rec no_concurrent_dls key f x = if List.mem key !currently_downloading then Run (OpamProcess.command "sleep" ["1"], (fun _ -> no_concurrent_dls key f x)) else (currently_downloading := key :: !currently_downloading; OpamProcess.Job.finally (fun () -> currently_downloading := List.filter (fun k -> k <> key) !currently_downloading) (fun () -> f x)) in fun cache_dir cache_urls checksums -> let mismatch file = OpamConsole.error "Conflicting file hashes, or broken or compromised cache!\n%s" (OpamStd.Format.itemize (fun ck -> OpamHash.to_string ck ^ if OpamHash.check_file (OpamFilename.to_string file) ck then OpamConsole.colorise `green " (match)" else OpamConsole.colorise `red " (MISMATCH)") checksums); OpamFilename.remove file; let m = "cache CONFLICT" in Done (Not_available (Some m, m)) in let dl_from_cache_job root_cache_url checksum file = let url = cache_url root_cache_url checksum in match url.OpamUrl.backend with | `http -> OpamDownload.download_as ~quiet:true ~validate:false ~overwrite:true ~checksum url file | `rsync -> (OpamLocal.rsync_file url file @@| function | Result _ | Up_to_date _-> () | Not_available (s,l) -> raise (OpamDownload.Download_fail (s,l))) | #OpamUrl.version_control -> failwith "Version control not allowed as cache URL" in try let hit_checksum, hit_file = OpamStd.List.find_map (fun ck -> let f = cache_file cache_dir ck in if OpamFilename.exists f then Some (ck, f) else None) checksums in if List.for_all (fun ck -> ck = hit_checksum || OpamHash.check_file (OpamFilename.to_string hit_file) ck) checksums then Done (Up_to_date (hit_file, OpamUrl.empty)) else mismatch hit_file with Not_found -> match checksums with | [] -> let m = "cache miss" in Done (Not_available (Some m, m)) | checksum::_ -> (* Try all cache urls in order, but only the first checksum *) let local_file = cache_file cache_dir checksum in let tmpfile = OpamFilename.add_extension local_file "tmp" in let rec try_cache_dl = function | [] -> let m = "cache miss" in Done (Not_available (Some m, m)) | root_cache_url::other_caches -> OpamProcess.Job.catch (function Failure _ | OpamDownload.Download_fail _ -> try_cache_dl other_caches | e -> raise e) @@ fun () -> dl_from_cache_job root_cache_url checksum tmpfile @@+ fun () -> if List.for_all (OpamHash.check_file (OpamFilename.to_string tmpfile)) checksums then (OpamFilename.move ~src:tmpfile ~dst:local_file; Done (Result (local_file, root_cache_url))) else mismatch tmpfile in no_concurrent_dls checksum try_cache_dl cache_urls let validate_and_add_to_cache label url cache_dir file checksums = try let mismatch, expected = OpamStd.List.find_map (fun c -> match OpamHash.mismatch (OpamFilename.to_string file) c with | Some found -> Some (found, c) | None -> None) checksums in OpamConsole.error "%s: Checksum mismatch for %s:\n\ \ expected %s\n\ \ got %s" label (OpamUrl.to_string url) (OpamHash.to_string expected) (OpamHash.to_string mismatch); OpamFilename.remove file; false with Not_found -> (match cache_dir, checksums with | Some dir, ck::_ -> OpamFilename.copy ~src:file ~dst:(cache_file dir ck) (* idea: hardlink to the other checksums? *) | _ -> ()); true (* [cache_dir] used to add to cache only *) let pull_from_upstream label ?(working_dir=false) cache_dir destdir checksums url = let module B = (val url_backend url: OpamRepositoryBackend.S) in let cksum = match checksums with [] -> None | c::_ -> Some c in let text = OpamProcess.make_command_text label (OpamUrl.string_of_backend url.OpamUrl.backend) in OpamProcess.Job.with_text text @@ (if working_dir then B.sync_dirty destdir url else let pin_cache_dir = OpamRepositoryPath.pin_cache url in let url, pull = if OpamUrl.(match url.backend with | #version_control -> false | _ -> true) && OpamFilename.exists_dir pin_cache_dir then (log "Pin cache existing for %s : %s\n" (OpamUrl.to_string url) @@ OpamFilename.Dir.to_string pin_cache_dir; let rsync = OpamUrl.parse ~backend:`rsync @@ OpamFilename.Dir.to_string pin_cache_dir in let pull = let module BR = (val url_backend rsync: OpamRepositoryBackend.S) in BR.pull_url in rsync, pull ) else url, B.pull_url in pull ?cache_dir destdir cksum url ) @@| function | (Result (Some file) | Up_to_date (Some file)) as ret -> if OpamRepositoryConfig.(!r.force_checksums) = Some false || validate_and_add_to_cache label url cache_dir file checksums then (OpamConsole.msg "[%s] %s from %s\n" (OpamConsole.colorise `green label) (match ret with Up_to_date _ -> "no changes" | _ -> "downloaded") (OpamUrl.to_string url); ret) else let m = "Checksum mismatch" in Not_available (Some m, m) | (Result None | Up_to_date None) as ret -> if checksums = [] then (OpamConsole.msg "[%s] %s from %s\n" (OpamConsole.colorise `green label) (match ret with Up_to_date _ -> "no changes" | _ -> "synchronised") (OpamUrl.to_string url); ret) else (OpamConsole.error "%s: file checksum specified, but a directory was \ retrieved from %s" label (OpamUrl.to_string url); OpamFilename.rmdir destdir; let m = "can't check directory checksum" in Not_available (Some m, m)) | Not_available _ as na -> na let rec pull_from_mirrors label ?working_dir cache_dir destdir checksums = function | [] -> invalid_arg "pull_from_mirrors: empty mirror list" | [url] -> pull_from_upstream label ?working_dir cache_dir destdir checksums url | url::mirrors -> pull_from_upstream label ?working_dir cache_dir destdir checksums url @@+ function | Not_available (_,s) -> OpamConsole.warning "%s: download of %s failed (%s), trying mirror" label (OpamUrl.to_string url) s; pull_from_mirrors label cache_dir destdir checksums mirrors | r -> Done r let pull_tree label ?cache_dir ?(cache_urls=[]) ?working_dir local_dirname checksums remote_urls = let extract_archive f = OpamFilename.cleandir local_dirname; OpamFilename.extract_job f local_dirname @@+ function | None -> Done (Up_to_date ()) | Some (Failure s) -> Done (Not_available (Some "Could not extract archive", s)) | Some e -> Done (Not_available (None, Printexc.to_string e)) in (match cache_dir with | Some cache_dir -> let text = OpamProcess.make_command_text label "dl" in OpamProcess.Job.with_text text @@ fetch_from_cache cache_dir cache_urls checksums | None -> assert (cache_urls = []); let m = "no cache" in Done (Not_available (Some m, m))) @@+ function | Up_to_date (archive, _) -> OpamConsole.msg "[%s] found in cache\n" (OpamConsole.colorise `green label); extract_archive archive | Result (archive, url) -> OpamConsole.msg "[%s] %s\n" (OpamConsole.colorise `green label) (match url.OpamUrl.backend with | `http -> "downloaded from cache at "^OpamUrl.to_string url | `rsync -> "found in external cache at "^url.OpamUrl.path | _ -> "found in external cache "^OpamUrl.to_string url); extract_archive archive | Not_available _ -> if checksums = [] && OpamRepositoryConfig.(!r.force_checksums = Some true) then OpamConsole.error_and_exit `File_error "%s: Missing checksum, and `--require-checksums` was set." label; pull_from_mirrors label ?working_dir cache_dir local_dirname checksums remote_urls @@+ function | Up_to_date None -> Done (Up_to_date ()) | Up_to_date (Some archive) | Result (Some archive) -> OpamFilename.with_tmp_dir_job @@ fun tmpdir -> let tmp_archive = OpamFilename.(create tmpdir (basename archive)) in OpamFilename.move ~src:archive ~dst:tmp_archive; extract_archive tmp_archive | Result None -> Done (Result ()) | Not_available _ as na -> Done na let revision dirname url = let kind = url.OpamUrl.backend in let module B = (val find_backend_by_kind kind: OpamRepositoryBackend.S) in B.revision dirname let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) file checksums remote_urls = (match cache_dir with | Some cache_dir -> let text = OpamProcess.make_command_text label "dl" in OpamProcess.Job.with_text text @@ fetch_from_cache cache_dir cache_urls checksums | None -> assert (cache_urls = []); let m = "no cache" in Done (Not_available (Some m, m))) @@+ function | Up_to_date (f, _) -> if not silent_hits then OpamConsole.msg "[%s] found in cache\n" (OpamConsole.colorise `green label); OpamFilename.copy ~src:f ~dst:file; Done (Result ()) | Result (f, url) -> OpamConsole.msg "[%s] downloaded from %s\n" (OpamConsole.colorise `green label) (OpamUrl.to_string url); OpamFilename.copy ~src:f ~dst:file; Done (Result ()) | Not_available _ -> if checksums = [] && OpamRepositoryConfig.(!r.force_checksums = Some true) then OpamConsole.error_and_exit `File_error "%s: Missing checksum, and `--require-checksums` was set." label; OpamFilename.with_tmp_dir_job (fun tmpdir -> pull_from_mirrors label cache_dir tmpdir checksums remote_urls @@| function | Up_to_date _ -> assert false | Result (Some f) -> OpamFilename.move ~src:f ~dst:file; Result () | Result None -> let m = "is a directory" in Not_available (Some m, m) | Not_available _ as na -> na) let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = let text = OpamProcess.make_command_text label "dl" in OpamProcess.Job.with_text text @@ fetch_from_cache cache_dir cache_urls checksums @@+ function | Up_to_date _ -> Done (Up_to_date ()) | Result (_, url) -> OpamConsole.msg "[%s] downloaded from %s\n" (OpamConsole.colorise `green label) (OpamUrl.to_string url); Done (Result ()) | Not_available _ -> OpamFilename.with_tmp_dir_job (fun tmpdir -> pull_from_mirrors label (Some cache_dir) tmpdir checksums remote_urls @@| function | Up_to_date _ -> assert false | Result (Some _) -> Result () | Result None -> let m = "is a directory" in Not_available (Some m, m) | Not_available _ as na -> na) let packages r = OpamPackage.list (OpamRepositoryPath.packages_dir r.repo_root) let packages_with_prefixes r = OpamPackage.prefixes (OpamRepositoryPath.packages_dir r.repo_root) let validate_repo_update repo update = match repo.repo_trust, OpamRepositoryConfig.(!r.validation_hook), OpamRepositoryConfig.(!r.force_checksums) with | None, Some _, Some true -> OpamConsole.error "No trust anchors for repository %s, and security was enforced: \ not updating" (OpamRepositoryName.to_string repo.repo_name); Done false | None, _, _ | _, None, _ | _, _, Some false -> Done true | Some ta, Some hook, _ -> let cmd = let open OpamRepositoryBackend in let env v = match OpamVariable.Full.to_string v, update with | "anchors", _ -> Some (S (String.concat "," ta.fingerprints)) | "quorum", _ -> Some (S (string_of_int ta.quorum)) | "repo", _ -> Some (S (OpamFilename.Dir.to_string repo.repo_root)) | "patch", Update_patch f -> Some (S (OpamFilename.to_string f)) | "incremental", Update_patch _ -> Some (B true) | "incremental", _ -> Some (B false) | "dir", Update_full d -> Some (S (OpamFilename.Dir.to_string d)) | _ -> None in match OpamFilter.single_command env hook with | cmd::args -> OpamSystem.make_command ~name:"validation-hook" ~verbose:OpamCoreConfig.(!r.verbose_level >= 2) cmd args | [] -> failwith "Empty validation hook" in cmd @@> fun r -> log "validation: %s" (OpamProcess.result_summary r); Done (OpamProcess.check_success_and_cleanup r) open OpamRepositoryBackend let apply_repo_update repo = function | Update_full d -> log "%a: applying update from scratch at %a" (slog OpamRepositoryName.to_string) repo.repo_name (slog OpamFilename.Dir.to_string) d; OpamFilename.rmdir repo.repo_root; if OpamFilename.is_symlink_dir d then (OpamFilename.copy_dir ~src:d ~dst:repo.repo_root; OpamFilename.rmdir d) else OpamFilename.move_dir ~src:d ~dst:repo.repo_root; OpamConsole.msg "[%s] Initialised\n" (OpamConsole.colorise `green (OpamRepositoryName.to_string repo.repo_name)); Done () | Update_patch f -> OpamConsole.msg "[%s] synchronised from %s\n" (OpamConsole.colorise `green (OpamRepositoryName.to_string repo.repo_name)) (OpamUrl.to_string repo.repo_url); log "%a: applying patch update at %a" (slog OpamRepositoryName.to_string) repo.repo_name (slog OpamFilename.to_string) f; let preprocess = match repo.repo_url.OpamUrl.backend with | `http | `rsync -> false | _ -> true in (OpamFilename.patch ~preprocess f repo.repo_root @@+ function | Some e -> if not (OpamConsole.debug ()) then OpamFilename.remove f; raise e | None -> OpamFilename.remove f; Done ()) | Update_empty -> OpamConsole.msg "[%s] no changes from %s\n" (OpamConsole.colorise `green (OpamRepositoryName.to_string repo.repo_name)) (OpamUrl.to_string repo.repo_url); log "%a: applying empty update" (slog OpamRepositoryName.to_string) repo.repo_name; Done () | Update_err _ -> assert false let cleanup_repo_update upd = if not (OpamConsole.debug ()) then match upd with | Update_full d -> OpamFilename.rmdir d | Update_patch f -> OpamFilename.remove f | _ -> () let update repo = log "update %a" (slog OpamRepositoryBackend.to_string) repo; let module B = (val find_backend repo: OpamRepositoryBackend.S) in B.fetch_repo_update repo.repo_name repo.repo_root repo.repo_url @@+ function | Update_err e -> raise e | (Update_empty | Update_full _ | Update_patch _) as upd -> OpamProcess.Job.catch (fun exn -> cleanup_repo_update upd; raise exn) @@ fun () -> validate_repo_update repo upd @@+ function | false -> cleanup_repo_update upd; failwith "Invalid repository signatures, update aborted" | true -> apply_repo_update repo upd @@+ fun () -> B.repo_update_complete repo.repo_root repo.repo_url let on_local_version_control url ~default f = match url.OpamUrl.backend with | #OpamUrl.version_control as backend -> (match OpamUrl.local_dir url with | None -> default | Some dir -> f dir (find_vcs_backend backend)) | #OpamUrl.backend -> default let current_branch url = on_local_version_control url ~default:(Done None) @@ fun dir (module VCS) -> VCS.current_branch dir let is_dirty url = on_local_version_control url ~default:(Done false) @@ fun dir (module VCS) -> VCS.is_dirty dir opam-2.0.5/src/repository/opamRepositoryPath.mli0000644000175000017500000000505513511367404021045 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Defines the file hierarchy in repositories *) open OpamTypes (** Repository local path: {i $opam/repo/} *) val create: dirname -> repository_name -> dirname (** Prefix where to store the downloaded files cache: {i $opam/download-cache}. Warning, this is relative to the opam root, not a repository root. *) val download_cache: dirname -> dirname (** Pin global cache, located in temporary directory, cleaned at end of process *) val pin_cache_dir: unit -> dirname (** Pin cache for a given download url. *) val pin_cache: OpamUrl.t -> dirname (** Return the repo file *) val repo: dirname -> OpamFile.Repo.t OpamFile.t (** Packages folder: {i $repo/packages} *) val packages_dir: dirname -> dirname (** Package folder: {i $repo/packages/XXX/$NAME.$VERSION} *) val packages: dirname -> string option -> package -> dirname (** Return the OPAM file for a given package: {i $repo/packages/XXX/$NAME.$VERSION/opam} *) val opam: dirname -> string option -> package -> OpamFile.OPAM.t OpamFile.t (** Return the description file for a given package: {i $repo/packages/XXX/$NAME.VERSION/descr} *) val descr: dirname -> string option -> package -> OpamFile.Descr.t OpamFile.t (** urls {i $repo/package/XXX/$NAME.$VERSION/url} *) val url: dirname -> string option -> package -> OpamFile.URL.t OpamFile.t (** files {i $repo/packages/XXX/$NAME.$VERSION/files} *) val files: dirname -> string option -> package -> dirname (** Url constructor for parts of remote repositories, when applicable (http and rsync). Function take the repo's root url. *) module Remote: sig (** Remote repo file *) val repo: url -> url (** Remote package files: {i $remote/packages} *) val packages_url: url -> url (** Remote archive {i $remote/archives/$NAME.$VERSION.tar.gz} *) val archive: url -> package -> url end opam-2.0.5/src/repository/opamRepository.mli0000644000175000017500000000625213511367404020230 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Operations on repositories (update, fetch...) based on the different backends implemented in separate modules *) open OpamTypes (** Get the list of packages *) val packages: repository -> package_set (** Get the list of packages (and their possible prefix) *) val packages_with_prefixes: repository -> string option package_map (** {2 Repository backends} *) (** Initialize {i $opam/repo/$repo} *) val init: dirname -> repository_name -> unit OpamProcess.job (** Update {i $opam/repo/$repo}. Raises [Failure] in case the update couldn't be achieved. *) val update: repository -> unit OpamProcess.job (** Fetch an URL and put the resulting tree into the supplied directory. The URL must either point to a tree (VCS, rsync) or to a known archive type. In case of an archive, the cache is used and supplied the hashes verified, then the archive uncompressed. In case of a version-controlled URL, it's checked out, or synchronised directly if local and [working_dir] was set. *) val pull_tree: string -> ?cache_dir:dirname -> ?cache_urls:url list -> ?working_dir:bool -> dirname -> OpamHash.t list -> url list -> unit download OpamProcess.job (** Same as [pull_tree], but for fetching a single file. *) val pull_file: string -> ?cache_dir:dirname -> ?cache_urls:url list -> ?silent_hits:bool -> filename -> OpamHash.t list -> url list -> unit download OpamProcess.job (** Same as [pull_file], but without a destination file: just ensures the file is present in the cache. *) val pull_file_to_cache: string -> cache_dir:dirname -> ?cache_urls:url list -> OpamHash.t list -> url list -> unit download OpamProcess.job (** The file where the file with the given hash is stored under cache at given dirname. *) val cache_file: dirname -> OpamHash.t -> filename (** Get the optional revision associated to a backend (git hash, etc.). *) val revision: dirname -> url -> version option OpamProcess.job (** Get the version-control branch for that url. Only applicable for local, version controlled URLs. Returns [None] in other cases. *) val current_branch: url -> string option OpamProcess.job (** Returns true if the url points to a local, version-controlled directory that has uncommitted changes *) val is_dirty: url -> bool OpamProcess.job (** Find a backend *) val find_backend: repository -> (module OpamRepositoryBackend.S) val find_backend_by_kind: OpamUrl.backend -> (module OpamRepositoryBackend.S) opam-2.0.5/src/repository/opamHg.ml0000644000175000017500000001051713511367404016235 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamFilename.Op open OpamProcess.Job.Op module VCS = struct let name = `hg let mark_prefix = "opam-mark" let exists repo_root = OpamFilename.exists_dir (repo_root / ".hg") let hg repo_root = let dir = OpamFilename.Dir.to_string repo_root in fun ?verbose ?env ?stdout args -> OpamSystem.make_command ~dir ?verbose ?env ?stdout "hg" args let init repo_root _repo_url = OpamFilename.mkdir repo_root; hg repo_root [ "init" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done () let mark_from_url url = match url.OpamUrl.hash with | None -> mark_prefix | Some fragment -> mark_prefix ^ "-" ^ fragment let fetch ?cache_dir:_ repo_root repo_url = let src = OpamUrl.base_url repo_url in let rev = OpamStd.Option.default "default" repo_url.OpamUrl.hash in let mark = mark_from_url repo_url in hg repo_root [ "pull"; "--rev"; rev; src ] @@> fun r -> OpamSystem.raise_on_process_error r; hg repo_root [ "bookmark"; "--force"; "--rev"; rev; mark ] @@> fun r -> OpamSystem.raise_on_process_error r; Done () let revision repo_root = hg repo_root [ "identify"; "--id" ] @@> fun r -> OpamSystem.raise_on_process_error r; match r.OpamProcess.r_stdout with | [] -> Done None | full::_ -> if String.length full > 8 then Done (Some (String.sub full 0 8)) else Done (Some full) let reset_tree repo_root repo_url = let mark = mark_from_url repo_url in hg repo_root [ "update"; "--clean"; "--rev"; mark ] @@> fun r -> OpamSystem.raise_on_process_error r; Done () let patch_applied = reset_tree let diff repo_root repo_url = let patch_file = OpamSystem.temp_file ~auto_clean:false "hg-diff" in let finalise () = OpamSystem.remove_file patch_file in OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () -> let mark = mark_from_url repo_url in hg repo_root ~stdout:patch_file [ "diff"; "--subrepos"; "--reverse"; "--rev"; mark ] @@> fun r -> if OpamProcess.is_failure r then (finalise (); OpamSystem.internal_error "Hg error: '%s' not found." mark) else if OpamSystem.file_is_empty patch_file then (finalise (); Done None) else Done (Some (OpamFilename.of_string patch_file)) let is_up_to_date repo_root repo_url = let mark = mark_from_url repo_url in hg repo_root [ "status"; "--subrepos"; "--rev"; mark ] @@> fun r -> OpamSystem.raise_on_process_error r; Done (r.OpamProcess.r_stdout = []) let versioned_files repo_root = hg repo_root [ "locate" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done r.OpamProcess.r_stdout let vc_dir repo_root = OpamFilename.Op.(repo_root / ".hg") let current_branch repo_root = hg repo_root [ "identify"; "--bookmarks" ] @@> fun r -> OpamSystem.raise_on_process_error r; match r.OpamProcess.r_stdout with | [] -> Done None | marks::_ -> let marks = OpamStd.String.split marks ' ' in let marks = List.filter (OpamStd.String.starts_with ~prefix:mark_prefix) marks in match marks with | mark::_ -> Done (Some mark) | [] -> hg repo_root [ "identify"; "--branch" ] @@> fun r -> OpamSystem.raise_on_process_error r; match r.OpamProcess.r_stdout with | branch::_ when branch <> "default" -> Done (Some branch) | _ -> Done None let is_dirty repo_root = hg repo_root [ "status"; "--subrepos" ] @@> fun r -> OpamSystem.raise_on_process_error r; Done (r.OpamProcess.r_stdout = []) end module B = OpamVCS.Make(VCS) opam-2.0.5/src/repository/opamRepositoryConfig.ml0000644000175000017500000000703013511367404021200 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes type dl_tool_kind = [ `Curl | `Default ] type t = { download_tool: (arg list * dl_tool_kind) Lazy.t; validation_hook: arg list option; retries: int; force_checksums: bool option; } type 'a options_fun = ?download_tool:(OpamTypes.arg list * dl_tool_kind) Lazy.t -> ?validation_hook:arg list option -> ?retries:int -> ?force_checksums:bool option -> 'a let default = { download_tool = lazy ( try let tools = if OpamStd.Sys.(os () = Darwin) then ["wget", `Default; "curl", `Curl] else ["curl", `Curl; "wget", `Default] in let cmd, kind = List.find (fun (c,_) -> OpamSystem.resolve_command c <> None) tools in [ CIdent cmd, None ], kind with Not_found -> OpamConsole.error_and_exit `Configuration_error "Could not find a suitable download command. Please make sure you \ have either \"curl\" or \"wget\" installed, or specify a custom \ command through variable OPAMFETCH." ); validation_hook = None; retries = 3; force_checksums = None; } let setk k t ?download_tool ?validation_hook ?retries ?force_checksums = let (+) x opt = match opt with Some x -> x | None -> x in k { download_tool = t.download_tool + download_tool; validation_hook = t.validation_hook + validation_hook; retries = t.retries + retries; force_checksums = t.force_checksums + force_checksums; } let set t = setk (fun x () -> x) t let r = ref default let update ?noop:_ = setk (fun cfg () -> r := cfg) !r let initk k = let open OpamStd.Config in let open OpamStd.Option.Op in let download_tool = env_string "FETCH" >>= (fun s -> let args = OpamStd.String.split s ' ' in match args with | cmd::a -> let cmd, kind = if OpamStd.String.ends_with ~suffix:"curl" cmd then (CIdent "curl", None), `Curl else if cmd = "wget" then (CIdent "wget", None), `Default else (CString cmd, None), `Default in let c = cmd :: List.map (fun a -> OpamTypes.CString a, None) a in Some (lazy (c, kind)) | [] -> None ) >>+ fun () -> env_string "CURL" >>| (fun s -> lazy ([CString s, None], `Curl)) in let validation_hook = env_string "VALIDATIONHOOK" >>| fun s -> match List.map (fun s -> CString s, None) (OpamStd.String.split s ' ') with | [] -> None | l -> Some l in let force_checksums = match env_bool "REQUIRECHECKSUMS", env_bool "NOCHECKSUMS" with | Some true, _ -> Some (Some true) | _, Some true -> Some (Some false) | None, None -> None | _ -> Some None in setk (setk (fun c -> r := c; k)) !r ?download_tool ?validation_hook ?retries:(env_int "RETRIES") ?force_checksums let init ?noop:_ = initk (fun () -> ()) opam-2.0.5/src/repository/opamRepositoryConfig.mli0000644000175000017500000000255213511367404021355 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration options for the repository lib (record, global reference, setter, initialisation) *) (** Toggles parsing of the tool's output to detect errors (curl returns 0 on a 404) *) type dl_tool_kind = [ `Curl | `Default ] type t = { download_tool: (OpamTypes.arg list * dl_tool_kind) Lazy.t; validation_hook: OpamTypes.arg list option; retries: int; force_checksums: bool option; } type 'a options_fun = ?download_tool:(OpamTypes.arg list * dl_tool_kind) Lazy.t -> ?validation_hook:OpamTypes.arg list option -> ?retries:int -> ?force_checksums:bool option -> 'a include OpamStd.Config.Sig with type t := t and type 'a options_fun := 'a options_fun opam-2.0.5/src/repository/opamLocal.mli0000644000175000017500000000216113511367404017076 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Rsync repository backend, for local or ssh sources *) module B: OpamRepositoryBackend.S open OpamTypes val rsync_dirs: ?args:string list -> ?exclude_vcdirs:bool -> OpamUrl.t -> OpamFilename.Dir.t -> OpamFilename.Dir.t download OpamProcess.job val rsync_file: ?args:string list -> OpamUrl.t -> OpamFilename.t -> OpamFilename.t download OpamProcess.job opam-2.0.5/src/repository/opamDarcs.mli0000644000175000017500000000156213511367404017104 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Darcs repository backend (based on OpamVCS) *) module VCS: OpamVCS.VCS module B: OpamRepositoryBackend.S opam-2.0.5/src/repository/opamRepositoryBackend.ml0000644000175000017500000000707213511367404021330 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes let log = OpamConsole.log "REPO_BACKEND" let slog = OpamConsole.slog type update = | Update_full of dirname | Update_patch of filename | Update_empty | Update_err of exn module type S = sig val name: OpamUrl.backend val pull_url: ?cache_dir:dirname -> dirname -> OpamHash.t option -> url -> filename option download OpamProcess.job val fetch_repo_update: repository_name -> ?cache_dir:dirname -> dirname -> url -> update OpamProcess.job val repo_update_complete: dirname -> url -> unit OpamProcess.job val revision: dirname -> version option OpamProcess.job val sync_dirty: dirname -> url -> filename option download OpamProcess.job end let compare r1 r2 = compare r1.repo_name r2.repo_name let to_string r = Printf.sprintf "%s at %s from %s" (OpamRepositoryName.to_string r.repo_name) (OpamFilename.Dir.to_string r.repo_root) (OpamUrl.to_string r.repo_url) let local dirname = { repo_name = OpamRepositoryName.of_string "local"; repo_root = dirname; repo_url = OpamUrl.empty; repo_trust = None; } let to_json r = `O [ ("name", OpamRepositoryName.to_json r.repo_name); ("kind", `String (OpamUrl.string_of_backend r.repo_url.OpamUrl.backend)); ] let check_digest filename = function | Some expected when OpamRepositoryConfig.(!r.force_checksums) <> Some false -> (match OpamHash.mismatch (OpamFilename.to_string filename) expected with | None -> true | Some bad_hash -> OpamConsole.error "Bad checksum for %s: expected %s\n\ \ got %s\n\ Metadata might be out of date, in this case use `opam update`." (OpamFilename.to_string filename) (OpamHash.to_string expected) (OpamHash.to_string bad_hash); false) | _ -> true open OpamProcess.Job.Op let job_text name label = OpamProcess.Job.with_text (Printf.sprintf "[%s: %s]" (OpamConsole.colorise `green (OpamRepositoryName.to_string name)) label) let get_diff parent_dir dir1 dir2 = log "diff: %a/{%a,%a}" (slog OpamFilename.Dir.to_string) parent_dir (slog OpamFilename.Base.to_string) dir1 (slog OpamFilename.Base.to_string) dir2; let patch = OpamSystem.temp_file ~auto_clean: false "patch" in let patch_file = OpamFilename.of_string patch in let finalise () = OpamFilename.remove patch_file in OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () -> OpamSystem.make_command ~verbose:OpamCoreConfig.(!r.verbose_level >= 2) ~dir:(OpamFilename.Dir.to_string parent_dir) ~stdout:patch "diff" [ "-ruaN"; OpamFilename.Base.to_string dir1; OpamFilename.Base.to_string dir2; ] @@> function | { OpamProcess.r_code = 0; _ } -> finalise(); Done None | { OpamProcess.r_code = 1; _ } as r -> OpamProcess.cleanup ~force:true r; Done (Some patch_file) | r -> OpamSystem.process_error r opam-2.0.5/src/repository/opamLocal.ml0000644000175000017500000001746713511367404016744 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamProcess.Job.Op let log fmt = OpamConsole.log "RSYNC" fmt let rsync_arg = "-rLptgoDrvc" (* if rsync -arv return 4 lines, this means that no files have changed *) let rsync_trim = function | [] -> [] | _ :: t -> match List.rev t with | _ :: _ :: _ :: l -> List.filter ((<>) "./") l | _ -> [] let call_rsync check args = OpamSystem.make_command "rsync" args @@> fun r -> match r.OpamProcess.r_code with | 0 -> Done (Some (rsync_trim r.OpamProcess.r_stdout)) | 3 | 5 | 10 | 11 | 12 -> (* protocol or file errors *) Done None | 20 -> (* signal *) raise Sys.Break | 23 | 24 -> (* partial, mostly mode, link or perm errors. But may also be a complete error so we do an additional check *) if check () then (OpamConsole.warning "Rsync partially failed:\n%s" (OpamStd.Format.itemize ~bullet:"" (fun x -> x) r.OpamProcess.r_stderr); Done (Some (rsync_trim r.OpamProcess.r_stdout))) else Done None | 30 | 35 -> (* timeouts *) Done None | _ -> OpamSystem.process_error r let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst = log "rsync: src=%s dst=%s" src dst; let remote = String.contains src ':' in let overlap src dst = let norm d = Filename.concat d "" in OpamStd.String.starts_with ~prefix:(norm src) (norm dst) && not (OpamStd.String.starts_with ~prefix:(norm (Filename.concat src OpamSwitch.external_dirname)) (norm dst)) || OpamStd.String.starts_with ~prefix:(norm dst) (norm src) in let exclude_args = if exclude_vcdirs then [ "--exclude"; ".git"; "--exclude"; "_darcs"; "--exclude"; ".hg"; "--exclude"; ".#*"; "--exclude"; OpamSwitch.external_dirname ^ "*"; ] else [ "--exclude"; ".#*"; "--exclude"; OpamSwitch.external_dirname ^ "*"; ] in if not(remote || Sys.file_exists src) then Done (Not_available (None, src)) else if src = dst then Done (Up_to_date []) else if overlap src dst then (OpamConsole.error "Cannot sync %s into %s: they overlap" src dst; Done (Not_available (None, src))) else ( OpamSystem.mkdir dst; call_rsync (fun () -> not (OpamSystem.dir_is_empty dst)) ( rsync_arg :: args @ exclude_args @ [ "--delete"; "--delete-excluded"; src; dst; ]) @@| function | None -> Not_available (None, src) | Some [] -> Up_to_date [] | Some lines -> Result lines ) let is_remote url = url.OpamUrl.transport <> "file" let rsync_dirs ?args ?exclude_vcdirs url dst = let src_s = OpamUrl.(Op.(url / "").path) in (* Ensure trailing '/' *) let dst_s = OpamFilename.Dir.to_string dst in if not (is_remote url) && not (OpamFilename.exists_dir (OpamFilename.Dir.of_string src_s)) then Done (Not_available (None, Printf.sprintf "Directory %s does not exist" src_s)) else rsync ?args ?exclude_vcdirs src_s dst_s @@| function | Not_available _ as na -> na | Result _ -> if OpamFilename.exists_dir dst then Result dst else Not_available (None, dst_s) | Up_to_date _ -> Up_to_date dst let rsync_file ?(args=[]) url dst = let src_s = url.OpamUrl.path in let dst_s = OpamFilename.to_string dst in log "rsync_file src=%s dst=%s" src_s dst_s; if not (is_remote url || OpamFilename.(exists (of_string src_s))) then Done (Not_available (None, src_s)) else if src_s = dst_s then Done (Up_to_date dst) else (OpamFilename.mkdir (OpamFilename.dirname dst); call_rsync (fun () -> Sys.file_exists dst_s) ( rsync_arg :: args @ [ src_s; dst_s ]) @@| function | None -> Not_available (None, src_s) | Some [] -> Up_to_date dst | Some [_] -> if OpamFilename.exists dst then Result dst else Not_available (None, src_s) | Some l -> OpamSystem.internal_error "unknown rsync output: {%s}" (String.concat ", " l)) module B = struct let name = `rsync let pull_dir_quiet local_dirname url = rsync_dirs url local_dirname let fetch_repo_update repo_name ?cache_dir:_ repo_root url = log "pull-repo-update"; let quarantine = OpamFilename.Dir.(of_string (to_string repo_root ^ ".new")) in let finalise () = OpamFilename.rmdir quarantine in OpamProcess.Job.catch (fun e -> finalise (); Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (match OpamUrl.local_dir url with | Some dir -> OpamFilename.copy_dir ~src:dir ~dst:quarantine; (* fixme: Would be best to symlink, but at the moment our filename api isn't able to cope properly with the symlinks afterwards OpamFilename.link_dir ~target:dir ~link:quarantine; *) Done (Result quarantine) | None -> if OpamFilename.exists_dir repo_root then OpamFilename.copy_dir ~src:repo_root ~dst:quarantine else OpamFilename.mkdir quarantine; pull_dir_quiet quarantine url) @@+ function | Not_available _ -> finalise (); Done (OpamRepositoryBackend.Update_err (Failure "rsync failed")) | Up_to_date _ -> finalise (); Done OpamRepositoryBackend.Update_empty | Result _ -> if not (OpamFilename.exists_dir repo_root) || OpamFilename.dir_is_empty repo_root then Done (OpamRepositoryBackend.Update_full quarantine) else OpamProcess.Job.finally finalise @@ fun () -> OpamRepositoryBackend.job_text repo_name "diff" @@ OpamRepositoryBackend.get_diff (OpamFilename.dirname_dir repo_root) (OpamFilename.basename_dir repo_root) (OpamFilename.basename_dir quarantine) @@| function | None -> OpamRepositoryBackend.Update_empty | Some p -> OpamRepositoryBackend.Update_patch p let repo_update_complete _ _ = Done () let pull_url ?cache_dir:_ local_dirname _checksum remote_url = OpamFilename.mkdir local_dirname; let dir = OpamFilename.Dir.to_string local_dirname in let remote_url = match OpamUrl.local_dir remote_url with | Some _ -> (* ensure that rsync doesn't recreate a subdir: add trailing '/' *) OpamUrl.Op.(remote_url / "") | None -> remote_url in rsync remote_url.OpamUrl.path dir @@| function | Not_available _ as na -> na | (Result _ | Up_to_date _) as r -> let res x = match r with | Result _ -> Result x | Up_to_date _ -> Up_to_date x | _ -> assert false in if OpamUrl.has_trailing_slash remote_url then res None else let filename = OpamFilename.Op.(local_dirname // OpamUrl.basename remote_url) in if OpamFilename.exists filename then res (Some filename) else Not_available (None, Printf.sprintf "Could not find target file %s after rsync with %s. \ Perhaps you meant %s/ ?" (OpamUrl.basename remote_url) (OpamUrl.to_string remote_url) (OpamUrl.to_string remote_url)) let revision _ = Done None let sync_dirty dir url = pull_url dir None url end opam-2.0.5/src/repository/opamVCS.ml0000644000175000017500000001245113511367404016331 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStd.Op open OpamProcess.Job.Op module type VCS = sig val name: OpamUrl.backend val exists: dirname -> bool val init: dirname -> url -> unit OpamProcess.job val fetch: ?cache_dir:dirname -> dirname -> url -> unit OpamProcess.job val reset_tree: dirname -> url -> unit OpamProcess.job val patch_applied: dirname -> url -> unit OpamProcess.job val diff: dirname -> url -> filename option OpamProcess.job val is_up_to_date: dirname -> url -> bool OpamProcess.job val revision: dirname -> string option OpamProcess.job val versioned_files: dirname -> string list OpamProcess.job val vc_dir: dirname -> dirname val current_branch: dirname -> string option OpamProcess.job val is_dirty: dirname -> bool OpamProcess.job end module Make (VCS: VCS) = struct let name = VCS.name let fetch_repo_update repo_name ?cache_dir repo_root repo_url = if VCS.exists repo_root then OpamProcess.Job.catch (fun e -> Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (VCS.fetch ?cache_dir repo_root repo_url) @@+ fun () -> OpamRepositoryBackend.job_text repo_name "diff" (VCS.diff repo_root repo_url) @@| function | None -> OpamRepositoryBackend.Update_empty | Some patch -> OpamRepositoryBackend.Update_patch patch else OpamProcess.Job.catch (fun e -> OpamFilename.rmdir repo_root; Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "init" (VCS.init repo_root repo_url) @@+ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (VCS.fetch ?cache_dir repo_root repo_url) @@+ fun () -> let tmpdir = OpamFilename.Dir.(of_string (to_string repo_root ^".new")) in OpamFilename.copy_dir ~src:repo_root ~dst:tmpdir; OpamProcess.Job.catch (fun e -> OpamFilename.rmdir tmpdir; raise e) @@ fun () -> VCS.reset_tree tmpdir repo_url @@| fun () -> OpamRepositoryBackend.Update_full tmpdir let repo_update_complete dirname url = VCS.patch_applied dirname url @@+ fun () -> Done () let pull_url ?cache_dir dirname checksum url = if checksum <> None then invalid_arg "VC pull_url doesn't allow checksums"; OpamProcess.Job.catch (fun e -> OpamConsole.error "Could not synchronize %s from %S:\n%s" (OpamFilename.Dir.to_string dirname) (OpamUrl.to_string url) (match e with Failure fw -> fw | _ -> Printexc.to_string e); Done (Not_available (None, OpamUrl.to_string url))) @@ fun () -> if VCS.exists dirname then VCS.fetch ?cache_dir dirname url @@+ fun () -> VCS.is_up_to_date dirname url @@+ function | true -> Done (Up_to_date None) | false -> VCS.reset_tree dirname url @@+ fun () -> Done (Result None) else (OpamFilename.mkdir dirname; VCS.init dirname url @@+ fun () -> VCS.fetch ?cache_dir dirname url @@+ fun () -> VCS.reset_tree dirname url @@+ fun () -> Done (Result None)) let revision repo_root = VCS.revision repo_root @@+ fun r -> Done (OpamStd.Option.map OpamPackage.Version.of_string r) let sync_dirty repo_root repo_url = match OpamUrl.local_dir repo_url with | None -> pull_url repo_root None repo_url | Some dir -> VCS.versioned_files dir @@+ fun files -> let files = List.map OpamFilename.(remove_prefix dir) (OpamFilename.rec_files (VCS.vc_dir dir)) @ files in let stdout_file = let f = OpamSystem.temp_file "rsync-files" in let fd = open_out f in List.iter (fun s -> output_string fd s; output_char fd '\n') files; close_out fd; f in (* Remove non-versionned files from destination *) (* fixme: doesn't clean directories *) let fset = OpamStd.String.Set.of_list files in List.iter (fun f -> let basename = OpamFilename.remove_prefix repo_root f in if not (OpamFilename.(starts_with (VCS.vc_dir repo_root) f) || OpamStd.String.Set.mem basename fset) then OpamFilename.remove f) (OpamFilename.rec_files repo_root); OpamLocal.rsync_dirs ~args:["--files-from"; stdout_file] ~exclude_vcdirs:false repo_url repo_root @@+ fun result -> OpamSystem.remove stdout_file; Done (match result with | Up_to_date _ -> Up_to_date None | Result _ -> Result None | Not_available _ as na -> na) end opam-2.0.5/src/format/0000755000175000017500000000000013511367404013535 5ustar nicoonicooopam-2.0.5/src/format/opamPp.mli0000644000175000017500000001372213511367404015501 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Generic bidirectional transformation toolbox for parsing/printing *) open OpamTypes (** {2 Parsing positions and error reporting helpers} *) (** Format error reporting: position and message *) type bad_format = pos option * string (** All the following parsing function raise [Bad_format] in case the input does not have the right format. *) exception Bad_format of bad_format exception Bad_format_list of bad_format list (** Raise [Bad_format]. *) val bad_format: ?pos:pos -> ('a, unit, string, 'b) format4 -> 'a val string_of_bad_format: ?file:string -> exn -> string (** Adds a position to a Bad_format exception if it doesn't have one yet *) val add_pos: pos -> exn -> exn (** {2 Parser/printers} *) (** The type of bidirectional parsers from ['a] to ['b]. We abuse the terms and describe going from ['a] to ['b] as "parsing", and going from ['b] to ['a] as "printing". Parsing is generally error-prone, while printing is not expected to fail, so the handling isn't really symmetrical. [parse (print x)] should always be the identity, while no guarantee is given regarding [print (parse x)] *) type ('a, 'b) t = private { parse: pos:pos -> 'a -> 'b; print: 'b -> 'a; ppname: string; name_constr: string -> string; } (** Base constructor for Pp.t, from a parser function and a printer function. [name_constr] is used to construct the resulting name when on the left of a pipe. Names are for tracing errors. *) val pp : ?name:string -> ?name_constr:(string -> string) -> (pos:pos -> 'a -> 'b) -> ('b -> 'a) -> ('a, 'b) t (** Constructor of Pp.t from a name and a pair *) val of_pair : string -> ('a -> 'b) * ('b -> 'a) -> ('a, 'b) t (** Base call for parsing with a pp *) val parse : ('a, 'b) t -> pos:pos -> 'a -> 'b (** Base call for printing with a pp *) val print : ('a, 'b) t -> 'b -> 'a (** Error handling *) (** Raises an exception handled by parser calls *) val unexpected : ?pos:pos -> unit -> 'a (** {3 Various pp constructors} *) module Op : sig (** Piping pps together: the left-hand pp is called first when parsing, last when printing *) val ( -| ) : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t (** Combinator to parse lists to different types using nested pairs *) val ( ^+ ) : ('a, 'b) t -> ('a list, 'c) t -> ('a list, 'b * 'c) t end val identity : ('a, 'a) t (** Always parses to [None] *) val ignore : ('a, 'b option) t (** Identity pp, unless the check fails. The check is turned into an assertion when printing *) val check : ?name:string -> ?errmsg:string -> ('a -> bool) -> ('a, 'a) t val map_pair : ?name:string -> ?posf1:('a -> pos) -> ?posf2:('b -> pos) -> ('a, 'c) t -> ('b, 'd) t -> ('a * 'b, 'c * 'd) t (** Builds a pp of pairs by passing the second term along *) val map_fst : ('a, 'b) t -> ('a * 'c, 'b * 'c) t (** Builds a pp of pairs by passing the first term along *) val map_snd : ('a, 'b) t -> ('c * 'a, 'c * 'b) t val map_list : ?name:string -> ?posf:('a -> pos) -> ('a, 'b) t -> ('a list, 'b list) t val map_option : ?name:string -> ('a, 'b) t -> ('a option, 'b option) t (** Parsing fails on non-singleton lists *) val singleton : ('a list, 'a) t (** Use for the rightmost element to close a [^+] sequence, e.g. [pp1 ^+ pp2 ^+ last -| pp3] *) val last : ('a list, 'a) t module type STR = sig type t val of_string : string -> t val to_string : t -> string end (** Generates a string pp from a module with of/to string functions *) val of_module : string -> (module STR with type t = 'a) -> (string, 'a) t (** Parses to None on the empty list. Often combined with singleton ([opt (singleton _)]) *) val opt : ('a list, 'b) t -> ('a list, 'b option) t val default : 'a -> ('a option, 'a) t (** [fallback p1 p2] is [p1], except that parsing is allowed to fail and will in that case try to parse through [p2]. Can be useful for backwards compatibility, but use with care *) val fallback : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t (** {3 Combinators to parse to a record from a list of (field name, field setter, field getter)} *) (** Used to parse a single field of a record: ['a] on the left is the accumulator, or value of the record parsed so far. (in lens terms, [get] would be the print operation that extracts the field for the record, while [set] would be the parse operation that takes the input and record, and updates a given field in the record) *) type ('a, 'value) field_parser = ('a * 'value option, 'a) t (** Make a field parser from setter, getter and base pp. [cleanup] is an optional sanitisation function that is called on parsed elements before calling the setter. *) val ppacc : ?cleanup:(pos:pos -> 'acc -> 'a -> 'a) -> ('a -> 'acc -> 'acc) -> ('acc -> 'a) -> ('value, 'a) t -> ('acc, 'value) field_parser (** Same as [ppacc], but when the field may be unset in the record, i.e. the getter returns an option *) val ppacc_opt : ?cleanup:(pos:pos -> 'acc -> 'a -> 'a) -> ('a -> 'acc -> 'acc) -> ('acc -> 'a option) -> ('value, 'a) t -> ('acc, 'value) field_parser (** A field parser that ignores its argument *) val ppacc_ignore : ('a, value) field_parser val embed : ('a -> 'acc -> 'acc) -> ('acc -> 'a) -> ('a, 'value) field_parser -> ('acc, 'value) field_parser opam-2.0.5/src/format/opamSwitch.mli0000644000175000017500000000311413511367404016355 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** The type for switch names *) include OpamStd.ABSTRACT (** System switch name *) val unset: t (** Determines wether this switch is internal (bound to a prefix within the opam root) or living somewhere else, in which case its prefix dir is inferred from its name using [get_root] *) val is_external: t -> bool (** Returns the root directory of the switch with the given name, assuming the given opam root *) val get_root: OpamFilename.Dir.t -> t -> OpamFilename.Dir.t (** The relative dirname in which the opam switch prefix sits for external switches ("_opam") *) val external_dirname: string (** Returns an external switch handle from a directory name. Resolves to the destination if [external_dirname] at the given dir is a symlink to another [external_dirname]. *) val of_dirname: OpamFilename.Dir.t -> t opam-2.0.5/src/format/opamFilter.ml0000644000175000017500000005211713511367404016177 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamStd.Op let log ?level fmt = OpamConsole.log "FILTER" ?level fmt let slog = OpamConsole.slog type env = full_variable -> variable_contents option type fident = name option list * variable * (string * string) option let to_string t = let rec aux ?(context=`Or) t = let paren ?(cond=false) f = if cond || OpamFormatConfig.(!r.all_parens) then Printf.sprintf "(%s)" f else f in match t with | FBool b -> string_of_bool b | FString s -> Printf.sprintf "%S" s | FIdent (pkgs,var,converter) -> OpamStd.List.concat_map "+" (function None -> "_" | Some p -> OpamPackage.Name.to_string p) pkgs ^ (if pkgs <> [] then ":" else "") ^ OpamVariable.to_string var ^ (match converter with | Some (it,ifu) -> "?"^it^":"^ifu | None -> "") | FOp(e,s,f) -> paren ~cond:(context <> `Or && context <> `And) (Printf.sprintf "%s %s %s" (aux ~context:`Relop e) (OpamPrinter.relop s) (aux ~context:`Relop f)) | FAnd (e,f) -> paren ~cond:(context <> `Or && context <> `And) (Printf.sprintf "%s & %s" (aux ~context:`And e) (aux ~context:`And f)) | FOr (e,f) -> paren ~cond:(context <> `Or) (Printf.sprintf "%s | %s" (aux e) (aux f)) | FNot e -> paren ~cond:(context = `Relop) (Printf.sprintf "!%s" (aux ~context:`Not e)) | FDefined e -> paren ~cond:(context = `Relop) (Printf.sprintf "?%s" (aux ~context:`Defined e)) | FUndef f -> Printf.sprintf "#undefined(%s)" (aux f) in aux t let rec fold_down_left f acc filter = match filter with | FOp(l,_,r) | FAnd(l,r) | FOr(l,r) -> fold_down_left f (fold_down_left f (f acc filter) l) r | FNot(x) -> fold_down_left f (f acc filter) x | x -> f acc x let rec map_up f = function | FOp (l, op, r) -> f (FOp (map_up f l, op, map_up f r)) | FAnd (l, r) -> f (FAnd (map_up f l, map_up f r)) | FOr (l, r) -> f (FOr (map_up f l, map_up f r)) | FNot x -> f (FNot (map_up f x)) | FUndef x -> f (FUndef (map_up f x)) | (FBool _ | FString _ | FIdent _ | FDefined _) as flt -> f flt (* ["%%"], ["%{xxx}%"], or ["%{xxx"] if unclosed *) let string_interp_regex = let open Re in let notclose = rep (alt [ diff notnl (set "}"); seq [char '}'; alt [diff notnl (set "%"); stop] ] ]) in compile (alt [ str "%%"; seq [str "%{"; group (greedy notclose); opt (group (str "}%"))]; ]) let escape_expansions = Re.replace_string Re.(compile @@ char '%') ~by:"%%" let escape_strings = map_up @@ function | FString s -> FString (escape_expansions s) | flt -> flt let fident_variables = function | [], var, _ -> [OpamVariable.Full.global var] | pkgs, var, _ -> List.map (function | Some n -> OpamVariable.Full.create n var | None -> OpamVariable.Full.self var) pkgs (* extracts variables appearing in interpolations in a string*) let string_variables s = let matches = let rec aux acc pos = try let ss = Re.exec ~pos string_interp_regex s in if Re.test ss 2 then aux (Re.get ss 1 :: acc) (fst (Re.get_ofs ss 0) + String.length (Re.get ss 0)) else aux acc (pos+1) with Not_found -> acc in aux [] 0 in List.fold_left (fun acc s -> try fident_variables (filter_ident_of_string s) @ acc with Failure _ -> acc) [] matches let variables filter = fold_down_left (fun acc -> function | FString s -> string_variables s @ acc | FIdent f -> fident_variables f @ acc | _ -> acc) [] filter (* Some cast functions on values *) let value ?default = function | FBool b -> B b | FString s -> S s | FUndef f -> (match default with | Some d -> d | None -> failwith ("Undefined filter value: "^to_string f)) | e -> raise (Invalid_argument ("filter value: "^to_string e)) let value_string ?default = function | FBool b -> string_of_bool b | FString s -> s | FUndef f -> (match default with | Some d -> d | None -> failwith ("Undefined string filter value: "^to_string f)) | e -> raise (Invalid_argument ("value_string: "^to_string e)) let value_bool ?default = function | FBool b -> b | FString "true" -> true | FString "false" -> false | FUndef f -> (match default with | Some d -> d | None -> failwith ("Undefined boolean filter value: "^to_string f)) | e -> (match default with | Some d -> d | None -> raise (Invalid_argument ("value_bool: "^to_string e))) (* Desugars the "enable" pseudo-variable *) let desugar_fident ((packages,var,converter) as fident) = let enable = OpamVariable.of_string "enable" in if packages <> [] && var = enable && converter = None then packages, OpamVariable.of_string "installed", Some ("enable","disable") else fident (* Resolves an ident to variable contents *) let resolve_ident_raw ?(no_undef_expand=false) env fident = let open OpamStd.Option.Op in let packages,var,converter = desugar_fident fident in let bool_of_value = function | B b -> Some b | S s | L [s] -> (try Some (bool_of_string s) with Invalid_argument _ -> None) | L _ -> None in let resolve name = let var = match name with | Some n -> OpamVariable.Full.create n var | None -> OpamVariable.Full.self var in env var in let value_opt : variable_contents option = match packages with | [] -> env (OpamVariable.Full.global var) | [name] -> resolve name | names -> List.fold_left (fun acc name -> if acc = Some false then acc else match resolve name with | Some (B true) -> acc | v -> v >>= bool_of_value) (Some true) names >>| fun b -> B b in match converter, no_undef_expand with | Some (iftrue, iffalse), false -> (match value_opt >>= bool_of_value with | Some true -> Some (S iftrue) | Some false -> Some (S iffalse) | None -> Some (S iffalse)) | _ -> value_opt (* Resolves [FIdent] to string or bool, using its package and converter specification *) let resolve_ident ?no_undef_expand env fident = match resolve_ident_raw ?no_undef_expand env fident with | Some (B b) -> FBool b | Some (S s) -> FString s | Some (L l) -> FString (String.concat " " l) | None -> FUndef (FIdent fident) (* Resolves ["%{x}%"] string interpolations *) let expand_string ?(partial=false) ?default env text = let default fident = match default, partial with | None, false -> None | Some df, false -> Some (df fident) | None, true -> Some (Printf.sprintf "%%{%s}%%" fident) | Some df, true -> Some (Printf.sprintf "%%{%s}%%" (df fident)) in let env v = if partial then match env v with | Some (S s) -> Some (S (escape_expansions s)) | x -> x else env v in let f g = let str = Re.Group.get g 0 in if str = "%%" then (if partial then "%%" else "%") else if not (OpamStd.String.ends_with ~suffix:"}%" str) then (log "ERR: Unclosed variable replacement in %S\n" str; str) else let fident = String.sub str 2 (String.length str - 4) in resolve_ident ~no_undef_expand:partial env (filter_ident_of_string fident) |> value_string ?default:(default fident) in Re.replace string_interp_regex ~f text let unclosed_expansions text = let re = Re.( compile (alt [ str "%%"; seq [str "%{"; group (greedy (rep (diff notnl (char '}')))); opt (group (str "}%"))]; ]) ) in Re.all re text |> OpamStd.List.filter_map @@ fun gr -> if Re.Group.test gr 1 && not (Re.Group.test gr 2) then Some (Re.Group.offset gr 0, Re.Group.get gr 0) else None let map_variables_in_fident f (_,_,conv as fid) = let vars = fident_variables fid in match List.map f vars with | [] -> assert false | v::vars -> let var_name = OpamVariable.Full.variable v in match OpamVariable.Full.scope v with | OpamVariable.Full.Global -> if vars <> [] then invalid_arg "OpamFilter.map_variables"; [], var_name, conv | OpamVariable.Full.Package _ | OpamVariable.Full.Self -> if (List.exists (fun v -> OpamVariable.Full.variable v <> var_name) vars) then invalid_arg "OpamFilter.map_variables"; List.map (fun v -> match OpamVariable.Full.scope v with | OpamVariable.Full.Package name -> Some name | OpamVariable.Full.Self -> None | OpamVariable.Full.Global -> invalid_arg "OpamFilter.map_variables") (v::vars), var_name, conv let map_variables_in_string f = expand_string ~partial:true ~default:(fun fid_string -> try fid_string |> filter_ident_of_string |> map_variables_in_fident f |> string_of_filter_ident with Failure _ -> fid_string) (fun _ -> None) let map_variables f = map_up @@ function | FIdent fid -> FIdent (map_variables_in_fident f fid) | FString s -> FString (map_variables_in_string f s) | flt -> flt let rec distribute_negations ?(neg=false) = function | FAnd (f1, f2) -> let f1 = distribute_negations ~neg f1 in let f2 = distribute_negations ~neg f2 in if neg then FOr (f1, f2) else FAnd (f1, f2) | FOr (f1, f2) -> let f1 = distribute_negations ~neg f1 in let f2 = distribute_negations ~neg f2 in if neg then FAnd (f1, f2) else FOr (f1, f2) | FBool b -> FBool (if neg then not b else b) | FOp (f1, op, f2) -> FOp (distribute_negations ~neg:false f1, (if neg then OpamFormula.neg_relop op else op), distribute_negations ~neg:false f2) | FNot f -> distribute_negations ~neg:(not neg) f | f -> if neg then FNot f else f let logop1 cstr op = function | FUndef f -> FUndef (cstr f) | e -> try FBool (op (value_bool e)) with Invalid_argument s -> log "ERR: %s" s; FUndef (cstr e) let logop2 cstr op absorb e f = match e, f with | _, FBool x when x = absorb -> FBool x | FBool x, _ when x = absorb -> FBool x | FUndef x, FUndef y | FUndef x, y | x, FUndef y -> FUndef (cstr x y) | f, g -> try FBool (op (value_bool f) (value_bool g)) with Invalid_argument s -> log "ERR: %s" s; FUndef (cstr f g) (* Reduce expressions to values *) let rec reduce_aux ?no_undef_expand ~default_str env = let reduce = reduce ?no_undef_expand ~default_str env in function | FUndef x -> FUndef x | FBool b -> FBool b | FString s -> FString s | FIdent i -> resolve_ident ?no_undef_expand env i | FOp (e,relop,f) -> (match reduce e, reduce f with | FUndef x, FUndef y -> FUndef (FOp (x, relop, y)) | FUndef x, y -> FUndef (FOp (x, relop, escape_strings y)) | x, FUndef y -> FUndef (FOp (escape_strings x, relop, y)) | e,f -> FBool (OpamFormula.check_relop relop (OpamVersionCompare.compare (value_string e) (value_string f)))) | FAnd (e,f) -> logop2 (fun e f -> FAnd (e,f)) (&&) false (reduce e) (reduce f) | FOr (e,f) -> logop2 (fun e f -> FOr (e,f)) (||) true (reduce e) (reduce f) | FNot e -> logop1 (fun e -> FNot e) not (reduce e) | FDefined e -> match reduce e with | FUndef _ -> FBool false | _ -> FBool true and reduce ?no_undef_expand ?(default_str = Some (fun _ -> "")) env e = match reduce_aux ?no_undef_expand ~default_str env e with | FString s -> (try FString (expand_string ?default:default_str env s) with Failure _ -> FUndef (FString (expand_string ~partial:true env s))) | e -> e let eval ?default env e = value ?default (reduce env e) let eval_to_bool ?default env e = value_bool ?default (reduce env e) let opt_eval_to_bool env opt = match opt with | None -> true | Some e -> value_bool ~default:false (reduce env e) let eval_to_string ?default env e = value_string ?default (reduce env e) let partial_eval env flt = match reduce ~no_undef_expand:true ~default_str:None env flt with | FUndef f -> f | f -> escape_strings f let ident_of_var v = (match OpamVariable.Full.scope v with | OpamVariable.Full.Global -> [] | OpamVariable.Full.Self -> [None] | OpamVariable.Full.Package p -> [Some p]), OpamVariable.Full.variable v, None let ident_of_string s = ident_of_var (OpamVariable.Full.of_string s) let ident_value ?default env id = value ?default (resolve_ident env id) let ident_string ?default env id = value_string ?default (resolve_ident env id) let ident_bool ?default env id = value_bool ?default (resolve_ident env id) (* Substitute the file contents *) let expand_interpolations_in_file env file = let f = OpamFilename.of_basename file in let src = OpamFilename.add_extension f "in" in let ic = OpamFilename.open_in src in let oc = OpamFilename.open_out f in let rec aux () = match try Some (input_line ic) with End_of_file -> None with | Some s -> output_string oc (expand_string ~default:(fun _ -> "") env s); output_char oc '\n'; aux () | None -> () in aux (); close_in ic; close_out oc (* Apply filters and interpolations to package commands *) let arguments env (a,f) = if opt_eval_to_bool env f then match a with | CString s -> [expand_string ~default:(fun _ -> "") env s] | CIdent i -> let fident = filter_ident_of_string i in match resolve_ident_raw env fident with | Some (S s) -> [s] | Some (B b) -> [string_of_bool b] | Some (L sl) -> sl | None -> log "ERR in replacement: undefined ident %S" i; [""] else [] let command env (l, f) = if opt_eval_to_bool env f then match List.concat (List.map (arguments env) l) with | [] -> None | l -> Some l else None let commands env l = OpamStd.List.filter_map (command env) l let single_command env l = List.concat (List.map (arguments env) l) let simple_arg_variables = function | CString s -> string_variables s | CIdent i -> try fident_variables (filter_ident_of_string i) with Failure _ -> [] let filter_opt_variables = function | None -> [] | Some f -> variables f let argument_variables (a,f) = simple_arg_variables a @ filter_opt_variables f let command_variables (l,f) = List.fold_left (fun acc a -> argument_variables a @ acc) (filter_opt_variables f) l let commands_variables l = List.fold_left (fun acc c -> command_variables c @ acc) [] l let rec of_formula atom_f = function | Empty -> FBool true | Atom at -> atom_f at | Block f -> of_formula atom_f f | And (a, b) -> FAnd (of_formula atom_f a, of_formula atom_f b) | Or (a, b) -> FOr (of_formula atom_f a, of_formula atom_f b) let filter_constraints ?default_version ?default env filtered_constraint = OpamFormula.partial_eval (function | Filter flt -> if eval_to_bool ?default env flt then `True else `False | Constraint (relop, v) -> try let v = eval_to_string env v in `Formula (Atom (relop, OpamPackage.Version.of_string v)) with Failure msg -> match default_version with | None -> log "Warn: ignoring version constraint %a: %s" (slog to_string) v msg; `Formula (Empty) | Some v -> `Formula (Atom (relop, v))) filtered_constraint (* { build & "%{skromuk}%" = "flib%" } *) (* { build & "flib%%" = "flib%" } *) let partial_filter_constraints env filtered_constraint = OpamFormula.partial_eval (function | Filter flt -> (match partial_eval env flt with | FBool true -> `True | FBool false -> `False | FUndef f | f -> `Formula (Atom (Filter f))) | Constraint (relop, flt_v) -> (match partial_eval env flt_v with | FBool b -> `Formula (Atom (Constraint (relop, FString (string_of_bool b)))) | FUndef f | f -> `Formula (Atom (Constraint (relop, f))))) filtered_constraint let gen_filter_formula constraints filtered_formula = OpamFormula.map (fun (name, fc) -> match constraints fc with | `True -> Atom (name, Empty) | `False -> Empty | `Formula c -> Atom (name, c)) filtered_formula let filter_formula ?default_version ?default env ff = gen_filter_formula (filter_constraints ?default_version ?default env) ff let partial_filter_formula env ff = gen_filter_formula (partial_filter_constraints env) ff let string_of_filtered_formula = let string_of_constraint = OpamFormula.string_of_formula (function | Constraint (op, FString s) -> Printf.sprintf "%s \"%s\"" (OpamPrinter.relop op) s | Constraint (op, (FIdent _ as v)) -> Printf.sprintf "%s %s" (OpamPrinter.relop op) (to_string v) | Constraint (op, v) -> Printf.sprintf "%s (%s)" (OpamPrinter.relop op) (to_string v) | Filter f -> to_string f) in OpamFormula.string_of_formula (function | n, Empty -> OpamPackage.Name.to_string n | n, c -> let paren = match c with Atom (Constraint _) -> false | _ -> true in Printf.sprintf "%s %s%s%s" (OpamPackage.Name.to_string n) (if paren then "{" else "") (string_of_constraint c) (if paren then "}" else "")) let variables_of_filtered_formula ff = OpamFormula.fold_left (fun acc (_, f) -> OpamFormula.fold_left (fun acc -> function | Constraint _ -> acc | Filter f -> variables f @ acc) acc f) [] ff let deps_var_env ~build ~post ?test ?doc ?dev var = let get_opt = function | Some b -> Some (B b) | None -> invalid_arg "filter_deps" in match OpamVariable.Full.to_string var with | "build" -> Some (B build) | "post" -> Some (B post) | "with-test" -> get_opt test | "with-doc" -> get_opt doc | "dev" -> get_opt dev | _ -> None let filter_deps ~build ~post ?test ?doc ?dev ?default_version ?default deps = filter_formula ?default_version ?default (deps_var_env ~build ~post ?test ?doc ?dev) deps let rec simplify_extended_version_formula ef = let to_pure ef = try Some (OpamFormula.map (function | Constraint (op, FString s) when string_variables s = [] -> Atom (op, OpamPackage.Version.of_string s) | _ -> failwith "Impure") ef) with Failure _ -> None in let to_filtered = OpamFormula.map (fun (op, v) -> Atom (Constraint (op, FString (OpamPackage.Version.to_string v)))) in match to_pure ef with | Some f -> OpamStd.Option.map to_filtered (OpamFormula.simplify_version_formula f) | None -> match ef with | And _ | Or _ -> let conj = match ef with And _ -> true | _ -> false in let l = OpamFormula.(if conj then ands_to_list else ors_to_list) ef in (try let filtered, pure = List.fold_left (fun (filtered, pure) ef1 -> match to_pure ef1 with | Some f -> filtered, f::pure | None -> let ef1 = simplify_extended_version_formula ef1 in match ef1 with | None -> (* Always false *) if conj then failwith "false" else filtered, pure | Some ef1 -> (match to_pure ef1 with | Some f -> filtered, f::pure | None -> ef1::filtered, pure)) ([], []) l in let mk = OpamFormula.(if conj then ands else ors) in match OpamFormula.simplify_version_formula (mk pure) with | None -> if conj then None else Some (mk (List.rev filtered)) | Some pure -> Some (mk (List.rev_append filtered [to_filtered pure])) with Failure _ -> None) | Block ef -> simplify_extended_version_formula ef | atom -> Some atom let atomise_extended = OpamFormula.map (fun (x, c) -> match c with | Empty -> Atom (x, (FBool true, None)) | cs -> let rec aux filters = function | Atom (Filter f) -> Atom (x, (FAnd (f,filters), None)) | Atom (Constraint c) -> Atom (x, (filters, Some c)) | Empty -> (match filters with FBool true -> Empty | f -> Atom (x, (f, None))) | Block f -> aux filters f | And _ as f -> let filters, constraints = let rec split filters conj = function | Atom (Filter f) :: r -> split (FAnd (f,filters)) conj r | cstr :: r -> split filters (cstr::conj) r | [] -> filters, conj in split filters [] (OpamFormula.ands_to_list f) in OpamFormula.ands (List.rev_map (aux filters) constraints) | Or (a, b) -> Or (aux filters a, aux filters b) in aux (FBool true) cs) opam-2.0.5/src/format/opamPp.ml0000644000175000017500000001710713511367404015331 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamStd.Op type bad_format = pos option * string exception Bad_format of bad_format exception Bad_format_list of bad_format list let bad_format ?pos fmt = Printf.ksprintf (fun str -> raise (Bad_format (pos,str))) fmt let add_pos pos = function | Bad_format (pos_opt,msg) as e -> if pos_opt = None || pos_opt = Some pos_null then Bad_format (Some pos, msg) else e | e -> e let rec string_of_bad_format ?file e = match e, file with | Bad_format (None, msg), Some f | Bad_format (Some (f, -1, -1), msg), _ -> Printf.sprintf "In %s:\n%s" f msg | Bad_format (Some pos, msg), _ -> Printf.sprintf "At %s:\n%s" (string_of_pos pos) msg | Bad_format (None, msg), None -> Printf.sprintf "Input error:\n%s" msg | Bad_format_list bfl, _ -> OpamStd.List.concat_map "\n" (fun bf -> string_of_bad_format ?file (Bad_format bf)) bfl | _ -> Printexc.to_string e let () = Printexc.register_printer @@ function | (Bad_format _ | Bad_format_list _ as e) -> Some (string_of_bad_format ?file:None e) | _ -> None type ('a,'b) t = { parse: pos:pos -> 'a -> 'b; print: 'b -> 'a; ppname: string; name_constr: string -> string; } let pp ?(name="") ?(name_constr=fun x -> x) parse print = { parse; print; ppname = name; name_constr; } let of_pair name (simple_parse, print) = pp ~name (fun ~pos:_ -> simple_parse) print (** Utility functions *) exception Unexpected of pos option let unexpected ?pos () = raise (Unexpected pos) (** Basic pp usage *) let parse pp ~pos x = try pp.parse ~pos x with | Bad_format _ | Bad_format_list _ as e -> raise (add_pos pos e) | Unexpected (Some pos) -> bad_format ~pos "expected %s" pp.ppname | Unexpected None -> bad_format ~pos "expected %s" pp.ppname | Failure msg -> bad_format ~pos "%s%s" (if pp.ppname <> "" then Printf.sprintf "while expecting %s: " pp.ppname else "") msg | e -> OpamStd.Exn.fatal e; bad_format ~pos "%s%s" (if pp.ppname <> "" then Printf.sprintf "while expecting %s: " pp.ppname else "") (Printexc.to_string e) let print pp x = pp.print x (** Pp combination and transformation *) (** Piping *) let (-|) pp1 pp2 = { parse = (fun ~pos x -> let y = pp1.parse ~pos x in parse pp2 ~pos y ); print = pp1.print @* pp2.print; ppname = (match pp2.ppname with "" -> pp1.ppname | name -> pp1.name_constr name); name_constr = pp1.name_constr @* pp2.name_constr; } let identity = { parse = (fun ~pos:_ x -> x); print = (fun x -> x); ppname = ""; name_constr = (fun x -> x); } let ignore = { parse = (fun ~pos:_ -> OpamStd.Option.none); print = (fun _ -> assert false); ppname = "ignored"; name_constr = (fun _ -> ""); } let check ?name ?errmsg f = pp ?name (fun ~pos x -> if not (f x) then match errmsg with | Some m -> bad_format ~pos "%s" m | None -> unexpected () else x) (fun x -> assert ( f x || (OpamConsole.error "Check failed on value printing%s%s" (match name with Some n -> " at "^n | None -> "") (match errmsg with Some e -> " ("^e^")" | None -> ""); false)); x) let map_pair ?name ?posf1 ?posf2 (pp1: ('a,'b) t) (pp2: ('c,'d) t) = let name = match name with | None -> Printf.sprintf "(%s, %s)" pp1.ppname pp2.ppname | Some n -> n in pp ~name (fun ~pos (a,b) -> let posf1 = OpamStd.Option.default (fun _ -> pos) posf1 in parse pp1 ~pos:(posf1 a) a, let posf2 = OpamStd.Option.default (fun _ -> pos) posf2 in parse pp2 ~pos:(posf2 b) b) (fun (a,b) -> print pp1 a, print pp2 b) let map_fst pp1 = pp (fun ~pos (a,b) -> pp1.parse ~pos a, b) (fun (a, b) -> pp1.print a, b) let map_snd pp1 = pp (fun ~pos (a,b) -> a, pp1.parse ~pos b) (fun (a, b) -> a, pp1.print b) let map_list ?name ?posf pp1 = let name = match name with | None -> pp1.ppname ^ "*" | Some n -> n in pp ~name (fun ~pos l -> let posf = OpamStd.Option.default (fun _ -> pos) posf in List.rev (List.rev_map (fun x -> parse pp1 ~pos:(posf x) x) l)) (List.rev @* List.rev_map (print pp1)) let map_option ?name pp1 = let name = match name with | None -> pp1.ppname ^ "?" | Some n -> n in pp ~name (fun ~pos -> OpamStd.Option.map (parse pp1 ~pos)) (OpamStd.Option.map (print pp1)) let singleton = { parse = (fun ~pos:_ -> function [x] -> x | _ -> unexpected ()); print = (fun x -> [x]); ppname = ""; name_constr = (fun x -> x); } (** Pps from strings *) module type STR = sig type t val of_string: string -> t val to_string: t -> string end let of_module (type a) name m = let module X = (val m: STR with type t = a) in pp ~name (fun ~pos:_ -> X.of_string) X.to_string (** Build tuples from lists *) let (^+) pp1 pp2 = pp ~name:(Printf.sprintf "%s %s" pp1.ppname pp2.ppname) (fun ~pos -> function | x::r -> parse pp1 ~pos x, parse pp2 ~pos r | [] -> unexpected ()) (fun (x,y) -> print pp1 x :: print pp2 y) let last = singleton let opt pp1 = pp ~name:("?"^pp1.ppname) (fun ~pos -> function [] -> None | l -> Some (pp1.parse ~pos l)) (function Some x -> pp1.print x | None -> []) let default d = pp (fun ~pos:_ -> function None -> d | Some x -> x) (fun x -> Some x) let fallback pp1 pp2 = let parse ~pos x = try pp1.parse ~pos x with e -> OpamStd.Exn.fatal e; let bt = Printexc.get_raw_backtrace () in try pp2.parse ~pos x with _ -> Printexc.raise_with_backtrace e bt in { pp1 with parse } module Op = struct let ( -| ) = ( -| ) let ( ^+ ) = ( ^+ ) end (** Pps for file contents (item lists), mostly list of [Variable(...)] fields *) type ('a, 'value) field_parser = ('a * 'value option, 'a) t (** add setter/getter and an accumulator to a pp; useful to use to get/set field records *) let ppacc_opt (* : ('a -> 'b -> 'a) -> ('a -> 'b option) -> ('value, 'b) t -> 'a field_parser *) = fun ?(cleanup = fun ~pos:_ _acc x -> x) set get pp1 -> let parse ~pos = function | acc, Some s -> set (cleanup ~pos acc (pp1.parse ~pos s)) acc | acc, None -> acc in let print s = s, OpamStd.Option.map pp1.print (get s) in { parse; print; ppname = pp1.ppname; name_constr = (fun x -> x); } let ppacc ?cleanup set get pp = ppacc_opt set (fun x -> Some (get x)) ?cleanup pp let ppacc_ignore = { parse = (fun ~pos:_ (acc,_) -> acc); print = (fun s -> s, None); ppname = ""; name_constr = (fun _ -> ""); } let embed set get ppacc = { parse = (fun ~pos (acc, x) -> set (ppacc.parse ~pos (get acc, x)) acc); print = (fun s -> let s1, v = ppacc.print (get s) in set s1 s, v); ppname = ppacc.ppname; name_constr = ppacc.name_constr; } opam-2.0.5/src/format/opamFormat.ml0000644000175000017500000006565413511367404016214 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamTypesBase open OpamStd.Op open OpamPp open OpamPp.Op let item_pos = function | Section (pos,_) | Variable (pos,_,_) -> pos let value_pos = function | Bool (pos, _) | Int (pos, _) | String (pos, _) | Logop (pos, _, _, _) | Pfxop (pos, _, _) | Relop (pos, _, _, _) | Prefix_relop (pos, _, _) | Ident (pos, _) | List (pos, _) | Group (pos, _) | Option (pos, _, _) | Env_binding (pos, _, _, _) -> pos let values_pos = function | [] -> None | x::_ -> Some (value_pos x) (** low-level Pps for the Lines parser ([string list list]) *) type lines = string list list let lines_set ~empty ~add ~fold pp1 = pp ~name:(Printf.sprintf "(%s) lines" pp1.ppname) (fun ~pos:(file,_,_) lines -> List.fold_left (fun (i,acc) -> function | [] -> i + 1, acc | line -> i + 1, add (parse pp1 ~pos:(file,i,0) line) acc) (1, empty) lines |> snd) (fun x -> List.rev (fold (fun v acc -> print pp1 v::acc) x [])) let lines_map ~empty ~add ~fold pp1 = pp ~name:(Printf.sprintf "(%s) lines" pp1.ppname) (fun ~pos:(file,_,_) lines -> List.fold_left (fun (i,acc) -> function | [] -> i + 1, acc | line -> let k,v = parse pp1 ~pos:(file,i,0) line in i + 1, add k v acc) (1, empty) lines |> snd) (fun x -> List.rev (fold (fun k v acc -> print pp1 (k,v)::acc) x [])) (* let list2 pp1 pp2 = pp ~name:(Printf.sprintf "%s %s" pp1.ppname pp2.ppname) (function [a; b] -> parse pp1 a, parse pp2 b | _ -> unexpected ()) (fun (x,y) -> [print pp1 x; print pp2 y]) *) (** All Pps dealing with the [value] type *) module V = struct (** Low-level Pps *) let bool = pp ~name:"bool" (fun ~pos:_ -> function Bool (_,b) -> b | _ -> unexpected ()) (fun b -> Bool (pos_null,b)) let int = pp ~name:"int" (fun ~pos:_ -> function Int (_,i) -> i | _ -> unexpected ()) (fun i -> Int (pos_null,i)) let pos_int = int -| check ~name:"positive-int" (fun i -> i >= 0) let ident = pp ~name:"ident" (fun ~pos:_ -> function Ident (_,i) -> i | _ -> unexpected ()) (fun str -> Ident (pos_null,str)) let string = pp ~name:"string" (fun ~pos:_ -> function String (_,s) -> s | _ -> unexpected ()) (fun str -> String (pos_null,str)) let string_tr = string -| pp (fun ~pos:_ -> OpamStd.String.strip) (fun x -> x) let simple_arg = pp ~name:"ident-or-string" (fun ~pos:_ -> function | Ident (_,i) -> CIdent i | String (_,s) -> CString s | _ -> unexpected ()) (function | CIdent i -> Ident (pos_null, i) | CString s -> String (pos_null, s)) let variable_contents = pp ~name:"string-or-stringlist-or-bool" (fun ~pos:_ -> function | String (_,s) -> S s | Bool (_,b) -> B b | List (_,l) -> L (List.map (function String (_, s) -> s | _ -> unexpected ()) l) | _ -> unexpected ()) (function | S s -> String (pos_null, s) | B b -> Bool (pos_null, b) | L l -> List (pos_null, List.map (fun s -> String (pos_null, s)) l)) let list = pp ~name:"list" ~name_constr:(Printf.sprintf "[%s]") (fun ~pos:_ -> function | List (_,l) -> l | x -> [x]) (fun l -> List (pos_null, l)) let group = pp ~name:"group" ~name_constr:(Printf.sprintf "(%s)") (fun ~pos:_ -> function | Group (_,l) -> l | x -> [x]) (fun l -> Group (pos_null, l)) let option = pp ~name:"option" (fun ~pos:_ -> function | Option (_,k,l) -> k, l | k -> k, []) (function | (v, []) -> v | (v, l) -> Option (pos_null, v, l)) let option_strict = pp ~name:"option" (fun ~pos -> function | Option (_,k,l) -> k, l | _ -> bad_format ~pos "Expected an option") (function (v, l) -> Option (pos_null, v, l)) let map_group pp1 = group -| map_list ~posf:value_pos pp1 let list_depth expected_depth = let rec depth = function | List (_,[]) -> 1 | List (_,(v::_)) -> 1 + depth v | Option (_,v,_) -> depth v | _ -> 0 in let rec wrap n v = if n <= 0 then v else wrap (n-1) (List (pos_null, [v])) in let rec lift n v = if n <= 0 then v else match v with | List (_, [v]) -> lift (n-1) v | v -> v in pp (fun ~pos:_ v -> wrap (expected_depth - depth v) v) (fun v -> lift expected_depth v) let option_depth expected_depth = let rec depth = function | Option (_,v,_) -> 1 + depth v | _ -> 0 in let rec wrap n v = if n <= 0 then v else wrap (n-1) (Option (pos_null, v, [])) in let rec lift n v = if n <= 0 then v else match v with | Option (_, v, []) -> lift (n-1) v | v -> v in pp (fun ~pos:_ v -> wrap (expected_depth - depth v) v) (fun v -> lift expected_depth v) let map_list ?(depth=0) pp1 = list_depth depth -| pp ~name:(Printf.sprintf "[%s]" pp1.ppname) (fun ~pos:_ v -> match v with | List (_, l) -> List.rev @@ List.rev_map (fun v -> parse pp1 ~pos:(value_pos v) v) l | _ -> unexpected ()) (function | l -> List (pos_null, List.rev @@ List.rev_map (print pp1) l)) let map_option_contents pp1 pp2 = map_pair ~name:(Printf.sprintf "%s ?{%s}" pp1.ppname pp2.ppname) ~posf1:value_pos ~posf2:(fun v -> OpamStd.Option.default pos_null (values_pos v)) pp1 pp2 let map_option pp1 pp2 = option -| map_option_contents pp1 pp2 let map_options_2 pp1 pp2 pp3 = option_depth 2 -| option_strict -| map_option_contents (option_strict -| map_option_contents pp1 pp2) pp3 -| pp (fun ~pos:_ ((a,b),c) -> a,b,c) (fun (a,b,c) -> (a,b),c) let map_options_3 pp1 pp2 pp3 pp4 = option_depth 3 -| option_strict -| map_option_contents (option_strict -| map_option_contents (option_strict -| map_option_contents pp1 pp2) pp3) pp4 -| pp (fun ~pos:_ (((a,b),c),d) -> a,b,c,d) (fun (a,b,c,d) -> ((a,b),c),d) let map_pair pp1 pp2 = pp ~name:(Printf.sprintf "[%s %s]" pp1.ppname pp2.ppname) (fun ~pos:_ -> function | List (_,[a; b]) -> parse pp1 ~pos:(value_pos a) a, parse pp2 ~pos:(value_pos b) b | _ -> unexpected ()) (fun (a, b) -> List (pos_null, [pp1.print a; pp2.print b])) let map_triple pp1 pp2 pp3 = pp ~name:(Printf.sprintf "[%s %s %s]" pp1.ppname pp2.ppname pp3.ppname) (fun ~pos:_ -> function | List (_,[a; b; c]) -> parse pp1 ~pos:(value_pos a) a, parse pp2 ~pos:(value_pos b) b, parse pp3 ~pos:(value_pos c) c | _ -> unexpected ()) (fun (a, b, c) -> List (pos_null, [pp1.print a; pp2.print b; pp3.print c])) (** Pps for the [value] type to higher level types *) let url = string -| of_module "url" (module OpamUrl) let url_with_backend backend = string -| pp ~name:"url" (fun ~pos:_ -> OpamUrl.parse ~backend ~handle_suffix:false) (fun url -> OpamUrl.to_string url) (* a hack to allow "system" compiler as ident rather than string. For backwards-compat. Deprecated, for migration only *) let compiler_version = let system_compiler = "system" in let parse ~pos:_ = function | Ident (_, v) when v = system_compiler -> v | String (_, v) -> v | _ -> unexpected () in let print v = if v = system_compiler then print ident v else print string v in pp ~name:"compiler-version" parse print let filter_ident = ident -| pp ~name:"filter-ident" (fun ~pos:_ -> filter_ident_of_string) string_of_filter_ident let filter = let rec parse_filter ~pos l = let rec aux = function | Bool (_,b) -> FBool b | String (_,s) -> FString s | Int (_,i) -> FString (string_of_int i) | Ident (pos,_) as id -> FIdent (parse ~pos filter_ident id) | Group (pos,g) -> parse_filter ~pos g | Relop (_,op,e,f) -> FOp (aux e, op, aux f) | Pfxop (_,`Not,e) -> FNot (aux e) | Pfxop (_,`Defined,e) -> FDefined (aux e) | Logop(_,`And,e,f)-> FAnd (aux e, aux f) | Logop(_,`Or, e,f)-> FOr (aux e, aux f) | _ -> unexpected () in match l with | [] -> FBool true | [Group (_, ([] | _::_::_))] | _::_::_ -> bad_format ~pos "expected a single filter expression" | [Group(_,[f])] | [f] -> aux f in let print_filter f = let rec aux ?(context=`Or) f = let group_if ?(cond=false) f = if cond || OpamFormatConfig.(!r.all_parens) then Group (pos_null, [f]) else f in match f with | FString s -> print string s | FIdent fid -> print filter_ident fid | FBool b -> print bool b | FOp(e,s,f) -> group_if ~cond:(context <> `Or && context <> `And) (Relop (pos_null, s, aux ~context:`Relop e, aux ~context:`Relop f)) | FOr(e,f) -> group_if ~cond:(context <> `Or) (Logop (pos_null, `Or, aux ~context:`Or e, aux ~context:`Or f)) | FAnd(e,f) -> group_if ~cond:(context <> `Or && context <> `And) (Logop (pos_null, `And, aux ~context:`And e, aux ~context:`And f)) | FNot f -> group_if ~cond:(context = `Relop) (Pfxop (pos_null, `Not, aux ~context:`Not f)) | FDefined f -> group_if ~cond:(context = `Relop) (Pfxop (pos_null, `Defined, aux ~context:`Defined f)) | FUndef _ -> assert false in match f with | FBool true -> [] | f -> [aux f] in pp ~name:"filter-expression" parse_filter print_filter let arg = map_option simple_arg (opt filter) let command = map_option (map_list arg) (opt filter) let constraints version = let rec parse_constraints ~pos:_ l = let rec aux = function | Prefix_relop (pos, op, v) -> Atom (op, parse version ~pos v) | Logop (_, `And, l, r) -> And (aux l, aux r) | Logop (_, `Or, l, r) -> Or (aux l, aux r) | Pfxop (_,`Not,v) -> OpamFormula.neg (fun (op, s) -> (OpamFormula.neg_relop op, s)) (aux v) | Group (pos, g) -> Block (parse_constraints ~pos g) | v -> unexpected ~pos:(value_pos v) () in OpamFormula.ands (List.map aux l) in let rec print_constraints cs = let rec aux ?(in_and=false) cs = let group_if ?(cond=false) f = if cond || OpamFormatConfig.(!r.all_parens) then Group (pos_null, [f]) else f in match cs with | Empty -> assert false | Atom (r, v) -> group_if (Prefix_relop (pos_null, r, print version v)) | And (x, y) -> group_if (Logop (pos_null, `And, aux ~in_and:true x, aux ~in_and:true y)) | Or (x, y) -> group_if ~cond:in_and (Logop (pos_null, `Or, aux x, aux y)) | Block g -> Group (pos_null, print_constraints g) in match cs with | Empty -> [] | cs -> [aux cs] in pp ~name:(version.ppname ^ "-constraints") parse_constraints print_constraints let filtered_constraints version = let rec parse_cs ~pos:_ items = let rec aux_parse = function | Prefix_relop (pos, op, v) -> Atom (Constraint (op, parse version ~pos v)) | Logop (_, `And, a, b) -> OpamFormula.ands [aux_parse a; aux_parse b] | Logop (_, `Or, a, b) -> OpamFormula.ors [aux_parse a; aux_parse b] | Group (pos, g) -> OpamFormula.Block (parse_cs ~pos g) | Pfxop (pos, `Not, v) -> parse_cs ~pos [v] |> OpamFormula.neg (function | Constraint (op, v) -> Constraint (OpamFormula.neg_relop op, v) | Filter f -> Filter (FNot f)) | filt -> let f = filter.parse ~pos:(value_pos filt) [filt] in Atom (Filter f) in OpamFormula.ands (List.map aux_parse items) in let rec print_cs cs = let rec aux ?(in_and=false) cs = let group_if ?(cond=false) f = if cond || OpamFormatConfig.(!r.all_parens) then Group (pos_null, [f]) else f in match cs with | Empty -> assert false | And (x, y) -> group_if (Logop (pos_null, `And, aux ~in_and:true x, aux ~in_and:true y)) | Or (x, y) -> group_if ~cond:in_and (Logop (pos_null, `Or, aux x, aux y)) | Block g -> Group (pos_null, print_cs g) | Atom (Constraint (op,v)) -> group_if (Prefix_relop (pos_null, op, print version v)) | Atom (Filter flt) -> (match filter.print flt with | f1::fr -> group_if (List.fold_left (fun a b -> Logop (pos_null, `And, a, b)) f1 fr) | [] -> Group (pos_null, [])) in match cs with | Empty -> [] | cs -> [aux cs] in pp ~name:"filtered-constraints" parse_cs print_cs let version = string -| of_module "version" (module OpamPackage.Version) let ext_version = pp ~name:"version-expr" (fun ~pos:_ -> function | String (pos,s) -> let _ = try OpamPackage.Version.of_string (OpamFilter.expand_string (fun _ -> Some (S "-")) s) with Failure msg -> bad_format ~pos "Invalid version string %S: %s" s msg in FString s | Ident (_,s) -> FIdent (filter_ident_of_string s) | _ -> unexpected ()) (function | FString s -> String (pos_null, s) | FIdent id -> Ident (pos_null, string_of_filter_ident id) | _ -> assert false) let pkgname = string -| of_module "pkg-name" (module OpamPackage.Name) let package_atom constraints = map_option pkgname constraints (* These two functions are duplicated from [OpamFormula] but we need to have a it here because of a change on [Block] handling: to have a coherent printing, we must not always discard them *) let rec ands_to_list = function | Empty -> [] | And (e,f) -> List.rev_append (rev_ands_to_list e) (ands_to_list f) | x -> [x] and rev_ands_to_list = function | Empty -> [] | And (e,f) -> List.rev_append (ands_to_list f) (rev_ands_to_list e) | x -> [x] let rec ors_to_list = function | Empty -> [] | Or (e,f) | Block (Or (e,f)) -> List.rev_append (rev_ors_to_list e) (ors_to_list f) | x -> [x] and rev_ors_to_list = function | Empty -> [] | Or (e,f) | Block (Or (e,f)) -> List.rev_append (ors_to_list f) (rev_ors_to_list e) | x -> [x] let package_formula_items kind constraints = let split, join = match kind with | `Conj -> ands_to_list, OpamFormula.ands | `Disj -> ors_to_list, OpamFormula.ors in let rec parse_formula ~pos:_ l = let rec aux = function | String (pos,_) | Option (pos,_,_) as at -> Atom (parse (package_atom constraints) ~pos at) | Group (pos,g) -> Block (parse_formula ~pos g) | Logop (_, `Or, e1, e2) -> let left = aux e1 in Or (left, aux e2) | Logop (_, `And, e1, e2) -> let left = aux e1 in And (left, aux e2) | v -> unexpected ~pos:(value_pos v) () in join (List.map aux l) in let rec print_formula ?(inner=false) f = let rec aux ?(in_and=false) f = let group_if ?(cond=false) f = if cond || OpamFormatConfig.(!r.all_parens) then Group (pos_null, [f]) else f in match f with | Empty -> assert false | Block f -> Group (pos_null, print_formula ~inner:true f) | And (e,f) -> group_if (Logop (pos_null, `And, aux ~in_and:true e, aux ~in_and:true f)) | Or (e,f) -> group_if ~cond:in_and (Logop (pos_null, `Or, aux e, aux f)) | Atom at -> group_if (print (package_atom constraints) at) in let fl = if inner then [f] else split f in List.map (aux ~in_and:false) fl in pp ~name:"pkg-formula" parse_formula print_formula let package_formula kind constraints = list -| package_formula_items kind constraints let env_binding = let parse ~pos:_ = function | Relop (_, `Eq, Ident (_,i), String (_,s)) -> i, Eq, s, None | Env_binding (_, Ident (_,i), op, String (_,s)) -> i, op, s, None | _ -> unexpected () in let print (id, op, str, _) = Env_binding (pos_null, print ident id, op, print string str) in list -| singleton -| pp ~name:"env-binding" parse print (* Only used by the deprecated "os" field *) let os_constraint = let rec parse_osc ~pos:_ l = let rec aux = function | Group (pos,g) -> Block (parse_osc ~pos g) | String (_,os) -> Atom (true, os) | Logop (_,`And,l,r) -> And (aux l, aux r) | Logop (_,`Or,l,r) -> Or (aux l, aux r) | Pfxop (_,`Not,v) -> OpamFormula.neg (fun (b, s) -> (not b, s)) (aux v) | v -> unexpected ~pos:(value_pos v) () in OpamFormula.ors (List.map aux l) in let print_osc f = let rec aux = function | Empty -> assert false | Atom (true , os) -> print string os | Atom (false, os) -> Pfxop (pos_null, `Not, print string os) | Block g -> Group (pos_null, [aux g]) | And(e,f) -> Logop (pos_null, `And, aux e, aux f) | Or(e,f) -> Logop (pos_null, `Or, aux e, aux f) in match f with | Empty -> [] | f -> [aux f] in list -| pp ~name:"os-constraint" parse_osc print_osc end (** Parsers for item lists (standard opam file contents: list of field bindings). *) module I = struct let file = pp ~name:"opam-file" (fun ~pos:_ file -> OpamFilename.of_string file.file_name, file.file_contents) (fun (file_name, file_contents) -> { file_name = OpamFilename.to_string file_name; file_contents }) let map_file pp1 = file -| map_snd pp1 let item = pp ~name:"field-binding" (fun ~pos:_ -> function | Section (pos,sec) -> bad_format ~pos "Unexpected section %s" sec.section_kind | Variable (_,k,v) -> k,v) (fun (k,v) -> Variable (pos_null, k, v)) let items = map_list ~posf:item_pos item let anonymous_section pp1 = pp ~name:pp1.ppname (fun ~pos -> function | [None, contents] -> pp1.parse ~pos contents | [Some _, _] -> bad_format ~pos "Unexpected section title" | [] -> bad_format ~pos "Missing section" | _::_::_ -> bad_format ~pos "Duplicate section") (fun l -> [None, pp1.print l]) let section kind = pp ~name:"file-section" (fun ~pos:_ -> function | Section (_, ({section_kind; _} as s)) when section_kind = kind -> s.section_name, s.section_items | Section (pos,sec) -> bad_format ~pos "Unexpected section %s" sec.section_kind | Variable (pos,k,_) -> bad_format ~pos "Unexpected field %s" k) (fun (section_name, section_items) -> Section (pos_null, { section_kind=kind; section_name; section_items })) type ('a, 'value) fields_def = (string * ('a, 'value) field_parser) list let fields ?name ~empty ?(sections=[]) ?(mandatory_fields=[]) ppas = let parse ~pos items = (* For consistency, always read fields in ppa order, ignoring file order. Some parsers may depend on it. *) let module SEM = OpamStd.Map.Make(struct type t = string * string option let compare = compare let to_string (s,o) = s ^ OpamStd.Option.to_string ((^) "^") o let to_json (s,o) = `O (("kind", `String s) :: match o with None -> [] | Some s -> ["name", `String s]) end) in let errs, section_map, field_map = List.fold_left (fun (errs, section_map, field_map) -> function | Section (pos, {section_kind=k; section_name=n; section_items=v}) -> if List.mem_assoc k sections then try errs, SEM.safe_add (k,n) (pos,v) section_map, field_map with Failure _ -> (k,(Some pos,"Duplicate section "^k)) :: errs, section_map, field_map else (k,(Some pos,"Invalid section "^k)) :: errs, section_map, field_map | Variable (pos, k, v) -> if List.mem_assoc k ppas then try errs, section_map, OpamStd.String.Map.safe_add k (pos,v) field_map with Failure _ -> (k,(Some pos,"Duplicate field "^k)) :: errs, section_map, field_map else (k,(Some pos,"Invalid field "^k))::errs, section_map, field_map) ([], SEM.empty, OpamStd.String.Map.empty) items in let errs, r = List.fold_left (fun (errs,acc) (field,ppa) -> try let pos, v = OpamStd.String.Map.find field field_map in try errs, parse ppa ~pos (acc, Some v) with | Bad_format (pos, msg) -> (field, (pos, msg)) :: errs, acc with Not_found -> (if List.mem field mandatory_fields then (field, (Some pos, "Missing field "^field)) :: errs else errs), acc) (errs, empty) ppas in let errs, r = List.fold_left (fun (errs,acc) (section_kind, ppa) -> let secs = SEM.fold (fun (kind, name) (_, items) acc -> if kind = section_kind then (name, items) :: acc else acc) section_map [] |> List.rev in if secs = [] then errs, acc else try errs, parse ppa ~pos (acc, Some secs) with | Bad_format (pos, msg) -> (section_kind,(pos, msg)) :: errs, acc) (errs, r) sections in r, errs in let print (acc, _) = OpamStd.List.filter_map (fun (field,ppa) -> match snd (ppa.print acc) with | None | Some (List (_,[]) | Group (_,[])) -> None | Some value -> Some (Variable (pos_null, field, value))) ppas @ (List.flatten @@ List.map (fun (section_kind, ppa) -> OpamStd.Option.default [] (snd (ppa.print acc)) |> List.map (fun (section_name, section_items) -> Section (pos_null, { section_kind; section_name; section_items }))) sections) in pp ?name parse print let show_errors ?name ?(strict=OpamFormatConfig.(!r.strict)) ?(condition=fun _ -> true) () = let parse ~pos:(file,_,_) (t, errs) = if errs = [] then t else if strict then raise (Bad_format_list (List.rev_map snd errs)) else (if condition t then OpamConsole.warning "Errors in %s, some fields have been ignored:\n%s" file (OpamStd.Format.itemize (fun e -> OpamPp.string_of_bad_format (Bad_format e)) (List.rev_map snd errs)) else OpamConsole.log "FORMAT" "File errors in %s, ignored fields: %s" file (OpamStd.List.concat_map "; " (fun e -> OpamPp.string_of_bad_format (Bad_format e)) (List.rev_map snd errs)); t) in let print t = t, [] in pp ?name parse print let on_errors ?name f = let parse ~pos:_ (t, errs) = List.fold_left f t errs in let print t = (t, []) in pp ?name parse print let partition filter = pp (fun ~pos:_ -> List.partition filter) (fun (a,b) -> a @ b) let partition_fields filter = partition @@ function | Variable (_,k,_) -> filter k | _ -> false let field name parse = pp (fun ~pos items -> match OpamStd.List.filter_map (function | Variable (_,k,v) when k = name -> Some v | _ -> None) items with | [] -> None, items | _::_::_ -> bad_format ~pos "Duplicate '%s:' field" name | [v] -> Some (parse ~pos v), items) (fun (_,x) -> x) let extract_field name = partition_fields ((=) name) -| (map_fst @@ opt @@ singleton -| item -| pp ~name:(Printf.sprintf "'%s:' field" name) (fun ~pos:_ (_,v) -> v) (fun v -> name,v)) let check_opam_version ?(optional=false) ?(f=fun v -> OpamVersion.(compare current_nopatch (nopatch v) >= 0)) () = let name = "opam-version" in let opam_v = V.string -| of_module "opam-version" (module OpamVersion) in let f v = OpamFormatConfig.(!r.skip_version_checks) || match v with | Some v -> f v | None -> optional in field name (parse opam_v) -| map_fst (check ~name ~errmsg:"unsupported or missing file format version" f) -| pp (fun ~pos:_ (_,x) -> x) (fun x -> (* re-extract the field using parse when printing, to check *) parse ~pos:pos_null (field name (parse opam_v)) x) type signature = string * string * string let signature = V.list -| (V.string ^+ V.string ^+ last -| V.string) -| pp (fun ~pos:_ (a,(b,c)) -> a,b,c) (fun (a,b,c) -> a,(b,c)) exception Invalid_signature of pos * (string*string*string) list option let signed ~check = let pp_sig = V.map_list ~depth:2 signature in extract_field "signature" -| pp ~name:"signed-file" (fun ~pos -> function | Some sgs, items -> let sgs = parse ~pos pp_sig sgs in let str = OpamPrinter.Normalise.items items in if not (check sgs str) then raise (Invalid_signature (pos, Some sgs)) else (sgs, items) | None, _ -> raise (Invalid_signature (pos, None))) (fun (sgs, items) -> assert (check sgs (OpamPrinter.Normalise.items items)); Some (print pp_sig sgs), items) end opam-2.0.5/src/format/opamLineLexer.mli0000644000175000017500000000156113511367404017007 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** A simple lexer to list of lines, which are lists of words *) val main: Lexing.lexbuf -> string list list opam-2.0.5/src/format/opamFilter.mli0000644000175000017500000002035413511367404016346 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Formulas on variables, as used in opam files build scripts Filters are a small language of formulas over strings and booleans used for conditions and text replacements. It has relational operators over strings (using version-number comparison), And, Or and Not boolean operations, dynamic casting (using strings "true" and "false"), and string interpolation. Variables are resolved using a user function returning an option, undefined values are propagated. String interpolation uses the syntax [%{identifier}%] Identifiers have the form {v [package:]var[?str_if_true:str_if_false_or_undef] v} The last optional part specifies a conversion from boolean to static strings. The syntax [pkg1+pkg2+pkgn:var] is allowed as a shortcut to [pkg1:var & pkg2:var & pkgn:var]. The special variable [pkg:enable] is allowed as a shortcut for [pkg:installed?enable:disable] *) open OpamTypes (** Pretty-print *) val to_string: filter -> string (** Folds on the tree of a filter *) val fold_down_left: ('a -> filter -> 'a) -> 'a -> filter -> 'a (** Maps on all nodes of a filter, bottom-up *) val map_up: (filter -> filter) -> filter -> filter (** Returns all the variables appearing in a filter (including the ones within string interpolations *) val variables: filter -> full_variable list (** Type of filter environment. *) type env = full_variable -> variable_contents option (** The type of filter idents with (optionally multiple) qualifying package names and optional string converter. Package name [None] encodes the self-reference [_] *) type fident = name option list * variable * (string * string) option (** Maps on all variables appearing in a filter. The case where package variables are renamed differently and appear in a filter ident of the form [%{pkg1+pkg2:var}%] is not supported and raises [Invalid_argument]. *) val map_variables: (full_variable -> full_variable) -> filter -> filter (** Same limitation as [map_variables] *) val map_variables_in_string: (full_variable -> full_variable) -> string -> string (** Does not handle rewriting the variables to different names (which can't be expressed with a [fident] anymore), and raises [Invalid_argument] *) val map_variables_in_fident: (full_variable -> full_variable) -> fident -> fident (** Distributes the negations to apply only to atoms *) val distribute_negations: ?neg:bool -> filter -> filter (** Rewrites string interpolations within a string. [default] is applied to the fident string (e.g. what's between [%{] and [}%]) when the expansion is undefined. If unspecified, this raises [Failure]. With [partial], [default] defaults to the identity, and is otherwise expected to return a fident. In this case, the returned string is supposed to be expanded again (expansion results are escaped, escapes are otherwise kept). This makes the function idempotent *) val expand_string: ?partial:bool -> ?default:(string -> string) -> env -> string -> string (** Returns the (beginning, end) offsets and substrings of any unclosed [%{] expansions *) val unclosed_expansions: string -> ((int * int) * string) list (** Computes the value of a filter. May raise [Failure] if [default] isn't provided *) val eval: ?default:variable_contents -> env -> filter -> variable_contents (** Like [eval] but casts the result to a bool. Raises [Invalid_argument] if not a valid bool and no default supplied. *) val eval_to_bool: ?default:bool -> env -> filter -> bool (** Same as [eval_to_bool], but takes an option as filter and returns always [true] on [None], [false] when the filter is [Undefined]. This is the most common behaviour for using "filters" for filtering *) val opt_eval_to_bool: env -> filter option -> bool (** Like [eval] but casts the result to a string *) val eval_to_string: ?default:string -> env -> filter -> string (** Reduces what can be, keeps the rest unchanged *) val partial_eval: env -> filter -> filter (** Wraps a full_variable into a fident accessor *) val ident_of_var: full_variable -> fident (** A fident accessor directly referring a variable with the given name *) val ident_of_string: string -> fident (** Resolves a filter ident. Like [eval], may raise Failure if no default is provided *) val ident_value: ?default:variable_contents -> env -> fident -> variable_contents (** Like [ident_value], but casts the result to a string *) val ident_string: ?default:string -> env -> fident -> string (** Like [ident_value], but casts the result to a bool *) val ident_bool: ?default:bool -> env -> fident -> bool (** Rewrites [basename].in to [basename], expanding interpolations *) val expand_interpolations_in_file: env -> basename -> unit (** Processes filters evaluation in a command list: parameter expansion and conditional filtering *) val commands: env -> command list -> string list list (** Process a simpler command, without filters *) val single_command: env -> arg list -> string list (** Extracts variables appearing in a list of commands *) val commands_variables: command list -> full_variable list (** Converts a generic formula to a filter, given a converter for atoms *) val of_formula: ('a -> filter) -> 'a generic_formula -> filter (** Resolves the filter in a filtered formula, reducing to a pure formula. [default] is the assumed result for undefined filters. If a version filter doesn't resolve to a valid version, the constraint is dropped unless [default_version] is specified. May raise, as other filter functions, if [default] is not provided and filters don't resolve. *) val filter_formula: ?default_version:version -> ?default:bool -> env -> filtered_formula -> formula (** Reduces according to what is defined in [env], and returns the simplified formula *) val partial_filter_formula: env -> filtered_formula -> filtered_formula (** A more generic formula reduction function, that takes a "partial resolver" as argument *) val gen_filter_formula: ('a -> [< `True | `False | `Formula of 'b OpamTypes.generic_formula ]) -> ('c * 'a) OpamFormula.formula -> ('c * 'b OpamTypes.generic_formula) OpamFormula.formula val string_of_filtered_formula: filtered_formula -> string val variables_of_filtered_formula: filtered_formula -> full_variable list (** Resolves the build, post, test, doc, dev flags in a filtered formula (which is supposed to have been pre-processed to remove switch and global variables). [default] determines the behaviour on undefined filters, and the function may raise if it is undefined. If a constraint resolves to an invalid version, it is dropped, or replaced with [default_version] if specified. If test, doc or dev are unspecified, they are assumed to be filtered out already and encountering them will raise an assert. *) val filter_deps: build:bool -> post:bool -> ?test:bool -> ?doc:bool -> ?dev:bool -> ?default_version:version -> ?default:bool -> filtered_formula -> formula (** The environment used in resolving the dependency filters, as per [filter_deps]. *) val deps_var_env: build:bool -> post:bool -> ?test:bool -> ?doc:bool -> ?dev:bool -> env (** Like [OpamFormula.simplify_version_formula], but on filtered formulas (filters are kept unchanged, but put in front) *) val simplify_extended_version_formula: filter filter_or_constraint OpamFormula.formula -> filter filter_or_constraint OpamFormula.formula option val atomise_extended: filtered_formula -> (OpamPackage.Name.t * (filter * (relop * filter) option)) OpamFormula.formula opam-2.0.5/src/format/opamPackage.ml0000644000175000017500000001745013511367404016306 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamCompat open OpamStd.Op let log fmt = OpamConsole.log "PACKAGE" fmt let slog = OpamConsole.slog module Version = struct type version = string type t = version let to_string x = x let of_string x = if String.length x = 0 then failwith "Package version can't be empty"; String.iter (function | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' | '+' | '.' | '~' -> () | c -> failwith (Printf.sprintf "Invalid character '%c' in package version %S" c x)) x; x let compare = OpamVersionCompare.compare let to_json x = `String (to_string x) module O = struct type t = version let to_string = to_string let compare = compare let to_json = to_json end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) end module Name = struct type t = string let to_string x = x let of_string x = match OpamStd.String.fold_left (fun acc c -> if acc = Some false then acc else match c with | 'a'..'z' | 'A'..'Z' -> Some true | '0'..'9' | '-' | '_' | '+' -> acc | _ -> Some false) None x with | Some false -> failwith (Printf.sprintf "Invalid character in package name %S" x) | None -> failwith (Printf.sprintf "Package name %S should contain at least one letter" x) | Some true -> x let compare n1 n2 = match compare (String.lowercase_ascii n1) (String.lowercase_ascii n2) with | 0 -> compare n1 n2 | i -> i let to_json x = `String x module O = struct type t = string let to_string = to_string let compare = compare let to_json = to_json end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) end type t = { name : Name.t; version: Version.t; } let create name version = { name; version } let name_to_string t = Name.to_string t.name let version_to_string t = Version.to_string t.version let name t = t.name let version t = t.version let sep = '.' let of_string_opt s = if OpamStd.String.contains_char s ' ' || OpamStd.String.contains_char s '\n' then None else match OpamStd.String.cut_at s sep with | None -> None | Some (n, v) -> try Some { name = Name.of_string n; version = Version.of_string v } with Failure _ -> None let of_string s = match of_string_opt s with | Some x -> x | None -> failwith "OpamPackage.of_string" let to_string t = match Version.to_string t.version with | "" -> Name.to_string t.name | _ -> Printf.sprintf "%s%c%s" (Name.to_string t.name) sep (Version.to_string t.version) let compare nv1 nv2 = match Name.compare nv1.name nv2.name with | 0 -> Version.compare nv1.version nv2.version | i -> i let hash nv = Hashtbl.hash nv let equal nv1 nv2 = compare nv1 nv2 = 0 let to_json nv = `O [ ("name", Name.to_json (name nv)); ("version", Version.to_json (version nv)); ] module O = struct type tmp = t type t = tmp let compare p1 p2 = let r = Name.compare p1.name p2.name in if r = 0 then Version.compare p1.version p2.version else r let hash = hash let equal = equal let to_string = to_string let to_json = to_json end module Set = OpamStd.Set.Make (O) module Map = OpamStd.Map.Make (O) let to_map nv = Set.fold (fun nv map -> let name = name nv in let version = version nv in try Name.Map.add name (Version.Set.add version (Name.Map.find name map)) map with Not_found -> Name.Map.add name (Version.Set.singleton version) map ) nv Name.Map.empty let of_map nvm = Name.Map.fold (fun n -> Version.Set.fold (fun v -> Set.add (create n v))) nvm Set.empty let keys map = Map.fold (fun nv _ set -> Set.add nv set) map Set.empty (* $DIR/$NAME.$VERSION/ *) let of_dirname f = f |> OpamFilename.basename_dir |> OpamFilename.Base.to_string |> of_string_opt (* $DIR/$NAME.$VERSION/opam *) let of_filename f = if OpamFilename.basename f = OpamFilename.Base.of_string "opam" then of_dirname (OpamFilename.dirname f) else if OpamFilename.check_suffix f ".opam" then of_string_opt OpamFilename.(Base.to_string (basename (chop_extension f))) else None (* $NAME.$VERSION+opam.tar.gz *) let of_archive f = let base = OpamFilename.basename f in match OpamStd.String.cut_at (OpamFilename.Base.to_string base) '+' with | None -> None | Some (s,_) -> of_string_opt s let list dir = log "list %a" (slog OpamFilename.Dir.to_string) dir; if OpamFilename.exists_dir dir then ( let files = OpamFilename.rec_files dir in List.fold_left (fun set f -> match of_filename f with | None -> set | Some p -> if not (Set.mem p set) then Set.add p set else let suffix = Filename.concat (to_string p) "opam" in let files = List.filter (OpamFilename.ends_with suffix) files in OpamConsole.error_and_exit `File_error "Multiple definition of package %s in %s:\n%s" (to_string p) (OpamFilename.Dir.to_string dir) (OpamStd.Format.itemize ~bullet:"" OpamFilename.to_string files); ) Set.empty files ) else Set.empty let prefixes repodir = log "prefixes %a" (slog OpamFilename.Dir.to_string) repodir; if OpamFilename.exists_dir repodir then ( let files = OpamFilename.rec_files repodir in List.fold_left (fun map f -> match of_filename f with | None -> map | Some p -> let pkgdir = OpamFilename.dirname_dir (OpamFilename.dirname f) in let prefix = match OpamFilename.remove_prefix_dir repodir pkgdir with | "" -> None | p -> Some p in Map.add p prefix map ) Map.empty files ) else Map.empty let versions_of_packages nvset = Set.fold (fun nv vset -> Version.Set.add (version nv) vset) nvset Version.Set.empty let has_name nvset n = Set.exists (fun nv -> name nv = n) nvset let names_of_packages nvset = Set.fold (fun nv vset -> Name.Set.add (name nv) vset) nvset Name.Set.empty let packages_of_name nvset n = if n = "" then Set.empty else let inf = {name = String.sub n 0 (String.length n - 1); version= ""} in let sup = {name = n^"\000"; version = ""} in let _, _, nvset = Set.split inf nvset in let nvset, _, _ = Set.split sup nvset in Set.filter (fun nv -> nv.name = n) nvset let package_of_name nvset n = Set.choose (packages_of_name nvset n) let package_of_name_opt nvset n = try Some (package_of_name nvset n) with Not_found -> None let packages_of_names nvset nameset = Name.Set.fold (fun name acc -> Set.union acc (packages_of_name nvset name)) nameset Set.empty let versions_of_name packages n = versions_of_packages (packages_of_name packages n) let filter_name_out packages name = Set.diff packages (packages_of_name packages name) let max_version set name = let versions = versions_of_name set name in let version = Version.Set.max_elt versions in create name version module Graph = (OpamParallel.MakeGraph (O) : OpamParallel.GRAPH with type V.t = t) opam-2.0.5/src/format/opamVariable.ml0000644000175000017500000000616413511367404016500 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include OpamStd.AbstractString type variable = t type variable_contents = | B of bool | S of string | L of string list let string_of_variable_contents = function | B b -> string_of_bool b | S s -> s | L l -> String.concat " " l let string str = S str let bool b = B b let int i = string (string_of_int i) let dirname dir = string (OpamFilename.Dir.to_string dir) module Full = struct type scope = | Global | Self | Package of OpamPackage.Name.t type t = { scope: scope; variable: variable; } let variable t = t.variable let scope t = t.scope let package ?self t = match t.scope with | Package p -> Some p | Self -> self | Global -> None let create package variable = let scope = if OpamPackage.Name.to_string package = "_" then Self else Package package in { scope; variable } (* Read the variables overridden through the environment *) let read_from_env v = let var_str = to_string (variable v) in let undash = OpamStd.String.map (function '-' -> '_' | c -> c) in let var_hook = match package v with | Some n -> Printf.sprintf "%s_%s" (undash (OpamPackage.Name.to_string n)) (undash var_str) | None -> undash var_str in try match OpamStd.Env.get ("OPAMVAR_" ^ var_hook) with | "true" | "1" -> Some (bool true) | "false" | "0" -> Some (bool false) | s -> Some (string s) with Not_found -> None let global variable = { scope = Global; variable } let self variable = { scope = Self; variable } let is_global variable = match variable.scope with | Global -> true | Self | Package _ -> false let of_string s = match OpamStd.String.rcut_at s ':' with | None -> global (of_string s) | Some ("_",v) -> { scope = Self; variable = of_string v } | Some (p,v) -> create (OpamPackage.Name.of_string p) (of_string v) let to_string t = let prefix = match t.scope with | Global -> "" | Self -> "_:" | Package p -> OpamPackage.Name.to_string p ^ ":" in prefix ^ to_string t.variable let to_json x = `String (to_string x) module O = struct type tmp = t type t = tmp let compare = compare let to_string = to_string let to_json = to_json end module Set = OpamStd.Set.Make(O) module Map = OpamStd.Map.Make(O) end opam-2.0.5/src/format/dune0000644000175000017500000000063313511367404014415 0ustar nicoonicoo(library (name opam_format) (public_name opam-format) (synopsis "OCaml Package Manager file format handling library") (libraries opam-core opam-file-format re) (modules_without_implementation OpamTypes) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-context-flags.sexp))) (wrapped false)) (ocamllex opamLineLexer) opam-2.0.5/src/format/opamSwitch.ml0000644000175000017500000000311413511367404016204 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include OpamStd.AbstractString let unset = of_string "#unset#" let is_external s = OpamStd.String.starts_with ~prefix:"." s || OpamStd.String.contains ~sub:Filename.dir_sep s let external_dirname = "_opam" let of_string s = if is_external s then OpamFilename.Dir.(to_string (of_string s)) else s let of_dirname d = let s = OpamFilename.Dir.to_string d in try let swdir = Unix.readlink (Filename.concat s external_dirname) in let swdir = if Filename.is_relative swdir then Filename.concat s swdir else swdir in let r = OpamSystem.real_path swdir in if Filename.basename r = external_dirname then Filename.dirname r else s with Unix.Unix_error _ -> s let get_root root s = if is_external s then OpamFilename.Dir.of_string (Filename.concat s external_dirname) else OpamFilename.Op.(root / s) opam-2.0.5/src/format/opamFile.ml0000644000175000017500000033027213511367404015632 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** This module contains the handlers for reading and writing all of OPAM files, and defines their internal types (records for most of them). We handle three types of files: - raw text files, without lexing - "table" files, i.e. lexing is just cutting into lines and words, returning a string list list. These are mostly used internally - files using the "opam syntax" and lexer, parsed using OpamFormat.Pp.V *) open OpamTypes open OpamTypesBase open OpamStd.Op module Pp = struct include OpamPp module V = OpamFormat.V module I = OpamFormat.I let warn ?pos ?(strict=OpamFormatConfig.(!r.strict)) ?exn fmt = if strict then match exn with | Some e -> raise e | None -> bad_format ?pos fmt else Printf.ksprintf (fun s -> if OpamConsole.verbose () then match exn with | None -> OpamConsole.warning "%s" (OpamPp.string_of_bad_format (Bad_format (pos, s))) | Some e -> OpamConsole.warning "%s" (OpamPp.string_of_bad_format e)) fmt end open Pp.Op type 'a t = filename type 'a typed_file = 'a t let make f = (f: 'a t) let filename f = (f: 'a t :> filename) let to_string f = OpamFilename.to_string (filename f) let exists f = OpamFilename.exists (filename f) module type IO_FILE = sig type t val empty: t val write: 'a typed_file -> t -> unit val read : 'a typed_file -> t val read_opt: 'a typed_file -> t option val safe_read: 'a typed_file -> t val read_from_channel: ?filename:'a typed_file -> in_channel -> t val read_from_string: ?filename:'a typed_file -> string -> t val write_to_channel: ?filename:'a typed_file -> out_channel -> t -> unit val write_to_string: ?filename:'a typed_file -> t -> string end module type IO_Arg = sig val internal : string type t val empty : t val of_channel : 'a typed_file -> in_channel -> t val to_channel : 'a typed_file -> out_channel -> t -> unit val of_string : 'a typed_file -> string -> t val to_string : 'a typed_file -> t -> string end module Stats = struct let read_files = ref [] let write_files = ref [] let print () = let aux kind = function | [] -> () | l -> OpamConsole.msg "%d files %s:\n %s\n" (List.length !read_files) kind (String.concat "\n " l) in aux "read" !read_files; aux "write" !write_files end let dummy_file = OpamFilename.raw "" module MakeIO (F : IO_Arg) = struct let log ?level fmt = OpamConsole.log (Printf.sprintf "FILE(%s)" F.internal) ?level fmt let slog = OpamConsole.slog let write f v = let filename = OpamFilename.to_string f in let chrono = OpamConsole.timer () in let oc = OpamFilename.(mkdir (dirname f)); try open_out_bin filename with Sys_error _ -> raise (OpamSystem.File_not_found filename) in try Unix.lockf (Unix.descr_of_out_channel oc) Unix.F_LOCK 0; F.to_channel f oc v; close_out oc; Stats.write_files := filename :: !Stats.write_files; log "Wrote %s in %.3fs" filename (chrono ()) with e -> OpamStd.Exn.finalise e @@ fun () -> close_out oc; OpamFilename.remove f let read_opt f = let filename = OpamFilename.prettify f in let chrono = OpamConsole.timer () in try let ic = OpamFilename.open_in f in try Unix.lockf (Unix.descr_of_in_channel ic) Unix.F_RLOCK 0; Stats.read_files := filename :: !Stats.read_files; let r = F.of_channel f ic in close_in ic; log ~level:3 "Read %s in %.3fs" filename (chrono ()); Some r with e -> OpamStd.Exn.finalise e (fun () -> close_in ic) with | OpamSystem.File_not_found _ -> None | e -> OpamStd.Exn.fatal e; if OpamFormatConfig.(!r.strict) then (OpamConsole.error "%s" (Pp.string_of_bad_format ~file:(OpamFilename.to_string f) e); OpamConsole.error_and_exit `File_error "Strict mode: aborting") else raise e let read f = match read_opt f with | Some f -> f | None -> OpamSystem.internal_error "File %s does not exist or can't be read" (OpamFilename.to_string f) let safe_read f = try match read_opt f with | Some f -> f | None -> log ~level:2 "Cannot find %a" (slog OpamFilename.to_string) f; F.empty with | Pp.Bad_format _ as e-> OpamConsole.error "%s [skipped]\n" (Pp.string_of_bad_format ~file:(OpamFilename.to_string f) e); F.empty let read_from_f f input = try f input with | Pp.Bad_format _ as e -> if OpamFormatConfig.(!r.strict) then (OpamConsole.error "%s" (Pp.string_of_bad_format e); OpamConsole.error_and_exit `File_error "Strict mode: aborting") else raise e let read_from_channel ?(filename=dummy_file) ic = read_from_f (F.of_channel filename) ic let read_from_string ?(filename=dummy_file) str = read_from_f (F.of_string filename) str let write_to_channel ?(filename=dummy_file) oc t = F.to_channel filename oc t let write_to_string ?(filename=dummy_file) t = F.to_string filename t end (** I - Raw text files (no parsing) *) (** Compiler and package description files (/packages/.../descr, /compilers/.../.descr): one-line title and content *) module DescrIO = struct let internal = "descr" type t = string * string let empty = "", "" let synopsis = fst let body = snd let full (x,y) = match y with | "" -> x ^ "\n" | y -> String.concat "" [x; "\n\n"; y; "\n"] let of_channel _ ic = let x = try OpamStd.String.strip (input_line ic) with End_of_file | Sys_error _ -> "" in let y = try OpamStd.String.strip (OpamSystem.string_of_channel ic) with End_of_file | Sys_error _ -> "" in x, y let to_channel _ oc (x,y) = output_string oc x; output_char oc '\n'; if y <> "" then (output_char oc '\n'; output_string oc y; output_char oc '\n') let create str = let head, tail = match OpamStd.String.cut_at str '\n' with | None -> str, "" | Some (h,t) -> h, t in OpamStd.String.strip head, OpamStd.String.strip tail let of_string _ = create let to_string _ = full end module Descr = struct include DescrIO include MakeIO(DescrIO) end (* module Comp_descr = Descr *) (** Raw file interface used for variable expansions ( *.in ) *) (* module SubstIO = struct let internal = "subst" type t = string let empty = "" let of_channel _ ic = OpamSystem.string_of_channel ic let to_channel _ oc t = output_string oc t let of_string _ str = str let to_string _ t = t end module Subst = struct include SubstIO include MakeIO(SubstIO) end *) (** II - Base word list list parser and associated file types *) module LinesBase = struct (* Lines of space separated words *) type t = string list list let empty = [] let internal = "lines" let find_escapes s len = let rec aux acc i = if i < 0 then acc else let acc = match s.[i] with | '\\' | ' ' | '\t' | '\n' -> let esc,count = acc in i::esc, count + 1 | _ -> acc in aux acc (i-1) in aux ([],0) (len - 1) let escape_spaces str = let len = String.length str in match find_escapes str len with | [], _ -> str | escapes, n -> let buf = Bytes.create (len + n) in let rec aux i = function | ofs1::(ofs2::_ as r) -> Bytes.blit_string str ofs1 buf (ofs1+i) (ofs2-ofs1); Bytes.set buf (ofs2+i) '\\'; aux (i+1) r | [ofs] -> Bytes.blit_string str ofs buf (ofs+i) (len-ofs); buf | [] -> assert false in Bytes.to_string (aux 0 (0::escapes)) let of_channel (_:filename) ic = OpamLineLexer.main (Lexing.from_channel ic) let to_channel (_:filename) oc t = List.iter (function | [] -> () | w::r -> output_string oc (escape_spaces w); List.iter (fun w -> output_char oc '\t'; output_string oc (escape_spaces w)) r; output_char oc '\n') t let of_string (_:filename) str = OpamLineLexer.main (Lexing.from_string str) let to_string (_:filename) (lines: t) = let buf = Buffer.create 1024 in List.iter (fun l -> (match l with | [] -> () | w::r -> Buffer.add_string buf (escape_spaces w); List.iter (fun w -> Buffer.add_char buf '\t'; Buffer.add_string buf (escape_spaces w)) r); Buffer.add_string buf "\n" ) lines; Buffer.contents buf let file_none = OpamFilename.of_string "" let pp_string = Pp.pp (fun ~pos:_ s -> OpamLineLexer.main (Lexing.from_string s)) (fun lines -> to_string file_none lines) let pp_channel ic oc = Pp.pp (fun ~pos:_ () -> of_channel file_none ic) (to_channel file_none oc) end module Lines = struct include LinesBase include MakeIO(LinesBase) end module type LineFileArg = sig val internal: string type t val empty: t val pp: (string list list, t) Pp.t end module LineFile (X: LineFileArg) = struct module IO = struct include X let to_channel _ oc t = Pp.print (Lines.pp_channel stdin oc -| pp) t let to_string _ t = Pp.print (Lines.pp_string -| pp) t let of_channel filename ic = Pp.parse (Lines.pp_channel ic stdout -| pp) ~pos:(pos_file filename) () let of_string filename str = Pp.parse (Lines.pp_string -| pp) ~pos:(OpamFilename.to_string filename,0,0) str end include IO include MakeIO(IO) end (** (1) Internal usage only *) (** Compiler aliases definitions (aliases): table *) module Aliases = LineFile(struct let internal = "aliases" type t = string switch_map let empty = OpamSwitch.Map.empty let pp = OpamSwitch.Map.(OpamFormat.lines_map ~empty ~add ~fold) @@ Pp.of_module "switch-name" (module OpamSwitch) ^+ Pp.last end) (** Indices of items and their associated source repository: table *) module Repo_index (A : OpamStd.ABSTRACT) = LineFile(struct let internal = "repo-index" type t = (repository_name * string option) A.Map.t let empty = A.Map.empty let pp = OpamFormat.lines_map ~empty ~add:A.Map.safe_add ~fold:A.Map.fold @@ Pp.of_module "name" (module A) ^+ Pp.of_module "repository" (module OpamRepositoryName) ^+ Pp.opt Pp.last end) module Package_index = Repo_index(OpamPackage) (** List of packages (/installed, /installed-roots, /reinstall): table *) module PkgList = LineFile (struct let internal = "package-version-list" type t = package_set let empty = OpamPackage.Set.empty let pp = OpamPackage.Set.(OpamFormat.lines_set ~empty ~add ~fold) @@ (Pp.of_module "pkg-name" (module OpamPackage.Name) ^+ Pp.last -| Pp.of_module "pkg-version" (module OpamPackage.Version)) -| Pp.pp (fun ~pos:_ (n,v) -> OpamPackage.create n v) (fun nv -> nv.name, nv.version) end) (** Lists of pinned packages (/pinned): table Backwards-compatibility code, do not use *) module Pinned_legacy = struct type pin_option = | Version of version | Source of url let pp_pin = let looks_like_version_re = Re.(compile @@ seq [bos; digit; rep @@ diff any (set "/\\"); eos]) in let pin_option_of_string ?kind s = match kind with | Some `version -> Version (OpamPackage.Version.of_string s) | None when Re.execp looks_like_version_re s -> Version (OpamPackage.Version.of_string s) | Some (#OpamUrl.backend as backend) -> Source (OpamUrl.parse ~backend s) | None -> Source (OpamUrl.parse ~handle_suffix:false s) in let string_of_pin_kind = function | `version -> "version" | `rsync -> "path" | #OpamUrl.backend as ub -> OpamUrl.string_of_backend ub in let pin_kind_of_string = function | "version" -> `version | "path" -> `rsync | s -> OpamUrl.backend_of_string s in let string_of_pin_option = function | Version v -> OpamPackage.Version.to_string v | Source url -> OpamUrl.to_string url in let kind_of_pin_option = function | Version _ -> `version | Source url -> (url.OpamUrl.backend :> pin_kind) in Pp.pp ~name:"?pin-kind pin-target" (fun ~pos -> function | [x] -> pin_option_of_string x | [k;x] -> pin_option_of_string ~kind:(pin_kind_of_string k) x | _ -> Pp.bad_format ~pos "Invalid number of fields") (fun x -> [string_of_pin_kind (kind_of_pin_option x); string_of_pin_option x]) include LineFile(struct let internal = "pinned" type t = pin_option OpamPackage.Name.Map.t let empty = OpamPackage.Name.Map.empty let pp = OpamPackage.Name.Map.(OpamFormat.lines_map ~empty ~add:safe_add ~fold) @@ Pp.of_module "pkg-name" (module OpamPackage.Name) ^+ pp_pin end) end (** Cached environment updates (/.opam-switch/environment) *) module Environment = LineFile(struct let internal = "environment" type t = env_update list let empty = [] let pp = (OpamFormat.lines_set ~empty:[] ~add:OpamStd.List.cons ~fold:List.fold_right @@ Pp.identity ^+ Pp.of_pair "env_update_op" (OpamLexer.env_update_op, OpamPrinter.env_update_op) ^+ Pp.identity ^+ Pp.opt Pp.singleton) -| Pp.pp (fun ~pos:_ -> List.rev) List.rev let pp = pp -| Pp.map_list (Pp.pp (fun ~pos:_ (a, (b, (c, d))) -> (a, b, c, d)) (fun (a, b, c, d) -> (a, (b, (c, d))))) end) (** (2) Part of the public repository format *) (** repository index files ("urls.txt"): table *) module File_attributes = LineFile(struct let internal = "file_attributes" type t = file_attribute_set let empty = OpamFilename.Attribute.Set.empty let pp = OpamFilename.Attribute.Set.(OpamFormat.lines_set ~empty ~add ~fold) @@ (Pp.of_module "file" (module OpamFilename.Base) ^+ Pp.of_pair "checksum" OpamHash.(of_string, contents) ^+ Pp.opt (Pp.last -| Pp.of_pair "perm" (int_of_string, string_of_int)) ) -| Pp.pp (fun ~pos:_ (base,(hash,perm)) -> OpamFilename.Attribute.create base hash perm) (fun att -> OpamFilename.Attribute.(base att, (md5 att, perm att))) end) (** (3) Available in interface *) (** Old Switch export/import format: table [pinning-kind] [pinning-url] *) module StateTable = struct let internal = "export" module M = OpamPackage.Name.Map type t = switch_selections let empty = { sel_installed = OpamPackage.Set.empty; sel_roots = OpamPackage.Set.empty; sel_compiler = OpamPackage.Set.empty; sel_pinned = OpamPackage.Set.empty; } let pp_state = Pp.pp ~name:"pkg-state" (fun ~pos:_ -> function | "compiler" -> `Compiler | "root" -> `Root | "noroot" | "installed" -> `Installed | "uninstalled" -> `Uninstalled | "uninstalled-compiler" -> `Uninstalled_compiler | _ -> Pp.unexpected ()) (function | `Compiler -> "compiler" | `Root -> "root" | `Installed -> "installed" | `Uninstalled -> "uninstalled" | `Uninstalled_compiler -> "uninstalled-compiler") let pp_lines = M.(OpamFormat.lines_map ~empty ~add:safe_add ~fold) @@ Pp.of_module "pkg-name" (module OpamPackage.Name) ^+ Pp.of_module "pkg-version" (module OpamPackage.Version) ^+ (Pp.opt (pp_state ^+ Pp.opt Pinned_legacy.pp_pin) -| Pp.default (`Root, None)) (* Convert from one name-map to type t *) let pp = pp_lines -| Pp.pp (fun ~pos:_ map -> M.fold (fun name (version,(state,pin)) t -> let nv = OpamPackage.create name version in { sel_installed = (match state with | `Installed | `Root | `Compiler -> OpamPackage.Set.add nv t.sel_installed | `Uninstalled | `Uninstalled_compiler -> t.sel_installed); sel_roots = (match state with | `Root | `Compiler -> OpamPackage.Set.add nv t.sel_roots | `Installed | `Uninstalled | `Uninstalled_compiler -> t.sel_roots); sel_compiler = (match state with | `Compiler | `Uninstalled_compiler -> OpamPackage.Set.add nv t.sel_compiler | `Root | `Installed | `Uninstalled -> t.sel_compiler); sel_pinned = (match pin with | Some (Pinned_legacy.Version v) -> OpamPackage.Set.add (OpamPackage.create name v) t.sel_pinned | Some _ -> OpamPackage.Set.add (OpamPackage.create name version) t.sel_pinned | None -> t.sel_pinned); }) map empty) (fun t -> M.empty |> OpamPackage.Set.fold (fun nv -> M.add nv.name (nv.version, (`Installed, None))) t.sel_installed |> OpamPackage.Set.fold (fun nv -> M.add nv.name (nv.version, (`Root, None))) t.sel_roots |> OpamPackage.Set.fold (fun nv acc -> let name = nv.name in try let (v, _) = M.find name acc in M.add name (v, (`Compiler, None)) acc with Not_found -> M.add name (nv.version, (`Uninstalled_compiler, None)) acc) t.sel_compiler |> OpamPackage.Set.fold (fun nv map -> let state = try let _, (state, _) = M.find nv.name map in state with Not_found -> `Uninstalled in (* Incorrect: marks all pins as version. But this is deprecated. *) M.add nv.name (nv.version, (state, Some (Pinned_legacy.Version nv.version))) map) t.sel_pinned) end module LegacyState = struct type t = switch_selections include (LineFile (StateTable) : IO_FILE with type t := t) end (** III - Opam Syntax parser and associated file types *) module Syntax = struct (* Idea: have a [(ic, oc_with_lock * t) pp] that can be used to reading and re-writing files with a guarantee that it hasn't been rewritten in the meantime *) let parser_main lexbuf filename = let error msg = let curr = lexbuf.Lexing.lex_curr_p in let start = lexbuf.Lexing.lex_start_p in let pos = curr.Lexing.pos_fname, start.Lexing.pos_lnum, start.Lexing.pos_cnum - start.Lexing.pos_bol in raise (OpamPp.Bad_format (Some pos, msg)) in let filename = OpamFilename.to_string filename in lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = filename }; try OpamParser.main OpamLexer.token lexbuf filename with | OpamLexer.Error msg -> error msg | Parsing.Parse_error -> error "Parse error" let pp_channel filename ic oc = Pp.pp (fun ~pos:_ () -> let lexbuf = Lexing.from_channel ic in parser_main lexbuf filename) (fun file -> let fmt = Format.formatter_of_out_channel oc in OpamPrinter.format_opamfile fmt file) let of_channel (filename:filename) (ic:in_channel) = Pp.parse ~pos:(pos_file filename) (pp_channel filename ic stdout) () let to_channel filename oc t = Pp.print (pp_channel filename stdin oc) t let of_string (filename:filename) str = let lexbuf = Lexing.from_string str in parser_main lexbuf filename let to_string _file_name t = OpamPrinter.opamfile t let to_string_with_preserved_format filename ?(format_from=filename) ?format_from_string ~empty ?(sections=[]) ~fields pp t = let current_str_opt = match format_from_string with | Some s -> Some s | None -> try Some (OpamFilename.read format_from) with OpamSystem.File_not_found _ -> None in match current_str_opt with | None -> to_string filename (Pp.print pp (filename, t)) | Some str -> let syn_file = of_string filename str in let syn_t = Pp.print pp (filename, t) in let it_ident = function | Variable (_, f, _) -> `Var f | Section (_, {section_kind = k; section_name = n; _}) -> `Sec (k,n) in let it_pos = function | Section (pos,_) | Variable (pos,_,_) -> pos in let lines_index = let rec aux acc s = let until = try Some (String.index_from s (List.hd acc) '\n') with Not_found -> None in match until with | Some until -> aux (until+1 :: acc) s | None -> Array.of_list (List.rev acc) in aux [0] str in let pos_index (_file, li, col) = lines_index.(li - 1) + col in let field_str ident = let rec aux = function | it1 :: r when it_ident it1 = ident -> let start = pos_index (it_pos it1) in let stop = match r with | it2 :: _ -> pos_index (it_pos it2) - 1 | [] -> let len = ref (String.length str) in while str.[!len - 1] = '\n' do decr len done; !len in String.sub str start (stop - start) | _ :: r -> aux r | [] -> raise Not_found in aux syn_file.file_contents in let rem, strs = List.fold_left (fun (rem, strs) item -> List.filter (fun i -> it_ident i <> it_ident item) rem, match item with | Variable (pos, name, v) -> (try let ppa = List.assoc name fields in match snd (Pp.print ppa t) with | None | Some (List (_, [])) | Some (List (_,[List(_,[])])) -> strs | field_syn_t when field_syn_t = snd (Pp.print ppa (Pp.parse ppa ~pos (empty, Some v))) -> (* unchanged *) field_str (`Var name) :: strs | _ -> try let f = List.find (fun i -> it_ident i = `Var name) syn_t.file_contents in OpamPrinter.items [f] :: strs with Not_found -> strs with Not_found | OpamPp.Bad_format _ -> if OpamStd.String.starts_with ~prefix:"x-" name then field_str (`Var name) :: strs else strs) | Section (pos, {section_kind; section_name; section_items}) -> (try let ppa = List.assoc section_kind sections in let print_sec ppa t = match snd (Pp.print ppa t) with | None -> None | Some v -> try Some (List.assoc section_name v) with Not_found -> None in let sec_field_t = print_sec ppa t in if sec_field_t <> None && sec_field_t = print_sec ppa (Pp.parse ppa ~pos (empty, Some [section_name, section_items])) then (* unchanged *) field_str (`Sec (section_kind, section_name)) :: strs else try let f = List.filter (fun i -> it_ident i = `Sec (section_kind, section_name)) syn_t.file_contents in OpamPrinter.items f :: strs with Not_found -> strs with Not_found | OpamPp.Bad_format _ -> strs) ) (syn_t.file_contents, []) syn_file.file_contents in String.concat "\n" (List.rev_append strs (if rem = [] then [""] else [OpamPrinter.items rem;""])) end module type SyntaxFileArg = sig val internal: string type t val empty: t val pp: (opamfile, filename * t) Pp.t end module SyntaxFile(X: SyntaxFileArg) : IO_FILE with type t := X.t = struct module IO = struct let to_opamfile filename t = Pp.print X.pp (filename, t) let of_channel filename (ic:in_channel) = Pp.parse X.pp ~pos:(pos_file filename) (Syntax.of_channel filename ic) |> snd let to_channel filename oc t = Syntax.to_channel filename oc (to_opamfile filename t) let of_string (filename:filename) str = Pp.parse X.pp ~pos:(pos_file filename) (Syntax.of_string filename str) |> snd let to_string filename t = Syntax.to_string filename (to_opamfile filename t) end include IO include X include MakeIO(struct include X include IO end) end (** (1) Internal files *) (** Structure shared by a few file formats *) module Wrappers = struct type t = { pre_build : command list; wrap_build : command list; post_build : command list; pre_install : command list; wrap_install : command list; post_install : command list; pre_remove : command list; wrap_remove : command list; post_remove : command list; pre_session : command list; post_session : command list; } let empty = { pre_build = []; wrap_build = []; post_build = []; pre_install = []; wrap_install = []; post_install = []; pre_remove = []; wrap_remove = []; post_remove = []; pre_session = []; post_session = [] } let pre_build t = t.pre_build let wrap_build t = t.wrap_build let post_build t = t.post_build let pre_install t = t.pre_install let wrap_install t = t.wrap_install let post_install t = t.post_install let pre_remove t = t.pre_remove let wrap_remove t = t.wrap_remove let post_remove t = t.post_remove let pre_session t = t.pre_session let post_session t = t.post_session let with_pre_build pre_build t = { t with pre_build } let with_wrap_build wrap_build t = { t with wrap_build } let with_post_build post_build t = { t with post_build } let with_pre_install pre_install t = { t with pre_install } let with_wrap_install wrap_install t = { t with wrap_install } let with_post_install post_install t = { t with post_install } let with_pre_remove pre_remove t = { t with pre_remove } let with_wrap_remove wrap_remove t = { t with wrap_remove } let with_post_remove post_remove t = { t with post_remove } let with_pre_session pre_session t = { t with pre_session } let with_post_session post_session t = { t with post_session } let fields = [ "pre-build-commands", Pp.ppacc with_pre_build pre_build (Pp.V.map_list ~depth:2 Pp.V.command); "pre-install-commands", Pp.ppacc with_pre_install pre_install (Pp.V.map_list ~depth:2 Pp.V.command); "pre-remove-commands", Pp.ppacc with_pre_remove pre_remove (Pp.V.map_list ~depth:2 Pp.V.command); "pre-session-commands", Pp.ppacc with_pre_session pre_session (Pp.V.map_list ~depth:2 Pp.V.command); "wrap-build-commands", Pp.ppacc with_wrap_build wrap_build (Pp.V.map_list ~depth:2 Pp.V.command); "wrap-install-commands", Pp.ppacc with_wrap_install wrap_install (Pp.V.map_list ~depth:2 Pp.V.command); "wrap-remove-commands", Pp.ppacc with_wrap_remove wrap_remove (Pp.V.map_list ~depth:2 Pp.V.command); "post-build-commands", Pp.ppacc with_post_build post_build (Pp.V.map_list ~depth:2 Pp.V.command); "post-install-commands", Pp.ppacc with_post_install post_install (Pp.V.map_list ~depth:2 Pp.V.command); "post-remove-commands", Pp.ppacc with_post_remove post_remove (Pp.V.map_list ~depth:2 Pp.V.command); "post-session-commands", Pp.ppacc with_post_session post_session (Pp.V.map_list ~depth:2 Pp.V.command); ] let with_default ~default t = let f = function [] -> fun l -> l | l -> fun _ -> l in { pre_build = f t.pre_build default.pre_build; wrap_build = f t.wrap_build default.wrap_build; post_build = f t.post_build default.post_build; pre_install = f t.pre_install default.pre_install; wrap_install = f t.wrap_install default.wrap_install; post_install = f t.post_install default.post_install; pre_remove = f t.pre_remove default.pre_remove; wrap_remove = f t.wrap_remove default.wrap_remove; post_remove = f t.post_remove default.post_remove; pre_session = f t.pre_session default.pre_session; post_session = f t.post_session default.post_session; } let add ~outer ~inner = { pre_build = outer.pre_build @ inner.pre_build; wrap_build = outer.wrap_build @ inner.wrap_build; post_build = inner.post_build @ outer.post_build; pre_install = outer.pre_install @ inner.pre_install; wrap_install = outer.wrap_install @ inner.wrap_install; post_install = inner.post_install @ outer.post_install; pre_remove = outer.pre_remove @ inner.pre_remove; wrap_remove = outer.wrap_remove @ inner.wrap_remove; post_remove = inner.post_remove @ outer.post_remove; pre_session = outer.pre_session @ inner.pre_session; post_session = inner.post_session @ outer.post_session; } end (** General opam configuration (config) *) module ConfigSyntax = struct let internal = "config" type t = { opam_version : opam_version; repositories : repository_name list; installed_switches : switch list; switch : switch option; jobs : int; dl_tool : arg list option; dl_jobs : int; dl_cache : url list option; wrappers : Wrappers.t; solver_criteria : (solver_criteria * string) list; best_effort_prefix : string option; solver : arg list option; global_variables : (variable * variable_contents * string) list; eval_variables : (variable * string list * string) list; validation_hook : arg list option; default_compiler : formula; } let opam_version t = t.opam_version let repositories t = t.repositories let installed_switches t = t.installed_switches let switch t = t.switch let jobs t = t.jobs let dl_tool t = t.dl_tool let dl_jobs t = t.dl_jobs let dl_cache t = OpamStd.Option.default [] t.dl_cache let criteria t = t.solver_criteria let best_effort_prefix t = t.best_effort_prefix let criterion kind t = try Some (List.assoc kind t.solver_criteria) with Not_found -> None let solver t = t.solver let wrappers t = t.wrappers let global_variables t = t.global_variables let eval_variables t = t.eval_variables let validation_hook t = t.validation_hook let default_compiler t = t.default_compiler let with_opam_version opam_version t = { t with opam_version } let with_repositories repositories t = { t with repositories } let with_installed_switches installed_switches t = { t with installed_switches } let with_switch_opt switch t = { t with switch } let with_switch switch t = { t with switch = Some switch } let with_jobs jobs t = { t with jobs } let with_dl_tool dl_tool t = { t with dl_tool = Some dl_tool } let with_dl_tool_opt dl_tool t = { t with dl_tool } let with_dl_jobs dl_jobs t = { t with dl_jobs } let with_dl_cache dl_cache t = { t with dl_cache = Some dl_cache } let with_criteria solver_criteria t = { t with solver_criteria } let with_criterion kind criterion t = { t with solver_criteria = (kind,criterion)::List.remove_assoc kind t.solver_criteria } let with_best_effort_prefix s t = { t with best_effort_prefix = Some s } let with_solver solver t = { t with solver = Some solver } let with_solver_opt solver t = { t with solver = solver } let with_wrappers wrappers t = { t with wrappers } let with_global_variables global_variables t = { t with global_variables } let with_eval_variables eval_variables t = { t with eval_variables } let with_validation_hook validation_hook t = { t with validation_hook = Some validation_hook} let with_validation_hook_opt validation_hook t = { t with validation_hook } let with_default_compiler default_compiler t = { t with default_compiler } let empty = { opam_version = OpamVersion.current_nopatch; repositories = []; installed_switches = []; switch = None; jobs = 1; dl_tool = None; dl_jobs = 1; dl_cache = None; solver_criteria = []; best_effort_prefix = None; solver = None; wrappers = Wrappers.empty; global_variables = []; eval_variables = []; validation_hook = None; default_compiler = OpamFormula.Empty; } let fields = let with_switch sw t = if t.switch = None then with_switch sw t else Pp.bad_format "Multiple switch specifications" in [ "opam-version", Pp.ppacc with_opam_version opam_version (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "repositories", Pp.ppacc with_repositories repositories (Pp.V.map_list ~depth:1 (Pp.V.string -| Pp.of_module "repository" (module OpamRepositoryName))); "installed-switches", Pp.ppacc with_installed_switches installed_switches (Pp.V.map_list ~depth:1 (Pp.V.string -| Pp.of_module "switch" (module OpamSwitch))); "switch", Pp.ppacc_opt with_switch switch (Pp.V.string -| Pp.of_module "switch" (module OpamSwitch)); "jobs", Pp.ppacc with_jobs jobs Pp.V.pos_int; "download-command", Pp.ppacc_opt with_dl_tool dl_tool (Pp.V.map_list ~depth:1 Pp.V.arg); "download-jobs", Pp.ppacc with_dl_jobs dl_jobs Pp.V.pos_int; "archive-mirrors", Pp.ppacc_opt with_dl_cache (fun t -> t.dl_cache) (Pp.V.map_list ~depth:1 Pp.V.url); "solver-criteria", Pp.ppacc_opt (with_criterion `Default) (criterion `Default) Pp.V.string; "solver-upgrade-criteria", Pp.ppacc_opt (with_criterion `Upgrade) (criterion `Upgrade) Pp.V.string; "solver-fixup-criteria", Pp.ppacc_opt (with_criterion `Fixup) (criterion `Fixup) Pp.V.string; "best-effort-prefix-criteria", Pp.ppacc_opt with_best_effort_prefix best_effort_prefix Pp.V.string; "solver", Pp.ppacc_opt with_solver solver (Pp.V.map_list ~depth:1 Pp.V.arg); "global-variables", Pp.ppacc with_global_variables global_variables (Pp.V.map_list ~depth:2 (Pp.V.map_triple (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) Pp.V.variable_contents Pp.V.string)); "eval-variables", Pp.ppacc with_eval_variables eval_variables (Pp.V.map_list ~depth:2 (Pp.V.map_triple (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) (Pp.V.map_list Pp.V.string) Pp.V.string)); "repository-validation-command", Pp.ppacc_opt with_validation_hook validation_hook (Pp.V.map_list ~depth:1 Pp.V.arg); "default-compiler", Pp.ppacc with_default_compiler default_compiler (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); (* deprecated fields *) "alias", Pp.ppacc_opt with_switch OpamStd.Option.none (Pp.V.string -| Pp.of_module "switch-name" (module OpamSwitch)); "ocaml-version", Pp.ppacc_opt with_switch OpamStd.Option.none (Pp.V.string -| Pp.of_module "switch-name" (module OpamSwitch)); "cores", Pp.ppacc_opt with_jobs OpamStd.Option.none Pp.V.pos_int; "system_ocaml-version", Pp.ppacc_ignore; "system-ocaml-version", Pp.ppacc_ignore; ] @ List.map (fun (fld, ppacc) -> fld, Pp.embed with_wrappers wrappers ppacc) Wrappers.fields let pp = let name = internal in Pp.I.map_file @@ Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name ~strict:OpamCoreConfig.(not !r.safe_mode) () end module Config = struct include ConfigSyntax include SyntaxFile(ConfigSyntax) end module InitConfigSyntax = struct let internal = "init-config" type t = { opam_version : opam_version; repositories : (repository_name * (url * trust_anchors option)) list; default_compiler : formula; jobs : int option; dl_tool : arg list option; dl_jobs : int option; dl_cache : url list option; solver_criteria : (solver_criteria * string) list; solver : arg list option; wrappers : Wrappers.t; global_variables : (variable * variable_contents * string) list; eval_variables : (variable * string list * string) list; recommended_tools : (string list * string option * filter option) list; required_tools : (string list * string option * filter option) list; init_scripts : ((string * string) * filter option) list; } let opam_version t = t.opam_version let repositories t = t.repositories let default_compiler t = t.default_compiler let jobs t = t.jobs let dl_tool t = t.dl_tool let dl_jobs t = t.dl_jobs let dl_cache t = OpamStd.Option.default [] t.dl_cache let solver_criteria t = t.solver_criteria let solver t = t.solver let wrappers t = t.wrappers let global_variables t = t.global_variables let eval_variables t = t.eval_variables let recommended_tools t = t.recommended_tools let required_tools t = t.required_tools let init_scripts t = t.init_scripts let with_opam_version opam_version t = {t with opam_version} let with_repositories repositories t = {t with repositories} let with_default_compiler default_compiler t = {t with default_compiler} let with_jobs jobs t = {t with jobs} let with_dl_tool dl_tool t = {t with dl_tool} let with_dl_jobs dl_jobs t = {t with dl_jobs} let with_dl_cache dl_cache t = {t with dl_cache = Some dl_cache} let with_solver_criteria solver_criteria t = {t with solver_criteria} let with_solver solver t = {t with solver} let with_wrappers wrappers t = {t with wrappers} let with_global_variables global_variables t = {t with global_variables} let with_eval_variables eval_variables t = {t with eval_variables} let with_recommended_tools recommended_tools t = {t with recommended_tools} let with_required_tools required_tools t = {t with required_tools} let with_init_scripts init_scripts t = {t with init_scripts} let criterion kind t = try Some (List.assoc kind t.solver_criteria) with Not_found -> None let with_criterion kind criterion t = { t with solver_criteria = (kind,criterion)::List.remove_assoc kind t.solver_criteria } let empty = { opam_version = OpamVersion.current_nopatch; repositories = []; default_compiler = OpamFormula.Empty; jobs = None; dl_tool = None; dl_jobs = None; dl_cache = None; solver_criteria = []; solver = None; wrappers = Wrappers.empty; global_variables = []; eval_variables = []; recommended_tools = []; required_tools = []; init_scripts = []; } let pp_repository_def = Pp.V.map_options_3 (Pp.V.string -| Pp.of_module "repository" (module OpamRepositoryName)) (Pp.opt @@ Pp.singleton -| Pp.V.url) (Pp.map_list Pp.V.string) (Pp.opt @@ Pp.singleton -| Pp.V.int -| OpamPp.check ~name:"quorum" ~errmsg:"quorum must be >= 0" ((<=) 0)) -| Pp.pp (fun ~pos:_ (name, url, fingerprints, quorum) -> name, url, match fingerprints with [] -> None | fingerprints -> Some {fingerprints; quorum = OpamStd.Option.default 1 quorum}) (fun (name, url, ta) -> match ta with | Some ta -> name, url, ta.fingerprints, Some ta.quorum | None -> name, url, [], None) let fields = [ "opam-version", Pp.ppacc with_opam_version opam_version (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "repositories", Pp.ppacc with_repositories repositories (Pp.V.map_list ~depth:1 @@ pp_repository_def -| Pp.pp (fun ~pos -> function | (name, Some url, ta) -> (name, (url, ta)) | (_, None, _) -> Pp.bad_format ~pos "Missing repository URL") (fun (name, (url, ta)) -> (name, Some url, ta))); "default-compiler", Pp.ppacc with_default_compiler default_compiler (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); "jobs", Pp.ppacc_opt (with_jobs @* OpamStd.Option.some) jobs Pp.V.pos_int; "download-command", Pp.ppacc_opt (with_dl_tool @* OpamStd.Option.some) dl_tool (Pp.V.map_list ~depth:1 Pp.V.arg); "download-jobs", Pp.ppacc_opt (with_dl_jobs @* OpamStd.Option.some) dl_jobs Pp.V.pos_int; "archive-mirrors", Pp.ppacc with_dl_cache dl_cache (Pp.V.map_list ~depth:1 Pp.V.url); "solver-criteria", Pp.ppacc_opt (with_criterion `Default) (criterion `Default) Pp.V.string; "solver-upgrade-criteria", Pp.ppacc_opt (with_criterion `Upgrade) (criterion `Upgrade) Pp.V.string; "solver-fixup-criteria", Pp.ppacc_opt (with_criterion `Fixup) (criterion `Fixup) Pp.V.string; "solver", Pp.ppacc_opt (with_solver @* OpamStd.Option.some) solver (Pp.V.map_list ~depth:1 Pp.V.arg); "global-variables", Pp.ppacc with_global_variables global_variables (Pp.V.map_list ~depth:2 (Pp.V.map_triple (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) Pp.V.variable_contents Pp.V.string)); "eval-variables", Pp.ppacc with_eval_variables eval_variables (Pp.V.map_list ~depth:2 (Pp.V.map_triple (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) (Pp.V.map_list Pp.V.string) Pp.V.string)); "recommended-tools", Pp.ppacc with_recommended_tools recommended_tools (Pp.V.map_list (Pp.V.map_options_2 (Pp.V.map_list ~depth:1 Pp.V.string) (Pp.opt @@ Pp.singleton -| Pp.V.string) (Pp.opt Pp.V.filter))); "required-tools", Pp.ppacc with_required_tools required_tools (Pp.V.map_list (Pp.V.map_options_2 (Pp.V.map_list ~depth:1 Pp.V.string) (Pp.opt @@ Pp.singleton -| Pp.V.string) (Pp.opt Pp.V.filter))); "init-scripts", Pp.ppacc with_init_scripts init_scripts (Pp.V.map_list ~depth:2 (Pp.V.map_option (Pp.V.map_pair (Pp.V.string) (Pp.V.string_tr)) (Pp.opt Pp.V.filter))); ] @ List.map (fun (fld, ppacc) -> fld, Pp.embed with_wrappers wrappers ppacc) Wrappers.fields let pp = let name = internal in Pp.I.map_file @@ Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name ~strict:true () let add t1 t2 = let opt = function None -> fun o -> o | some -> fun _ -> some in let list = function [] -> fun l -> l | l -> fun _ -> l in { opam_version = t2.opam_version; repositories = list t2.repositories t1.repositories; default_compiler = if t2.default_compiler <> Empty then t2.default_compiler else t1.default_compiler; jobs = opt t2.jobs t1.jobs; dl_tool = opt t2.dl_tool t1.dl_tool; dl_jobs = opt t2.dl_jobs t1.dl_jobs; dl_cache = opt t2.dl_cache t1.dl_cache; solver_criteria = List.fold_left (fun acc c -> try (c, List.assoc c t2.solver_criteria) :: acc with Not_found -> try (c, List.assoc c t1.solver_criteria) :: acc with Not_found -> acc) [] [`Fixup; `Upgrade; `Default]; solver = opt t2.solver t1.solver; wrappers = Wrappers.with_default ~default:t1.wrappers t2.wrappers; global_variables = list t2.global_variables t1.global_variables; eval_variables = list t2.eval_variables t1.eval_variables; recommended_tools = list t2.recommended_tools t1.recommended_tools; required_tools = list t2.required_tools t1.required_tools; init_scripts = list t2.init_scripts t1.init_scripts; } end module InitConfig = struct include InitConfigSyntax include SyntaxFile(InitConfigSyntax) end module Repos_configSyntax = struct let internal = "repos-config" type t = ((url * trust_anchors option) option) OpamRepositoryName.Map.t let empty = OpamRepositoryName.Map.empty let fields = [ "repositories", Pp.ppacc (fun x _ -> x) (fun x -> x) ((Pp.V.map_list ~depth:1 @@ InitConfigSyntax.pp_repository_def -| Pp.pp (fun ~pos:_ -> function | (name, Some url, ta) -> name, Some (url, ta) | (name, None, _) -> name, None) (fun (name, def) -> match def with | Some (url, ta) -> name, Some url, ta | None -> name, None, None)) -| Pp.of_pair "repository-url-list" OpamRepositoryName.Map.(of_list, bindings)); ] let pp = let name = internal in Pp.I.map_file @@ Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name () end module Repos_config = struct include Repos_configSyntax include SyntaxFile(Repos_configSyntax) end module Switch_configSyntax = struct let internal = "switch-config" type t = { opam_version: OpamVersion.t; synopsis: string; repos: repository_name list option; paths: (std_path * string) list; variables: (variable * variable_contents) list; opam_root: dirname option; wrappers: Wrappers.t; env: env_update list; } let empty = { opam_version = OpamVersion.current_nopatch; synopsis = ""; repos = None; paths = []; variables = []; opam_root = None; wrappers = Wrappers.empty; env = []; } let sections = [ "paths", Pp.ppacc (fun paths t -> {t with paths}) (fun t -> t.paths) (Pp.I.anonymous_section Pp.I.items -| Pp.map_list (Pp.map_pair (Pp.of_pair "std-path" (std_path_of_string, string_of_std_path)) Pp.V.string)); "variables", Pp.ppacc (fun variables t -> {t with variables}) (fun t -> t.variables) (Pp.I.anonymous_section Pp.I.items -| Pp.map_list (Pp.map_pair (Pp.of_module "variable" (module OpamVariable)) Pp.V.variable_contents)); ] let fields = [ "opam-version", Pp.ppacc (fun opam_version t -> {t with opam_version}) (fun t -> t.opam_version) (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "synopsis", Pp.ppacc (fun synopsis t -> {t with synopsis}) (fun t -> t.synopsis) Pp.V.string; "repositories", Pp.ppacc_opt (fun r t -> {t with repos = Some r}) (fun t -> t.repos) (Pp.V.map_list ~depth:1 @@ Pp.V.string -| Pp.of_module "repo" (module OpamRepositoryName)); "opam-root", Pp.ppacc_opt (fun r t -> {t with opam_root = Some r}) (fun t -> t.opam_root) (Pp.V.string -| Pp.of_module "dirname" (module OpamFilename.Dir)); "setenv", Pp.ppacc (fun env t -> {t with env}) (fun t -> t.env) (Pp.V.map_list ~depth:2 Pp.V.env_binding); ] @ List.map (fun (fld, ppacc) -> fld, Pp.embed (fun wrappers t -> {t with wrappers}) (fun t -> t.wrappers) ppacc) Wrappers.fields let pp = let name = internal in Pp.I.map_file @@ Pp.I.fields ~name ~empty ~sections fields -| Pp.I.show_errors ~name () let variable t s = try Some (List.assoc s t.variables) with Not_found -> None let path t p = try Some (List.assoc p t.paths) with Not_found -> None let wrappers t = t.wrappers end module Switch_config = struct include Switch_configSyntax include SyntaxFile(Switch_configSyntax) end module SwitchSelectionsSyntax = struct let internal = "switch-state" type t = switch_selections let empty = { sel_installed = OpamPackage.Set.empty; sel_roots = OpamPackage.Set.empty; sel_compiler = OpamPackage.Set.empty; sel_pinned = OpamPackage.Set.empty; } let pp_package = Pp.of_module "package" (module OpamPackage) let pp_pkglist = Pp.V.map_list (Pp.V.string -| pp_package) -| Pp.pp (fun ~pos:_ -> OpamPackage.Set.of_list) OpamPackage.Set.elements let fields = [ "opam-version", Pp.ppacc (fun _ t -> t) (fun _ -> OpamVersion.current_nopatch) (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "compiler", Pp.ppacc (fun sel_compiler t -> {t with sel_compiler}) (fun t -> t.sel_compiler) pp_pkglist; "roots", Pp.ppacc (fun sel_roots t -> {t with sel_roots}) (fun t -> t.sel_roots) pp_pkglist; "installed", Pp.ppacc (fun installed t -> {t with sel_installed = installed}) (fun t -> t.sel_installed) pp_pkglist; "pinned", Pp.ppacc (fun sel_pinned t -> {t with sel_pinned}) (fun t -> t.sel_pinned) (Pp.V.map_list ~depth:1 (Pp.V.option -| (* The contents of the option is obsolete, the information is now contained in the overlay only *) Pp.pp (fun ~pos:_ (nv,_) -> nv) (fun nv -> nv, []) -| Pp.V.string -| pp_package) -| Pp.of_pair "Package set" OpamPackage.Set.(of_list, elements)) ] let pp = let name = "switch-state" in Pp.I.map_file @@ Pp.I.check_opam_version () -| Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name () end module SwitchSelections = struct type t = switch_selections include SyntaxFile(SwitchSelectionsSyntax) end (** Local repository config file (repo//config) *) module Repo_config_legacySyntax = struct let internal = "repo-file" type t = { repo_name : repository_name; repo_root : dirname; repo_url : url; repo_priority : int; } let empty = { repo_name = OpamRepositoryName.of_string ""; repo_url = OpamUrl.empty; repo_root = OpamFilename.raw_dir ""; repo_priority = 0; } let fields = [ "name", Pp.ppacc (fun repo_name (r:t) -> {r with repo_name}) (fun r -> r.repo_name) (Pp.V.string -| Pp.of_module "repository-name" (module OpamRepositoryName)); "address", Pp.ppacc (fun repo_url (r:t) -> {r with repo_url}) (fun r -> r.repo_url) Pp.V.url; "kind", Pp.ppacc_opt (* deprecated *) (fun backend (r:t) -> {r with repo_url = {r.repo_url with OpamUrl.backend}}) OpamStd.Option.none (Pp.V.string -| Pp.of_pair "repository-kind" OpamUrl.(backend_of_string, string_of_backend)); "priority", Pp.ppacc (fun repo_priority (r:t) -> {r with repo_priority}) (fun r -> r.repo_priority) Pp.V.int; "root", Pp.ppacc (fun repo_root (r:t) -> {r with repo_root}) (fun r -> r.repo_root) (Pp.V.string -| Pp.of_module "directory" (module OpamFilename.Dir)); ] let pp = let name = internal in Pp.I.map_file @@ Pp.I.fields ~name ~empty ~mandatory_fields:["root";"address";"name"] fields -| Pp.I.show_errors ~name ~strict:true () end module Repo_config_legacy = struct include Repo_config_legacySyntax include SyntaxFile(Repo_config_legacySyntax) end (** Global or package switch-local configuration variables. (/config/global-config.config, /lib//opam.config) *) module Dot_configSyntax = struct let internal = ".config" type t = { vars: (variable * variable_contents) list; file_depends: (filename * OpamHash.t) list; } let empty = { vars = []; file_depends = []; } let create vars = { empty with vars } let vars t = t.vars let with_vars vars t = { t with vars } let file_depends t = t.file_depends let with_file_depends file_depends t = { t with file_depends } let pp_variables = Pp.I.items -| Pp.map_list (Pp.map_pair (Pp.of_module "variable" (module OpamVariable)) Pp.V.variable_contents) let pp_contents = Pp.I.fields ~name:"config-file" ~empty ~sections:[ "variables", Pp.ppacc with_vars vars (Pp.I.anonymous_section pp_variables) ] [ "opam-version", Pp.ppacc (fun _ t -> t) (fun _ -> OpamVersion.current) (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "file-depends", Pp.ppacc with_file_depends file_depends (Pp.V.map_list ~depth:2 @@ Pp.V.map_pair (Pp.V.string -| Pp.of_module "path" (module OpamFilename)) (Pp.V.string -| Pp.of_module "checksum" (module OpamHash))) ] -| Pp.I.show_errors ~name:internal () (* Files with the variables at toplevel and no other fields are allowed for backwards-compat, when opam-version is unset or too old *) let pp = Pp.I.map_file @@ Pp.I.field "opam-version" (Pp.parse (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion))) -| Pp.pp (fun ~pos (opam_version_opt, s) -> match opam_version_opt with | Some v when OpamVersion.compare v (OpamVersion.of_string "1.3~dev3") > 0 -> Pp.parse ~pos pp_contents s | _ -> {empty with vars = Pp.parse ~pos pp_variables s}) (fun t -> None, Pp.print pp_contents t) let variables t = List.rev_map fst t.vars let bindings t = t.vars let variable t s = try Some (List.assoc s t.vars) with Not_found -> None let set k v t = let vars = List.remove_assoc k t.vars in let vars = match v with | Some v -> (k,v) :: vars | None -> vars in { t with vars } end module Dot_config = struct include Dot_configSyntax include SyntaxFile(Dot_configSyntax) end (** (2) General, public repository format *) (** Public repository definition file (/repo) *) module RepoSyntax = struct let internal = "repo" type t = { opam_version : OpamVersion.t option; browse : string option; upstream : string option; redirect : (string * filter option) list; root_url : url option; dl_cache : string list option; announce : (string * filter option) list; stamp : string option; } let create ?browse ?upstream ?opam_version ?(redirect=[]) ?root_url ?dl_cache ?(announce=[]) ?stamp () = { opam_version; browse; upstream; redirect; root_url; dl_cache; announce; stamp; } let empty = create () let opam_version t = t.opam_version let browse t = t.browse let upstream t = t.upstream let redirect t = t.redirect let root_url t = t.root_url let dl_cache t = OpamStd.Option.default [] t.dl_cache let announce t = t.announce let stamp t = t.stamp let with_opam_version opam_version t = { t with opam_version = Some opam_version } let with_browse browse t = { t with browse = Some browse } let with_upstream upstream t = { t with upstream = Some upstream } let with_redirect redirect t = { t with redirect } let with_root_url root_url t = { t with root_url = Some root_url } let with_dl_cache dl_cache t = { t with dl_cache = Some dl_cache } let with_announce announce t = { t with announce } let with_stamp id t = { t with stamp = Some id } let with_stamp_opt stamp t = { t with stamp } let fields = [ "opam-version", Pp.ppacc_opt with_opam_version opam_version (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "browse", Pp.ppacc_opt with_browse browse Pp.V.string; "upstream", Pp.ppacc_opt with_upstream upstream Pp.V.string; "redirect", Pp.ppacc with_redirect redirect (Pp.V.map_list ~depth:1 (Pp.V.map_option Pp.V.string (Pp.opt Pp.V.filter))); "archive-mirrors", Pp.ppacc with_dl_cache dl_cache (Pp.V.map_list ~depth:1 Pp.V.string); "announce", Pp.ppacc with_announce announce (Pp.V.map_list ~depth:1 (Pp.V.map_option Pp.V.string (Pp.opt Pp.V.filter))); "stamp", Pp.ppacc_opt with_stamp stamp Pp.V.string ] let pp = let name = internal in Pp.I.map_file @@ Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name ~condition:(function | {opam_version = Some v; _} -> OpamVersion.(compare current v) >= 0 | _ -> true) () end module Repo = struct include RepoSyntax include SyntaxFile(RepoSyntax) end (** Package url files (/packages/.../url) *) module URLSyntax = struct let internal = "url-file" type t = { url : url; mirrors : url list; checksum: OpamHash.t list; errors : (string * Pp.bad_format) list; } let create ?(mirrors=[]) ?(checksum=[]) url = { url; mirrors; checksum; errors = []; } let empty = { url = OpamUrl.empty; mirrors = []; checksum= []; errors = []; } let url t = t.url let mirrors t = t.mirrors let checksum t = t.checksum let with_url url t = { t with url } let with_mirrors mirrors t = { t with mirrors } let with_checksum checksum t = { t with checksum = checksum } let fields = let with_url url t = if t.url <> OpamUrl.empty then Pp.bad_format "Too many URLS" else with_url url t in [ "src", Pp.ppacc with_url url Pp.V.url; "archive", Pp.ppacc_opt with_url OpamStd.Option.none (Pp.V.url_with_backend `http); "http", Pp.ppacc_opt with_url OpamStd.Option.none (Pp.V.url_with_backend `http); "git", Pp.ppacc_opt with_url OpamStd.Option.none (Pp.V.url_with_backend `git); "darcs", Pp.ppacc_opt with_url OpamStd.Option.none (Pp.V.url_with_backend `darcs); "hg", Pp.ppacc_opt with_url OpamStd.Option.none (Pp.V.url_with_backend `hg); "local", Pp.ppacc_opt with_url OpamStd.Option.none (Pp.V.url_with_backend `rsync); "checksum", Pp.ppacc with_checksum checksum (Pp.V.map_list ~depth:1 (Pp.V.string -| Pp.of_module "checksum" (module OpamHash))); "mirrors", Pp.ppacc with_mirrors mirrors (Pp.V.map_list ~depth:1 Pp.V.url); ] let pp_contents = let name = internal in Pp.I.fields ~name ~empty fields -| Pp.I.on_errors ~name (fun t e -> {t with errors = e::t.errors}) -| Pp.pp ~name (fun ~pos t -> if t.url = OpamUrl.empty then OpamPp.bad_format ~pos "missing URL" else t) (fun x -> x) let pp = Pp.I.map_file pp_contents end module URL = struct include URLSyntax include SyntaxFile(URLSyntax) end (** (3) Opam package format *) module OPAMSyntax = struct let internal = "opam" type t = { opam_version: opam_version; (* Package ident *) name : OpamPackage.Name.t option; version : OpamPackage.Version.t option; (* Relationships; solver and availability info *) depends : filtered_formula; depopts : filtered_formula; conflicts : filtered_formula; conflict_class : name list; available : filter; flags : package_flag list; env : env_update list; (* Build instructions *) build : command list; run_test : command list; install : command list; remove : command list; (* Auxiliary data affecting the build *) substs : basename list; patches : (basename * filter option) list; build_env : env_update list; features : (OpamVariable.t * filtered_formula * string) list; extra_sources: (basename * URL.t) list; (* User-facing data used by opam *) messages : (string * filter option) list; post_messages: (string * filter option) list; depexts : (string list * filter) list; libraries : (string * filter option) list; syntax : (string * filter option) list; dev_repo : url option; pin_depends: (package * url) list; (* Package database details *) maintainer : string list; author : string list; license : string list; tags : string list; homepage : string list; doc : string list; bug_reports: string list; (* Extension fields (x-foo: "bar") *) extensions : (pos * value) OpamStd.String.Map.t; (* Extra sections *) url : URL.t option; descr : Descr.t option; (* Extra data, not actually file fields *) (* Related metadata directory (not an actual field of the file) This can be used to locate e.g. the files/ overlays *) metadata_dir: dirname option; (* Names and hashes of the files below files/ *) extra_files: (OpamFilename.Base.t * OpamHash.t) list option; (* Stores any file errors for printing them later *) format_errors: (string * Pp.bad_format) list; (* Deprecated, for compat and proper linting *) ocaml_version: (OpamFormula.relop * string) OpamFormula.formula option; os : (bool * string) generic_formula; deprecated_build_test : command list; deprecated_build_doc : command list; } let empty = { opam_version = OpamVersion.current_nopatch; name = None; version = None; depends = OpamFormula.Empty; depopts = OpamFormula.Empty; conflicts = OpamFormula.Empty; available = FBool true; flags = []; conflict_class = []; env = []; build = []; run_test = []; install = []; remove = []; substs = []; patches = []; build_env = []; features = []; extra_sources = []; messages = []; post_messages = []; depexts = []; libraries = []; syntax = []; dev_repo = None; pin_depends= []; maintainer = []; author = []; license = []; tags = []; homepage = []; doc = []; bug_reports = []; extensions = OpamStd.String.Map.empty; url = None; descr = None; metadata_dir = None; extra_files = None; format_errors = []; ocaml_version = None; os = Empty; deprecated_build_test = []; deprecated_build_doc = []; } let create nv = let name = Some (nv.OpamPackage.name) in let version = Some (nv.OpamPackage.version) in { empty with name; version } let check t name = function | None -> let pos = OpamStd.Option.Op.(OpamFilename.Op.( t.metadata_dir >>| fun d -> pos_file (d // "opam"))) in Pp.bad_format ?pos "Field '%s:' is required" name | Some n -> n let ext_field_prefix = "x-" let is_ext_field = OpamStd.String.starts_with ~prefix:ext_field_prefix (* Getters *) let opam_version t = t.opam_version let name (t:t) = check t "name" t.name let name_opt (t:t) = t.name let version (t:t) = check t "version" t.version let version_opt (t:t) = t.version let package t = OpamPackage.create (name t) (version t) let depends t = t.depends let depopts t = t.depopts let conflicts t = t.conflicts let conflict_class t = t.conflict_class let available t = t.available let flags t = t.flags let has_flag f t = List.mem f t.flags let env (t:t) = List.map (fun env -> match t.name, env with | Some name, (var,op,value,None) -> var, op, value, Some ("Updated by package " ^ OpamPackage.Name.to_string name) | _, b -> b) t.env let build t = t.build let run_test t = t.deprecated_build_test @ t.run_test let deprecated_build_test t = t.deprecated_build_test let deprecated_build_doc t = t.deprecated_build_doc let install t = t.install let remove t = t.remove let substs t = t.substs let patches t = t.patches let build_env t = t.build_env let features t = t.features let extra_sources t = t.extra_sources let messages t = t.messages let post_messages t = t.post_messages let depexts t = t.depexts let libraries t = t.libraries let syntax t = t.syntax let dev_repo t = t.dev_repo let pin_depends t = t.pin_depends let maintainer t = t.maintainer let author t = t.author let license t = t.license let tags t = t.tags let homepage t = t.homepage let doc t = t.doc let bug_reports t = t.bug_reports let extensions t = OpamStd.String.Map.map snd t.extensions let extended t fld parse = if not (is_ext_field fld) then invalid_arg "OpamFile.OPAM.extended"; try let pos, s = OpamStd.String.Map.find fld t.extensions in (try Some (parse s) with | Pp.Bad_format _ as e -> raise (Pp.add_pos pos e)) with Not_found -> None let url t = t.url let descr t = t.descr let synopsis t = OpamStd.Option.map Descr.synopsis t.descr let descr_body t = match t.descr with | None | Some (_, "") -> None | Some (_, text) -> Some text let get_url t = match url t with Some u -> Some (URL.url u) | None -> None let format_errors t = t.format_errors let metadata_dir t = t.metadata_dir let extra_files t = t.extra_files (* Setters *) let with_opam_version opam_version t = { t with opam_version } let with_name name (t:t) = { t with name = Some name } let with_name_opt name (t:t) = { t with name } let with_version version (t:t) = { t with version = Some version } let with_version_opt version (t:t) = { t with version } let with_nv nv (t:t) = { t with name = Some (nv.OpamPackage.name); version = Some (nv.OpamPackage.version) } let with_depends depends t = { t with depends } let with_depopts depopts t = { t with depopts } let with_conflicts conflicts t = {t with conflicts } let with_conflict_class conflict_class t = { t with conflict_class } let with_available available t = { t with available } let with_flags flags t = { t with flags } let add_flags flags t = { t with flags = OpamStd.List.sort_nodup compare (flags @ t.flags) } let with_env env t = { t with env } let with_build build t = { t with build } let with_run_test run_test t = { t with run_test } let with_deprecated_build_test deprecated_build_test t = { t with deprecated_build_test } let with_deprecated_build_doc deprecated_build_doc t = { t with deprecated_build_doc } let with_install install t = { t with install } let with_remove remove t = { t with remove } let with_substs substs t = { t with substs } let with_patches patches t = { t with patches } let with_build_env build_env t = { t with build_env } let with_features features t = {t with features } let with_extra_sources extra_sources t = { t with extra_sources } let with_messages messages t = { t with messages } let with_post_messages post_messages t = { t with post_messages } let with_depexts depexts t = { t with depexts = depexts } let with_libraries libraries t = { t with libraries } let with_syntax syntax t = { t with syntax } let with_dev_repo dev_repo t = { t with dev_repo = Some dev_repo } let with_dev_repo_opt dev_repo t = { t with dev_repo } let with_pin_depends pin_depends t = { t with pin_depends } let with_maintainer maintainer t = { t with maintainer } let with_author author t = { t with author } let with_license license t = { t with license } let with_tags tags t = { t with tags } let with_homepage homepage t = { t with homepage } let with_doc doc t = { t with doc } let with_bug_reports bug_reports t = { t with bug_reports } let with_extensions extensions t = if not (OpamStd.String.Map.for_all (fun k _ -> is_ext_field k) extensions) then invalid_arg "OpamFile.OPAM.with_extensions"; {t with extensions = OpamStd.String.Map.map (fun s -> pos_null, s) extensions } let add_extension t fld syn = if not (is_ext_field fld) then invalid_arg "OpamFile.OPAM.add_extension"; {t with extensions = OpamStd.String.Map.add fld (pos_null,syn) t.extensions } let with_url url t = let format_errors = List.map (fun (name,bf) -> "url."^name, bf) url.URL.errors in { t with url = Some url; format_errors = format_errors @ t.format_errors } let with_url_opt url t = let format_errors = match url with | None -> [] | Some u -> List.map (fun (name,bf) -> "url."^name, bf) u.URL.errors in { t with url; format_errors = format_errors @ t.format_errors } let with_descr descr t = { t with descr = Some descr } let with_descr_opt descr t = { t with descr } let with_synopsis synopsis t = { t with descr = Some (synopsis, OpamStd.Option.default "" (descr_body t)) } let with_descr_body text t = { t with descr = Some (OpamStd.Option.default "" (synopsis t), text) } let with_metadata_dir metadata_dir t = { t with metadata_dir } let with_extra_files extra_files t = { t with extra_files = Some extra_files } let with_extra_files_opt extra_files t = { t with extra_files } let with_format_errors format_errors t = { t with format_errors } let with_ocaml_version ocaml_version t = { t with ocaml_version = Some ocaml_version } let with_os os t = { t with os } (* Post-processing functions used for some fields (optional, because we don't want them when linting). It's better to do them in the same pass as parsing, because it allows one to get file positions, which we lose afterwards *) (* Allow 'flag:xxx' tags as flags, for compat *) let flag_of_tag tag = let prefix = "flags:" in if OpamStd.String.starts_with ~prefix tag then Some (pkg_flag_of_string (OpamStd.String.remove_prefix ~prefix tag)) else None let cleanup_name _opam_version ~pos:(file,_,_ as pos) name = match OpamPackage.of_filename (OpamFilename.of_string file) with | Some nv when nv.OpamPackage.name <> name -> Pp.warn ~pos "This file is for package '%s' but its 'name:' field \ advertises '%s'." (OpamPackage.name_to_string nv) (OpamPackage.Name.to_string name); nv.OpamPackage.name | _ -> name let cleanup_version _opam_version ~pos:(file,_,_ as pos) version = match OpamPackage.of_filename (OpamFilename.of_string file) with | Some nv when nv.OpamPackage.version <> version -> Pp.warn ~pos "This file is for version '%s' but its 'version:' field \ advertises '%s'." (OpamPackage.version_to_string nv) (OpamPackage.Version.to_string version); nv.OpamPackage.version | _ -> version let cleanup_depopts opam_version ~pos depopts = if OpamFormatConfig.(!r.skip_version_checks) || OpamVersion.compare opam_version (OpamVersion.of_string "1.2") < 0 then depopts else (* Make sure depopts are a pure disjunction *) let rec aux acc disjunction = List.fold_left (fun acc -> function | OpamFormula.Atom _ as atom -> atom :: acc | f -> Pp.warn ~pos "Optional dependencies must be a disjunction. \ Treated as such."; aux acc (OpamFormula.fold_left (fun acc a -> OpamFormula.Atom a::acc) [] f) ) acc disjunction in OpamFormula.ors_to_list depopts |> aux [] |> List.rev |> OpamFormula.ors let cleanup_conflicts opam_version ~pos conflicts = (* Conflicts were encoded as a conjunction before 1.3, which didn't match the semantics. The rewrite is done for all versions, but on 1.3+ it should be an error. *) let is_disjunction f = List.for_all (function Atom _ -> true | _ -> false) OpamFormula.(ors_to_list f) in if is_disjunction conflicts then conflicts else let force_disjunction f = OpamFormula.map_formula (function | And (a, b) -> Or (a, b) | f -> f) f in if OpamVersion.(compare opam_version (of_string "1.3") >= 0) then Pp.warn ~pos "Conflicts must be a disjunction, '&' is not \ supported (treated as '|')."; force_disjunction conflicts let cleanup_flags _opam_version ~pos flags = let known_flags = List.filter (function Pkgflag_Unknown _ -> false | _ -> true) flags in if known_flags <> flags then Pp.warn ~pos "Unknown package flags %s ignored" (OpamStd.Format.pretty_list (OpamStd.List.filter_map (function | Pkgflag_Unknown s -> Some s | _ -> None) flags)); known_flags let cleanup_tags opam_version ~pos tags = let flags = OpamStd.List.filter_map flag_of_tag tags in ignore (cleanup_flags opam_version ~pos flags); tags let cleanup_dev_repo opam_version ~pos:_ dev_repo = if OpamVersion.(compare opam_version (of_string "1.3") >= 0) then dev_repo else OpamUrl.parse ~handle_suffix:true (OpamUrl.to_string dev_repo) let pp_basename = Pp.V.string -| Pp.of_module "file" (module OpamFilename.Base) (* Field parser-printers *) (* [field name, (pure pp, pp including cleanup/check function)] *) let fields_gen = let no_cleanup (ppacc: ?cleanup:(pos:_ -> _) -> _) set get pp = let p = ppacc set get pp in p, p in let with_cleanup cleanup (ppacc: ?cleanup:(pos:_ -> _) -> _) set get pp = let cleanup ~pos acc x = cleanup acc.opam_version ~pos x in ppacc set get pp, ppacc set get ~cleanup pp in [ "opam-version", no_cleanup Pp.ppacc with_opam_version opam_version (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "name", with_cleanup cleanup_name Pp.ppacc_opt with_name name_opt Pp.V.pkgname; "version", with_cleanup cleanup_version Pp.ppacc_opt with_version version_opt (Pp.V.string_tr -| Pp.of_module "version" (module OpamPackage.Version)); "synopsis", no_cleanup Pp.ppacc_opt with_synopsis synopsis Pp.V.string_tr; "description", no_cleanup Pp.ppacc_opt with_descr_body descr_body Pp.V.string_tr; "maintainer", no_cleanup Pp.ppacc with_maintainer maintainer (Pp.V.map_list ~depth:1 Pp.V.string); "authors", no_cleanup Pp.ppacc with_author author (Pp.V.map_list ~depth:1 Pp.V.string); "author", no_cleanup Pp.ppacc (fun a t -> if t.author = [] then with_author a t else Pp.bad_format "multiple \"authors:\" fields" author) (fun _ -> []) (Pp.V.map_list ~depth:1 Pp.V.string); "license", no_cleanup Pp.ppacc with_license license (Pp.V.map_list ~depth:1 Pp.V.string); "tags", with_cleanup cleanup_tags Pp.ppacc with_tags tags (Pp.V.map_list ~depth:1 Pp.V.string); "homepage", no_cleanup Pp.ppacc with_homepage homepage (Pp.V.map_list ~depth:1 Pp.V.string); "doc", no_cleanup Pp.ppacc with_doc doc (Pp.V.map_list ~depth:1 Pp.V.string); "bug-reports", no_cleanup Pp.ppacc with_bug_reports bug_reports (Pp.V.map_list ~depth:1 Pp.V.string); "depends", no_cleanup Pp.ppacc with_depends depends (Pp.V.package_formula `Conj Pp.V.(filtered_constraints ext_version)); "depopts", with_cleanup cleanup_depopts Pp.ppacc with_depopts depopts (Pp.V.package_formula `Disj Pp.V.(filtered_constraints ext_version)); "conflicts", with_cleanup cleanup_conflicts Pp.ppacc with_conflicts conflicts (Pp.V.package_formula `Disj Pp.V.(filtered_constraints ext_version)); "conflict-class", no_cleanup Pp.ppacc with_conflict_class conflict_class (Pp.V.map_list ~depth:1 Pp.V.pkgname); "available", no_cleanup Pp.ppacc with_available available (Pp.V.list_depth 1 -| Pp.V.list -| Pp.V.filter); "flags", with_cleanup cleanup_flags Pp.ppacc add_flags flags (Pp.V.map_list ~depth:1 @@ Pp.V.ident -| Pp.of_pair "package-flag" (pkg_flag_of_string, string_of_pkg_flag)); "setenv", no_cleanup Pp.ppacc with_env env (Pp.V.map_list ~depth:2 Pp.V.env_binding); "build", no_cleanup Pp.ppacc with_build build (Pp.V.map_list ~depth:2 Pp.V.command); "run-test", no_cleanup Pp.ppacc with_run_test run_test (Pp.V.map_list ~depth:2 Pp.V.command); "install", no_cleanup Pp.ppacc with_install install (Pp.V.map_list ~depth:2 Pp.V.command); "remove", no_cleanup Pp.ppacc with_remove remove (Pp.V.map_list ~depth:2 Pp.V.command); "substs", no_cleanup Pp.ppacc with_substs substs (Pp.V.map_list ~depth:1 pp_basename); "patches", no_cleanup Pp.ppacc with_patches patches (Pp.V.map_list ~depth:1 @@ Pp.V.map_option pp_basename (Pp.opt Pp.V.filter)); "build-env", no_cleanup Pp.ppacc with_build_env build_env (Pp.V.map_list ~depth:2 Pp.V.env_binding); "features", no_cleanup Pp.ppacc with_features features (Pp.V.map_list ~depth:2 @@ Pp.V.map_options_2 (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) (Pp.V.package_formula_items `Conj Pp.V.(filtered_constraints ext_version)) (Pp.singleton -| Pp.V.string)); "messages", no_cleanup Pp.ppacc with_messages messages (Pp.V.map_list ~depth:1 @@ Pp.V.map_option Pp.V.string_tr (Pp.opt Pp.V.filter)); "post-messages", no_cleanup Pp.ppacc with_post_messages post_messages (Pp.V.map_list ~depth:1 @@ Pp.V.map_option Pp.V.string_tr (Pp.opt Pp.V.filter)); "depexts", no_cleanup Pp.ppacc with_depexts depexts (Pp.fallback (Pp.V.map_list ~depth:2 @@ Pp.V.map_option (Pp.V.map_list Pp.V.string) (Pp.V.filter)) (Pp.V.map_list ~depth:3 (let rec filter_of_taglist = function | [] -> FBool true | [v] -> FString v | v :: r -> FAnd (FString v, filter_of_taglist r) in Pp.V.map_pair (Pp.V.map_list Pp.V.string -| Pp.of_pair "tag-list" (filter_of_taglist, fun _ -> assert false)) (Pp.V.map_list Pp.V.string) -| Pp.pp (fun ~pos:_ (a,b) -> b,a) (fun (b,a) -> a,b)))); "libraries", no_cleanup Pp.ppacc with_libraries libraries (Pp.V.map_list ~depth:1 @@ Pp.V.map_option Pp.V.string (Pp.opt Pp.V.filter)); "syntax", no_cleanup Pp.ppacc with_syntax syntax (Pp.V.map_list ~depth:1 @@ Pp.V.map_option Pp.V.string (Pp.opt Pp.V.filter)); "dev-repo", with_cleanup cleanup_dev_repo Pp.ppacc_opt with_dev_repo dev_repo (Pp.V.string -| Pp.of_pair "vc-url" OpamUrl.(parse ?backend:None ~handle_suffix:false, to_string)); "pin-depends", no_cleanup Pp.ppacc with_pin_depends pin_depends (OpamFormat.V.map_list ~depth:2 (OpamFormat.V.map_pair (OpamFormat.V.string -| OpamPp.of_module "package" (module OpamPackage)) (OpamFormat.V.string -| OpamPp.of_module "URL" (module OpamUrl)))); "extra-files", no_cleanup Pp.ppacc_opt with_extra_files extra_files (Pp.V.map_list ~depth:2 @@ Pp.V.map_pair pp_basename (Pp.V.string -| Pp.of_module "checksum" (module OpamHash))); (* deprecated fields, here for compat *) "configure-style", (Pp.ppacc_ignore, Pp.ppacc_ignore); "ocaml-version", no_cleanup Pp.ppacc_opt with_ocaml_version OpamStd.Option.none (Pp.V.list_depth 1 -| Pp.V.list -| Pp.V.constraints Pp.V.compiler_version); "os", no_cleanup Pp.ppacc_opt with_os OpamStd.Option.none Pp.V.os_constraint; "descr", no_cleanup Pp.ppacc_opt with_descr OpamStd.Option.none (Pp.V.string_tr -| Pp.of_pair "descr" Descr.(of_string (), to_string ())); "extra-sources", no_cleanup Pp.ppacc_opt with_extra_sources OpamStd.Option.none (Pp.V.map_list ~depth:2 @@ Pp.V.map_pair (Pp.V.map_option Pp.V.url (Pp.opt @@ Pp.singleton -| pp_basename)) (Pp.V.string -| Pp.of_module "checksum" (module OpamHash)) -| Pp.pp (fun ~pos:_ ((u,b),md5) -> OpamStd.Option.default (OpamFilename.Base.of_string (OpamUrl.basename u)) b, URL.create ~checksum:[md5] u) (fun (f, urlf) -> URL.((url urlf, Some f), List.hd (checksum urlf)))); "build-test", no_cleanup Pp.ppacc_opt with_deprecated_build_test OpamStd.Option.none (Pp.V.map_list ~depth:2 Pp.V.command); "build-doc", no_cleanup Pp.ppacc_opt with_deprecated_build_doc (fun x -> Some (deprecated_build_doc x)) (Pp.V.map_list ~depth:2 Pp.V.command); ] (* These don't have a printer and their info is stored in new fields *) let alias_fields = [ "author", "authors"; "descr", "description"; ] (* These don't have a printer and their info can't be retrieved in the same format anymore *) let deprecated_fields = [ "ocaml-version"; "os"; "configure-style"; "extra-sources"; "build-test"; "build-doc"; ] let fields = List.map (fun (name, (_, cleaned_up_pp)) -> name, cleaned_up_pp) fields_gen let sections = [ "url", Pp.ppacc_opt with_url url (Pp.I.anonymous_section URL.pp_contents); "extra-source", Pp.ppacc with_extra_sources extra_sources (Pp.map_list (Pp.map_pair (Pp.pp (fun ~pos -> function | Some o -> OpamFilename.Base.of_string o | None -> Pp.bad_format ~pos "missing extra-source name") (fun b -> Some (OpamFilename.Base.to_string b))) URL.pp_contents)) ] let raw_fields = List.map (fun (name, (raw_pp, _)) -> name, raw_pp) fields_gen let handle_flags_in_tags = let parse ~pos:_ t = let flags = List.fold_left (fun flags tag -> match flag_of_tag tag with | Some flag -> flag :: flags | None -> flags) t.flags t.tags in {t with flags} in let print t = let flags, tags = List.fold_left (fun (flags, tags) tag -> match flag_of_tag tag with | Some flag -> if List.mem flag flags then List.filter ((<>) flag) flags, tag::tags else flags, tags | None -> flags, tag::tags) (t.flags,[]) (List.rev t.tags) in {t with flags; tags} in Pp.pp parse print let handle_deprecated_available = let add_available available filter = match available with | FBool true -> filter | f -> FAnd (filter, f) in let parse ~pos:_ t = let available = t.available in let available = match t.ocaml_version with | None -> available | Some ocaml_version -> let var = OpamVariable.of_string "ocaml-version" in let mk_atom (op,v) = FOp (FIdent ([], var, None), op, FString v) in let filter = OpamFilter.of_formula mk_atom ocaml_version in add_available available filter in let available = match t.os with | Empty -> available | os -> let var = OpamVariable.of_string "os" in let mk_atom (eq,name) = FOp (FIdent ([], var, None), (if eq then `Eq else `Neq), FString name) in let filter = OpamFilter.of_formula mk_atom os in add_available available filter in { t with available } in Pp.pp parse (fun x -> x) (* Doesn't handle package name encoded in directory name *) let pp_raw_fields = Pp.I.check_opam_version () -| Pp.I.partition_fields is_ext_field -| Pp.map_pair (Pp.I.items -| OpamStd.String.Map.(Pp.pp (fun ~pos:_ -> of_list) bindings)) (Pp.I.fields ~name:"opam-file" ~empty ~sections fields -| Pp.I.on_errors (fun t e -> {t with format_errors=e::t.format_errors}) -| handle_flags_in_tags -| handle_deprecated_available) -| Pp.pp (fun ~pos:_ (extensions, t) -> with_extensions extensions t) (fun t -> extensions t, t) let pp_raw = Pp.I.map_file @@ pp_raw_fields let pp = pp_raw -| Pp.pp (fun ~pos:_ (filename, t) -> filename, let metadata_dir = if filename <> dummy_file then Some (OpamFilename.dirname filename) else None in let t = { t with metadata_dir } in match OpamPackage.of_filename filename with | Some nv -> with_nv nv t | None -> t) (fun (filename, t) -> filename, match OpamPackage.of_filename filename, t.name, t.version with | Some _, None, None -> t | None, Some _, Some _ -> t | None, _, _ -> OpamConsole.log "FILE(opam)" "Outputting opam file %s with unspecified name or version" (OpamFilename.to_string filename); t | Some nv, _, _ -> if t.name <> None && t.name <> Some (nv.OpamPackage.name) || t.version <> None && t.version <> Some (nv.OpamPackage.version) then OpamConsole.warning "Skipping inconsistent 'name:' or 'version:' fields (%s) \ while saving %s" (OpamPackage.to_string @@ OpamPackage.create (OpamStd.Option.default (nv.OpamPackage.name) t.name) (OpamStd.Option.default (nv.OpamPackage.version) t.version)) (OpamFilename.prettify filename); {t with name = None; version = None}) let to_string_with_preserved_format ?format_from ?format_from_string filename t = Syntax.to_string_with_preserved_format ?format_from ?format_from_string filename ~empty ~sections ~fields:raw_fields pp t let write_with_preserved_format ?format_from ?format_from_string filename t = let s = to_string_with_preserved_format ?format_from ?format_from_string filename t in OpamFilename.write filename s let contents ?(filename=dummy_file) t = Pp.print pp (filename, t) let to_list ?filename t = let rec aux acc pfx = function | Section (_, {section_kind; section_name=None; section_items}) :: r -> aux (aux acc (section_kind :: pfx) section_items) pfx r | Section (_, {section_kind; section_name=Some n; section_items}) :: r -> aux (aux acc (Printf.sprintf "%s(%s)" section_kind n :: pfx) section_items) pfx r | Variable (_, name, value) :: r -> aux (((name :: pfx), value) :: acc) pfx r | [] -> acc in List.rev_map (fun (pfx, value) -> String.concat "." (List.rev pfx), value) (aux [] [] (contents ?filename t).file_contents) let print_field_as_syntax field t = let field = try List.assoc field alias_fields with Not_found -> field in if List.mem field deprecated_fields then raise Not_found; match OpamStd.String.cut_at field '.' with | None -> if is_ext_field field then OpamStd.Option.map snd (OpamStd.String.Map.find_opt field t.extensions) else snd (Pp.print (List.assoc field fields) t) | Some (sec, field) -> match snd (Pp.print (List.assoc sec sections) t) with | None -> None | Some items -> (* /!\ returns only the first result for multiple named sections *) Some (OpamStd.List.find_map (function | Variable (_, f, contents) when f = field -> Some contents | _ -> None) (List.flatten (List.map snd items))) end module OPAM = struct include OPAMSyntax include SyntaxFile(OPAMSyntax) (** Extra stuff for opam files *) let effective_part (t:t) = { opam_version = empty.opam_version; name = t.name; version = t.version; depends = t.depends; depopts = t.depopts; conflicts = t.conflicts; conflict_class = t.conflict_class; available = t.available; flags = t.flags; env = t.env; build = t.build; run_test = t.deprecated_build_test @ t.run_test; install = t.install; remove = t.remove; substs = t.substs; patches = t.patches; build_env = t.build_env; features = t.features; extra_sources = t.extra_sources; messages = empty.messages; post_messages = empty.post_messages; depexts = empty.depexts; libraries = empty.libraries; syntax = empty.syntax; dev_repo = empty.dev_repo; pin_depends = empty.pin_depends; maintainer = empty.maintainer; author = empty.author; license = empty.license; tags = empty.tags; homepage = empty.homepage; doc = empty.doc; bug_reports = empty.bug_reports; extensions = empty.extensions; url = (match t.url with | None -> None | Some u -> match URL.checksum u with | [] -> Some (URL.create (URL.url u)) (* ignore mirrors *) | cksum::_ -> Some (URL.with_checksum [cksum] URL.empty)); (* ignore actual url and extra checksums *) descr = empty.descr; metadata_dir = empty.metadata_dir; extra_files = OpamStd.Option.Op.(t.extra_files ++ Some []); format_errors = empty.format_errors; ocaml_version = empty.ocaml_version; os = empty.os; deprecated_build_test = []; (* merged into run_test *) deprecated_build_doc = t.deprecated_build_doc; } let effectively_equal o1 o2 = effective_part o1 = effective_part o2 let equal o1 o2 = with_metadata_dir None o1 = with_metadata_dir None o2 let get_extra_files o = OpamStd.Option.Op.( (metadata_dir o >>= fun mdir -> let files_dir = OpamFilename.Op.(mdir / "files") in extra_files o >>| List.map @@ fun (basename, hash) -> OpamFilename.create files_dir basename, basename, hash) +! [] ) let print_errors ?file o = if o.format_errors <> [] then OpamConsole.error "In the opam file%s:\n%s\ %s %s been %s." (match o.name, o.version, file, o.metadata_dir with | Some n, Some v, _, _ -> Printf.sprintf " for %s" (OpamPackage.to_string (OpamPackage.create n v)) | _, _, Some f, _ -> Printf.sprintf " at %s" (to_string f) | _, _, _, Some dir -> Printf.sprintf " in %s" (OpamFilename.Dir.to_string dir) | _ -> "") (OpamStd.Format.itemize (fun (_, bf) -> Pp.string_of_bad_format (OpamPp.Bad_format bf)) o.format_errors) (OpamStd.List.concat_map ", " (fun (f,_) -> Printf.sprintf "'%s'" f) o.format_errors) (match o.format_errors with [_] -> "has" | _ -> "have") (OpamConsole.colorise `bold "ignored") end (** Optional package.install files (/.install, /packages/.../files/.install) *) module Dot_installSyntax = struct let internal = ".install" type t = { bin : (basename optional * basename option) list; sbin : (basename optional * basename option) list; lib : (basename optional * basename option) list; toplevel: (basename optional * basename option) list; stublibs: (basename optional * basename option) list; share : (basename optional * basename option) list; share_root: (basename optional * basename option) list; etc : (basename optional * basename option) list; doc : (basename optional * basename option) list; man : (basename optional * basename option) list; libexec : (basename optional * basename option) list; lib_root: (basename optional * basename option) list; libexec_root: (basename optional * basename option) list; misc : (basename optional * filename) list; } let empty = { lib = []; bin = []; sbin = []; toplevel = []; stublibs = []; misc = []; share = []; share_root = []; etc = []; man = []; libexec = []; lib_root = []; libexec_root = []; doc = []; } let bin t = t.bin let sbin t = t.sbin let lib t = t.lib let toplevel t = t.toplevel let stublibs t = t.stublibs let misc t = t.misc let share t = t.share let share_root t = t.share_root let etc t = t.etc let raw_man t = t.man let doc t = t.doc let libexec t = t.libexec let lib_root t = t.lib_root let libexec_root t = t.libexec_root let with_bin bin t = { t with bin } let with_sbin sbin t = { t with sbin } let with_lib lib t = { t with lib } let with_toplevel toplevel t = { t with toplevel } let with_stublibs stublibs t = { t with stublibs } let with_misc misc t = { t with misc } let with_share share t = { t with share } let with_share_root share_root t = { t with share_root } let with_etc etc t = { t with etc } let with_man man t = { t with man } let with_doc doc t = { t with doc } let with_libexec libexec t = { t with libexec } let with_lib_root lib_root t = { t with lib_root } let with_libexec_root libexec_root t = { t with libexec_root } let add_man_section_dir src = let file = Filename.basename (OpamFilename.Base.to_string src.c) in let section = let base = if Filename.check_suffix file ".gz" then Filename.chop_suffix file ".gz" else file in let dot = String.rindex base '.' in if dot < String.length base - 1 then match base.[dot+1] with | '1'..'8' as c -> Some (Printf.sprintf "man%c" c) | _ -> None else None in OpamStd.Option.Op.( section >>| (fun s -> Filename.concat s file) >>| OpamFilename.Base.of_string ) let man t = List.map (fun (src, dst) -> src, match dst with | Some _ -> dst | None -> add_man_section_dir src ) t.man (* Filenames starting by ? are not always present. *) let pp_optional = Pp.pp ~name:"file-name" (fun ~pos:_ str -> let mk = OpamFilename.Base.of_string in if String.length str > 0 && str.[0] = '?' then { optional = true; c = mk (String.sub str 1 (String.length str - 1)) } else { optional = false; c = mk str }) (fun op -> if op.optional then "?" ^ OpamFilename.Base.to_string op.c else OpamFilename.Base.to_string op.c) let fields = let pp_field = Pp.V.map_list ~depth:1 @@ Pp.V.map_option (Pp.V.string -| pp_optional) (Pp.opt @@ Pp.singleton -| Pp.V.string -| Pp.of_module "rel-filename" (module OpamFilename.Base)) in let pp_misc = Pp.V.map_list ~depth:1 @@ Pp.V.map_option (Pp.V.string -| pp_optional) (Pp.singleton -| Pp.V.string -| Pp.pp ~name:"abs-filename" (fun ~pos s -> if not (Filename.is_relative s) then OpamFilename.of_string s else Pp.bad_format ~pos "%s is not an absolute filename." s) OpamFilename.to_string) in [ "lib", Pp.ppacc with_lib lib pp_field; "bin", Pp.ppacc with_bin bin pp_field; "sbin", Pp.ppacc with_sbin sbin pp_field; "misc", Pp.ppacc with_misc misc pp_misc; "toplevel", Pp.ppacc with_toplevel toplevel pp_field; "stublibs", Pp.ppacc with_stublibs stublibs pp_field; "share", Pp.ppacc with_share share pp_field; "share_root", Pp.ppacc with_share_root share_root pp_field; "etc", Pp.ppacc with_etc etc pp_field; "doc", Pp.ppacc with_doc doc pp_field; "man", Pp.ppacc with_man raw_man pp_field; "libexec", Pp.ppacc with_libexec libexec pp_field; "lib_root", Pp.ppacc with_lib_root lib_root pp_field; "libexec_root", Pp.ppacc with_libexec_root libexec_root pp_field; ] let pp = let name = internal in Pp.I.map_file @@ Pp.I.check_opam_version ~optional:true () -| Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name () -| Pp.check ~errmsg:"man file without destination or recognised suffix" (fun t -> List.for_all (function | m, None -> add_man_section_dir m <> None | _, Some _ -> true) t.man) end module Dot_install = struct include Dot_installSyntax include SyntaxFile(Dot_installSyntax) end module ChangesSyntax = struct let internal = "changes" open OpamDirTrack type t = OpamDirTrack.t module SM = OpamStd.String.Map let empty = SM.empty let field kind get_kind = Pp.ppacc (fun files t -> List.fold_left (fun t (f,digest) -> SM.add f (kind digest) t) t files) (fun t -> SM.fold (fun f op acc -> match get_kind op with Some dg -> (f, dg) :: acc | None -> acc) t [] |> List.rev) (Pp.V.map_list ~depth:1 @@ Pp.V.map_option Pp.V.string (Pp.opt (Pp.singleton -| Pp.V.string -| Pp.of_pair "digest" (digest_of_string, string_of_digest)))) let fields = [ "added", field (function Some dg -> Added dg | None -> Pp.bad_format "Missing digest") (function Added dg -> Some (Some dg) | _ -> None); "removed", field (function Some _ -> Pp.bad_format "Extra digest" | None -> Removed) (function Removed -> Some None | _ -> None); "contents-changed", field (function Some dg -> Contents_changed dg | None -> Pp.bad_format "Missing digest") (function Contents_changed dg -> Some (Some dg) | _ -> None); "perm-changed", field (function Some dg -> Perm_changed dg | None -> Pp.bad_format "Missing digest") (function Perm_changed dg -> Some (Some dg) | _ -> None); "kind-changed", field (function Some dg -> Kind_changed dg | None -> Pp.bad_format "Missing digest") (function Kind_changed dg -> Some (Some dg) | _ -> None); ] let pp_contents = Pp.I.fields ~name:internal ~empty fields -| Pp.I.show_errors ~name:internal () let pp = Pp.I.map_file pp_contents end module Changes = struct type t = OpamDirTrack.t include SyntaxFile(ChangesSyntax) end module SwitchExportSyntax = struct let internal = "switch-export" type t = { selections: switch_selections; overlays: OPAM.t OpamPackage.Name.Map.t; } let empty = { selections = SwitchSelectionsSyntax.empty; overlays = OpamPackage.Name.Map.empty; } let fields = SwitchSelectionsSyntax.fields let pp = let name = "export-file" in Pp.I.map_file @@ Pp.I.check_opam_version () -| Pp.I.partition (function | Section (_, { section_kind="package"; section_name=Some _; _ }) -> false | _ -> true) -| Pp.map_pair (Pp.I.fields ~name ~empty:SwitchSelectionsSyntax.empty fields -| Pp.I.show_errors ~name ()) (Pp.map_list (Pp.I.section "package" -| Pp.map_pair (Pp.map_option (Pp.of_module "package-name" (module OpamPackage.Name))) OPAMSyntax.pp_raw_fields -| Pp.pp (fun ~pos:_ (name, opam) -> match name with | Some name -> name, OPAM.with_name name opam | None -> OPAM.name opam, opam) (fun (name, opam) -> Some name, OPAM.with_name_opt None opam)) -| Pp.of_pair "package-metadata-map" OpamPackage.Name.Map.(of_list,bindings)) -| Pp.pp (fun ~pos:_ (selections, overlays) -> {selections; overlays}) (fun {selections; overlays} -> (selections, overlays)) end module SwitchExport = struct type t = SwitchExportSyntax.t = { selections: switch_selections; overlays: OPAM.t OpamPackage.Name.Map.t; } include SyntaxFile(SwitchExportSyntax) end module CompSyntax = struct let internal = "comp" type compiler = string type compiler_version = string type t = { opam_version : opam_version ; name : compiler ; version : compiler_version ; preinstalled : bool; src : url option ; patches : url list ; configure : string list ; make : string list ; build : command list ; packages : formula ; env : env_update list; tags : string list; } let empty = { opam_version = OpamVersion.current; name = ""; version = ""; src = None; preinstalled = false; patches = []; configure = []; make = []; build = []; packages = OpamFormula.Empty; env = []; tags = []; } let create_preinstalled name version packages env = let mk n = Atom (n, Empty) in let packages = OpamFormula.ands (List.map mk packages) in { empty with name; version; preinstalled = true; packages; env } let name (t:t) = t.name let version (t:t) = t.version let patches t = t.patches let configure t = t.configure let make t = t.make let build t = t.build let src t = t.src let opam_version t = t.opam_version let packages t = t.packages let preinstalled t = t.preinstalled let env (t:t) = List.map (function | var,op,value,None -> var, op, value, Some ("Updated by compiler " ^ t.name) | b -> b) t.env let tags t = t.tags let with_opam_version opam_version t = {t with opam_version} let with_name name (t:t) = {t with name} let with_version version (t:t) = {t with version} let with_src src t = { t with src } let with_patches patches t = {t with patches} let with_configure configure t = {t with configure} let with_make make t = {t with make} let with_build build t = {t with build} let with_packages packages t = {t with packages} let with_preinstalled preinstalled t = {t with preinstalled} let with_env env t = {t with env} let with_tags tags t = {t with tags} let fields = let with_src url t = if t.src <> None then Pp.bad_format "Too many URLS" else with_src (Some url) t in [ "opam-version", Pp.ppacc with_opam_version opam_version (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion)); "name", Pp.ppacc_opt with_name (fun t -> if t.name = empty.name then None else Some t.name) Pp.V.string; "version", Pp.ppacc_opt with_version (fun t -> if t.version = empty.version then None else Some t.version) Pp.V.string; "src", Pp.ppacc_opt with_src src Pp.V.url; "http", Pp.ppacc_opt with_src OpamStd.Option.none (Pp.V.url_with_backend `http); "archive", Pp.ppacc_opt with_src OpamStd.Option.none (Pp.V.url_with_backend `http); "git", Pp.ppacc_opt with_src OpamStd.Option.none (Pp.V.url_with_backend `git); "darcs", Pp.ppacc_opt with_src OpamStd.Option.none (Pp.V.url_with_backend `darcs); "hg", Pp.ppacc_opt with_src OpamStd.Option.none (Pp.V.url_with_backend `hg); "local", Pp.ppacc_opt with_src OpamStd.Option.none (Pp.V.url_with_backend `rsync); "patches", Pp.ppacc with_patches patches (Pp.V.map_list ~depth:1 @@ Pp.V.url); "configure", Pp.ppacc with_configure configure (Pp.V.map_list ~depth:1 Pp.V.string); "make", Pp.ppacc with_make make (Pp.V.map_list ~depth:1 Pp.V.string); "build", Pp.ppacc with_build build (Pp.V.map_list ~depth:1 Pp.V.command); "packages", Pp.ppacc with_packages packages (Pp.V.package_formula `Conj (Pp.V.constraints Pp.V.version)); "env", Pp.ppacc with_env env (Pp.V.map_list ~depth:2 Pp.V.env_binding); "preinstalled", Pp.ppacc_opt with_preinstalled (fun t -> if t.preinstalled then Some true else None) Pp.V.bool; "tags", Pp.ppacc with_tags tags (Pp.V.map_list ~depth:1 Pp.V.string); ] let system_compiler = "system" let version_of_name name = match OpamStd.String.cut_at name '+' with | Some (v,_) -> v | None -> name let pp_raw = let name = internal in Pp.I.map_file @@ Pp.I.check_opam_version () -| Pp.I.fields ~name ~empty fields -| Pp.I.show_errors ~name () -| Pp.check ~errmsg:"fields 'build:' and 'configure:'+'make:' are mutually \ exclusive " (fun t -> t.build = [] || t.configure = [] && t.make = []) let of_filename f = if OpamFilename.check_suffix f ".comp" then f |> OpamFilename.chop_extension |> OpamFilename.basename |> OpamFilename.Base.to_string |> fun x -> Some x else None let pp = pp_raw -| Pp.pp (fun ~pos (filename, (t:t)) -> filename, match of_filename filename with | None -> if t.name = empty.name || t.name <> "system" && t.version = empty.version then Pp.bad_format ~pos "File name not in the form ., and missing 'name:' \ or 'version:' fields" else Pp.warn ~pos ".comp file name not in the form ."; t | Some name -> let version = if name = "system" then t.version else version_of_name name in if t.name <> empty.name && t.name <> name then Pp.warn ~pos "Mismatching file name and 'name:' field"; if name <> system_compiler && t.version <> empty.version && t.version <> version then Pp.warn ~pos "Mismatching file name and 'version:' field"; {t with name; version}) (fun (filename, t) -> filename, match of_filename filename with | None -> if t.name = empty.name || t.name <> system_compiler && t.version = empty.version then OpamConsole.warning "Outputting .comp file %s with unspecified name or version" (OpamFilename.to_string filename); t | Some name -> let version = if name = system_compiler then t.version else version_of_name name in if t.name <> empty.name && t.name <> name || name <> system_compiler && t.version <> empty.version && t.version <> version then OpamConsole.warning "Skipping inconsistent 'name:' or 'version:' fields (%s.%s) \ while saving %s" t.name version (OpamFilename.to_string filename); { t with name = empty.name }) let to_package ?package comp descr_opt = let package = match package with | Some p -> p | None -> OpamPackage.create (OpamPackage.Name.of_string "ocaml") (OpamPackage.Version.of_string (name comp)) in let nofilter x = x, (None: filter option) in let depends = OpamFormula.map (fun (n, formula) -> let cstr (op, v) = OpamFormula.ands [ Atom (Constraint (op, FString (OpamPackage.Version.to_string v))); ] in let post_flag = Filter (FIdent ([], OpamVariable.of_string "post", None)) in Atom (n, OpamFormula.ands [OpamFormula.map cstr formula; Atom post_flag])) (OpamFormula.ands [ Atom (OpamPackage.Name.of_string "ocaml", Atom (`Eq, OpamPackage.Version.of_string comp.version)); comp.packages ]) in let url = OpamStd.Option.map (fun url -> URL.with_url url URL.empty) comp.src in let build, install = match comp.build with | [] -> List.map (fun l -> nofilter (List.map nofilter l)) [ (List.map (fun s -> CString s) ("./configure" :: configure comp )) @ [ CString "-prefix"; CIdent "prefix" ]; CIdent "make" :: List.map (fun s -> CString s) (make comp); ], List.map (fun l -> nofilter (List.map nofilter l)) [ [ CIdent "make"; CString "install" ]; ] | cl -> match List.rev cl with | install::cl -> List.rev cl, [install] | [] -> assert false in let extra_sources = List.map (fun url -> OpamFilename.Base.of_string (OpamUrl.basename url), URL.create url) comp.patches in let patches = List.map (fun u -> nofilter (OpamFilename.Base.of_string (OpamUrl.basename u))) comp.patches in let pkg = OPAM.create package in { pkg with OPAM. depends; build; install; maintainer = [ "platform@lists.ocaml.org" ]; extra_sources; patches; env = comp.env; flags = [Pkgflag_Compiler]; url; descr = descr_opt; } end module Comp = struct include CompSyntax include SyntaxFile(CompSyntax) end opam-2.0.5/src/format/opamPath.ml0000644000175000017500000001557013511367404015650 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamFilename.Op type t = dirname (* Returns a generic file, coerced by the .mli *) let ( /- ) dir f = OpamFile.make (dir // f) let config t = t /- "config" let init_config_files () = List.map OpamFile.make [ OpamFilename.Dir.of_string (OpamStd.Sys.etc ()) // "opamrc"; OpamFilename.Dir.of_string (OpamStd.Sys.home ()) // ".opamrc"; ] let state_cache t = t / "repo" // "state.cache" let lock t = t // "lock" let config_lock t = t // "config.lock" let archives_dir t = t / "archives" let archive t nv = archives_dir t // (OpamPackage.to_string nv ^ "+opam.tar.gz") let repos_lock t = t / "repo" // "lock" let repos_config t = t / "repo" /- "repos-config" let init t = t / "opam-init" let hooks_dir t = init t / "hooks" let log t = t / "log" let backup_file = let file = lazy Unix.( let tm = gmtime (Unix.gettimeofday ()) in Printf.sprintf "state-%04d%02d%02d%02d%02d%02d.export" (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec ) in fun () -> Lazy.force file let backup_dir t = t / "backup" let backup t = backup_dir t /- backup_file () let plugins t = t / "plugins" let plugins_bin t = plugins t / "bin" let plugin_bin t name = let sname = OpamPackage.Name.to_string name in let basename = if OpamStd.String.starts_with ~prefix:"opam-" sname then sname else "opam-" ^ sname in plugins_bin t // basename let plugin t name = let sname = OpamPackage.Name.to_string name in assert (sname <> "bin"); plugins t / sname module Switch = struct let root t a = OpamSwitch.get_root t a (** Internal files and dirs with static location *) let meta_dirname = ".opam-switch" let meta t a = root t a / meta_dirname let lock t a = meta t a // "lock" let backup_dir t a = meta t a / "backup" let backup t a = backup_dir t a /- backup_file () let selections t a = meta t a /- "switch-state" let build_dir t a = meta t a / "build" let build t a nv = build_dir t a / OpamPackage.to_string nv let remove_dir t a = meta t a / "remove" let remove t a nv = remove_dir t a / OpamPackage.to_string nv let install_dir t a = meta t a / "install" let install t a n = install_dir t a /- (OpamPackage.Name.to_string n ^ ".install") let changes t a n = install_dir t a /- (OpamPackage.Name.to_string n ^ ".changes") let reinstall t a = meta t a /- "reinstall" let switch_config t a = meta t a /- "switch-config" let config_dir t a = meta t a / "config" let config t a n = config_dir t a /- (OpamPackage.Name.to_string n ^ ".config") let sources_dir t a = meta t a / "sources" let sources t a nv = sources_dir t a / OpamPackage.to_string nv let pinned_package t a name = sources_dir t a / OpamPackage.Name.to_string name let env_filename = "environment" let environment t a = meta t a /- env_filename let env_relative_to_prefix pfx = pfx / meta_dirname /- env_filename let installed_opams t a = meta t a / "packages" let installed_package_dir t a nv = installed_opams t a / OpamPackage.to_string nv let installed_opam t a nv = installed_package_dir t a nv /- "opam" let installed_opam_files_dir t a nv = installed_package_dir t a nv / "files" module Default = struct (** Visible files that can be redirected using [config/global-config.config] *) let lib_dir t a = root t a / "lib" let lib t a n = lib_dir t a / OpamPackage.Name.to_string n let stublibs t a = lib_dir t a / "stublibs" let toplevel t a = lib_dir t a / "toplevel" let doc_dir t a = root t a / "doc" let man_dir ?num t a = match num with | None -> root t a / "man" | Some n -> root t a / "man" / ("man" ^ n) let share_dir t a = root t a / "share" let share t a n = share_dir t a / OpamPackage.Name.to_string n let etc_dir t a = root t a / "etc" let etc t a n = etc_dir t a / OpamPackage.Name.to_string n let doc t a n = doc_dir t a / OpamPackage.Name.to_string n let bin t a = root t a / "bin" let sbin t a = root t a / "sbin" end let lookup stdpath relative_to default config = let dir = OpamStd.Option.default default (OpamFile.Switch_config.path config stdpath) in if Filename.is_relative dir then if dir = "" then relative_to else relative_to / dir else OpamFilename.Dir.of_string dir let prefix t a c = lookup Prefix (root t a) "" c let lib_dir t a c = lookup Lib (prefix t a c) "lib" c let lib t a c n = lib_dir t a c / OpamPackage.Name.to_string n let stublibs t a c = lookup Stublibs (lib_dir t a c) "stublibs" c let toplevel t a c = lookup Toplevel (lib_dir t a c) "toplevel" c let doc_dir t a c = lookup Doc (prefix t a c) "doc" c let doc t a c n = doc_dir t a c / OpamPackage.Name.to_string n let man_dir ?num t a c = let base = lookup Man (prefix t a c) "man" c in match num with | None -> base | Some n -> base / ("man" ^ n) let share_dir t a c = lookup Share (prefix t a c) "share" c let share t a c n = share_dir t a c / OpamPackage.Name.to_string n let etc_dir t a c = lookup Etc (prefix t a c) "etc" c let etc t a c n = etc_dir t a c / OpamPackage.Name.to_string n let bin t a c = lookup Bin (prefix t a c) "bin" c let sbin t a c = lookup Sbin (prefix t a c) "sbin" c let get_stdpath t a c = function | Prefix -> prefix t a c | Lib -> lib_dir t a c | Bin -> bin t a c | Sbin -> sbin t a c | Share -> share_dir t a c | Doc -> doc_dir t a c | Etc -> etc_dir t a c | Man -> man_dir t a c | Toplevel -> toplevel t a c | Stublibs -> stublibs t a c module Overlay = struct let dir t a = meta t a / "overlay" let package t a n = dir t a / OpamPackage.Name.to_string n let opam t a n = package t a n /- "opam" let tmp_opam t a n = package t a n /- "opam_" let url t a n = package t a n /- "url" let descr t a n = package t a n /- "descr" let files t a n = package t a n / "files" end end module Builddir = struct let install builddir nv = builddir /- (OpamPackage.Name.to_string nv.name ^ ".install") let config builddir nv = builddir /- (OpamPackage.Name.to_string nv.name ^ ".config") end opam-2.0.5/src/format/opamFormula.mli0000644000175000017500000001744213511367404016532 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Formulas on packages, opt. with sub-formulas on versions, and conversion functions *) (** binary operations (compatible with the Dose type for Cudf operators!) *) type relop = OpamParserTypes.relop (* = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] *) (** Version constraints for OPAM *) type version_constraint = relop * OpamPackage.Version.t (** Formula atoms for OPAM *) type atom = OpamPackage.Name.t * version_constraint option (** Pretty-printing of atoms *) val string_of_atom: atom -> string (** The compact atom format used in requests, "pkgOPvers", with '.' allowed instead of '=' *) val short_string_of_atom: atom -> string (** Prints atoms as a conjunction ("&") using the short format *) val string_of_atoms: atom list -> string (** Checks if a package verifies an atom *) val check: atom -> OpamPackage.t -> bool (** Return all packages satisfying the given atoms from a set (i.e. name matching at least one of the atoms, version matching all atoms with the appropriate name) *) val packages_of_atoms: OpamPackage.Set.t -> atom list -> OpamPackage.Set.t (** AND formulas *) type 'a conjunction = 'a list (** Pretty print AND formulas *) val string_of_conjunction: ('a -> string) -> 'a conjunction -> string (** OR formulas *) type 'a disjunction = 'a list (** Pretty print OR formulas *) val string_of_disjunction: ('a -> string) -> 'a disjunction -> string (** CNF formulas (Conjunctive Normal Form) *) type 'a cnf = 'a disjunction conjunction (** DNF formulas (Disjunctive Normal Form) *) type 'a dnf = 'a conjunction disjunction (** Pretty print CNF formulas *) val string_of_cnf: ('a -> string) -> 'a cnf -> string (** Pretty print DNF formulas *) val string_of_dnf: ('a -> string) -> 'a dnf -> string (** General formulas *) type 'a formula = | Empty | Atom of 'a | Block of 'a formula | And of 'a formula * 'a formula | Or of 'a formula * 'a formula (** Eval a formula *) val eval: ('a -> bool) -> 'a formula -> bool val partial_eval: ('a -> [ `Formula of 'b formula | `True | `False ]) -> 'a formula -> [ `Formula of 'b formula | `True | `False ] (** Check a relational operator against an integer from compare *) val check_relop: relop -> int -> bool (** Evaluate a relational operator between versions *) val eval_relop: relop -> OpamPackage.Version.t -> OpamPackage.Version.t -> bool val neg_relop: relop -> relop (** Pretty print a formula *) val string_of_formula: ('a -> string) -> 'a formula -> string (** Convert a list of formulas to an AND-formula ([Empty] formulas are ignored) *) val ands: 'a formula list -> 'a formula (** Converts back an AND-formula to a list (flattens top-level ands) *) val ands_to_list: 'a formula -> 'a formula list (** Convert a list of formulas to an OR-formula ([Empty] formulas are ignored) *) val ors: 'a formula list -> 'a formula (** Converts back an OR-formula to a list (flattens top-level ors) *) val ors_to_list: 'a formula -> 'a formula list (** Map on atoms. Atoms for which the given function returns Empty will be simply removed *) val map: ('a -> 'b formula) -> 'a formula -> 'b formula (** Maps top-down on a formula *) val map_formula: ('a formula -> 'a formula) -> 'a formula -> 'a formula (** Maps bottom-up on a formula (atoms first) *) val map_up_formula: ('a formula -> 'a formula) -> 'a formula -> 'a formula (** Negates a formula (given the function to negate atoms) *) val neg: ('a -> 'a) -> 'a formula -> 'a formula (** Iter function *) val iter: ('a -> unit) -> 'a formula -> unit (** Fold function (bottom-up, left-to-right) *) val fold_left: ('a -> 'b -> 'a) -> 'a -> 'b formula -> 'a (** Fold function (bottom-up, right-to-left) *) val fold_right: ('a -> 'b -> 'a) -> 'a -> 'b formula -> 'a (** Expressions composed entirely of version constraints *) type version_formula = version_constraint formula (** Checks if a given version satisfies a formula *) val check_version_formula: version_formula -> OpamPackage.Version.t -> bool (** An atom is: [name] * ([relop] * [version]) formula. Examples of valid formulae: - "foo" \{> "1" & (<"3" | ="5")\} - "foo" \{= "1" | > "4"\} | ("bar" "bouh") *) type t = (OpamPackage.Name.t * version_formula) formula (** Returns [true] if [package] verifies [formula] (i.e. it is within at least one package set that is a solution of the formula, and is named in the formula) *) val verifies: t -> OpamPackage.t -> bool (** Returns the subset of packages possibly matching the formula (i.e. including all disjunction cases) *) val packages: OpamPackage.Set.t -> t -> OpamPackage.Set.t (** Convert a formula to CNF *) val cnf_of_formula: 'a formula -> 'a formula (** Convert a formula to DNF *) val dnf_of_formula: 'a formula -> 'a formula (** Transform a formula where versions can be expressed using formulas to a flat atom formula *) val to_atom_formula: t -> atom formula (** Convert an atom-formula to a t-formula *) val of_atom_formula: atom formula -> t (** [simplify_ineq_formula comp f] returns a canonical version of inequality formula [f], based on comparison function [comp], where each version appears at most once, and in increasing order. Returns [Some Empty] if the formula is always [true], [None] if it is always false *) val simplify_ineq_formula: ('a -> 'a -> int) -> (relop * 'a) formula -> (relop * 'a) formula option (** Like [simplify_ineq_formula], but specialised on version formulas *) val simplify_version_formula: version_formula -> version_formula option (** A more aggressive version of [simplify_version_formula] that attempts to find a shorter formula describing the same subset of versions within a given set. The empty formula is returned for an empty set, and the original formula is otherwise returned as is if no versions match. *) val simplify_version_set: OpamPackage.Version.Set.t -> version_formula -> version_formula (** [formula_of_version_set set subset] generates a formula that is enough to describe all packages of [subset] and exclude packages otherwise in [set] *) val formula_of_version_set: OpamPackage.Version.Set.t -> OpamPackage.Version.Set.t -> version_formula (** {2 Atoms} *) (** Return all the atoms *) val atoms: t -> atom list (** Pretty print the formula *) val to_string: t -> string (** Return a conjunction. If the initial formula is not a conjunction, then fail. *) val to_conjunction: t -> atom conjunction (** Return a formula from a conjunction of atoms *) val of_conjunction: atom conjunction -> t (** Return a disjunction of atoms from a package formula. It the initial formula is not a disjunction, then fail. *) val to_disjunction: t -> atom disjunction (** Like [to_disjunction], but accepts conjunctions within constraint formulas, resolving them using the provided package set. Conjunctions between packages still raise [Failure]. *) val set_to_disjunction: OpamPackage.Set.t -> t -> atom disjunction (** Return a formula from a disjunction of atoms *) val of_disjunction: atom disjunction -> t (** Return an equivalent CNF formula *) val to_cnf: t -> atom cnf (** Return an equivalent DNF formula *) val to_dnf: t -> atom dnf opam-2.0.5/src/format/opamRepositoryName.ml0000644000175000017500000000150513511367404017725 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include OpamStd.AbstractString let default = of_string "default" opam-2.0.5/src/format/opamFile.mli0000644000175000017500000007226313511367404016006 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Handles all OPAM file formats as record types and submodules, conversion to and from syntax *) open OpamTypes (** Functions to read and write OPAM configuration files in a typed way *) (** Associate a type to a filename through a phantom type *) type 'a t = private filename type 'a typed_file = 'a t val make: filename -> 'a t val filename: 'a t -> filename val to_string: 'a t -> string val exists: 'a t -> bool (** All Configuration files satisfy this signature *) module type IO_FILE = sig (** File contents *) type t (** Empty file *) val empty: t (** Write some contents to a file *) val write: t typed_file -> t -> unit (** Read file contents. Raise an error if the file does not exist. *) val read: t typed_file -> t (** Returns [None] on non-existing file *) val read_opt: t typed_file -> t option (** Read file contents. Return [empty] if the file does not exist. *) val safe_read: t typed_file -> t val read_from_channel: ?filename:t typed_file -> in_channel -> t val read_from_string: ?filename:t typed_file -> string -> t val write_to_channel: ?filename:t typed_file -> out_channel -> t -> unit val write_to_string: ?filename:t typed_file -> t -> string end (** Lines of space-separated words. *) module Lines: IO_FILE with type t = string list list (** Command wrappers for package scripts *) module Wrappers: sig type t = { pre_build : command list; wrap_build : command list; post_build : command list; pre_install : command list; wrap_install : command list; post_install : command list; pre_remove : command list; wrap_remove : command list; post_remove : command list; pre_session : command list; post_session : command list; } val pre_build: t -> command list val wrap_build: t -> command list val post_build: t -> command list val pre_install: t -> command list val wrap_install: t -> command list val post_install: t -> command list val pre_remove: t -> command list val wrap_remove: t -> command list val post_remove: t -> command list val pre_session: t -> command list val post_session: t -> command list val empty : t val add: outer:t -> inner:t -> t end (** Configuration file: [$opam/config] *) module Config: sig include IO_FILE (** OCaml switch updates *) val with_switch: switch -> t -> t val with_switch_opt: switch option -> t -> t val with_installed_switches: switch list -> t -> t (** Repository updates *) val with_repositories: repository_name list -> t -> t (** Update opam-version *) val with_opam_version: OpamVersion.t -> t -> t val with_criteria: (solver_criteria * string) list -> t -> t val with_best_effort_prefix: string -> t -> t val with_solver: arg list -> t -> t val with_solver_opt: arg list option -> t -> t val with_jobs: int -> t -> t val with_dl_tool: arg list -> t -> t val with_dl_tool_opt: arg list option -> t -> t val with_dl_jobs: int -> t -> t val with_dl_cache: url list -> t -> t val with_wrappers: Wrappers.t -> t -> t val with_global_variables: (variable * variable_contents * string) list -> t -> t val with_eval_variables: (variable * string list * string) list -> t -> t val with_validation_hook_opt: arg list option -> t -> t val with_default_compiler: formula -> t -> t (** Return the OPAM version *) val opam_version: t -> opam_version (** Return the list of repository *) val repositories: t -> repository_name list (** Return the OCaml switch *) val switch: t -> switch option val installed_switches: t -> switch list (** Return the number of jobs *) val jobs: t -> int val dl_tool: t -> arg list option (** Return the number of download jobs *) val dl_jobs: t -> int val dl_cache: t -> url list val criteria: t -> (solver_criteria * string) list val best_effort_prefix: t -> string option val solver: t -> arg list option val wrappers: t -> Wrappers.t (** variable, value, docstring *) val global_variables: t -> (variable * variable_contents * string) list (** variable, command, docstring *) val eval_variables: t -> (variable * string list * string) list val validation_hook: t -> arg list option val default_compiler: t -> formula end (** Init config file [/etc/opamrc] *) module InitConfig: sig include IO_FILE val opam_version: t -> opam_version val repositories: t -> (repository_name * (url * trust_anchors option)) list val default_compiler: t -> formula val jobs: t -> int option val dl_tool: t -> arg list option val dl_jobs: t -> int option val dl_cache: t -> url list val solver_criteria: t -> (solver_criteria * string) list val solver: t -> arg list option val wrappers: t -> Wrappers.t val global_variables: t -> (variable * variable_contents * string) list val eval_variables: t -> (variable * string list * string) list val recommended_tools: t -> (string list * string option * filter option) list val required_tools: t -> (string list * string option * filter option) list val init_scripts: t -> ((string * string) * filter option) list val with_opam_version: opam_version -> t -> t val with_repositories: (repository_name * (url * trust_anchors option)) list -> t -> t val with_default_compiler: formula -> t -> t val with_jobs: int option -> t -> t val with_dl_tool: arg list option -> t -> t val with_dl_jobs: int option -> t -> t val with_dl_cache: url list -> t -> t val with_solver_criteria: (solver_criteria * string) list -> t -> t val with_solver: arg list option -> t -> t val with_wrappers: Wrappers.t -> t -> t val with_global_variables: (variable * variable_contents * string) list -> t -> t val with_eval_variables: (variable * string list * string) list -> t -> t val with_recommended_tools: (string list * string option * filter option) list -> t -> t val with_required_tools: (string list * string option * filter option) list -> t -> t val with_init_scripts: ((string * string) * filter option) list -> t -> t (** [add t1 t2] is [t2], with the field values falling back to those of [t1] when not set in [t2] *) val add: t -> t -> t end (** Package descriptions: [$opam/descr/] *) module Descr: sig include IO_FILE val create: string -> t (** Create an abstract description file from a string *) val of_string: t typed_file -> string -> t (** Return the first line *) val synopsis: t -> string (** Return the body *) val body: t -> string (** Return the full description *) val full: t -> string end (** {2 Urls for OPAM repositories} *) module URL: sig include IO_FILE val create: ?mirrors:url list -> ?checksum:OpamHash.t list -> url -> t (** URL address *) val url: t -> url val mirrors: t -> url list (** Archive checksum *) val checksum: t -> OpamHash.t list (** Constructor *) val with_checksum: OpamHash.t list -> t -> t end (** OPAM files *) module OPAM: sig type t = private { opam_version: opam_version; (* Package ident *) name : name option; version : version option; (* Relationships; solver and availability info *) depends : filtered_formula; depopts : filtered_formula; conflicts : filtered_formula; conflict_class : name list; available : filter; flags : package_flag list; env : env_update list; (* Build instructions *) build : command list; run_test : command list; install : command list; remove : command list; (* Auxiliary data affecting the build *) substs : basename list; patches : (basename * filter option) list; build_env : env_update list; features : (OpamVariable.t * filtered_formula * string) list; extra_sources: (basename * URL.t) list; (* User-facing data used by opam *) messages : (string * filter option) list; post_messages: (string * filter option) list; depexts : (string list * filter) list; libraries : (string * filter option) list; syntax : (string * filter option) list; dev_repo : url option; pin_depends: (package * url) list; (* Package database details *) maintainer : string list; author : string list; license : string list; tags : string list; homepage : string list; doc : string list; bug_reports: string list; (* Extension fields (x-foo: "bar") *) extensions : (pos * value) OpamStd.String.Map.t; (* Extra sections *) url : URL.t option; descr : Descr.t option; (* Related metadata directory (not an actual field of the file) This can be used to locate e.g. the files/ overlays *) metadata_dir: dirname option; (* Names and hashes of the files below files/ *) extra_files: (OpamFilename.Base.t * OpamHash.t) list option; format_errors: (string * OpamPp.bad_format) list; (* Deprecated, for compat and proper linting *) ocaml_version: (OpamFormula.relop * string) OpamFormula.formula option; os : (bool * string) generic_formula; deprecated_build_test : command list; deprecated_build_doc : command list; } include IO_FILE with type t := t val empty: t (** Create an opam file *) val create: package -> t (** Returns the opam value (including url, descr) with all non-effective (i.e. user-directed information that doesn't change opam's view on the package) fields set to their empty values. Useful for comparisons. *) val effective_part: t -> t (** Returns true if the effective parts of the two package definitions are equal *) val effectively_equal: t -> t -> bool (** Compares two package definitions, ignoring the virtual fields bound to file location ([metadata_dir]...) *) val equal: t -> t -> bool (** Prints the format errors that were found when the file was read *) val print_errors: ?file:t typed_file -> t -> unit (** Get OPAM version. *) val opam_version: t -> opam_version (** Package name *) val name: t -> name val name_opt: t -> name option (** Package version *) val version: t -> version val version_opt: t -> version option (** The informations in both the name and version fields, as a package *) val package: t -> package (** Availability formula (OS + compiler constraints) *) val available: t -> filter (** Package maintainer(s) *) val maintainer: t -> string list (** File substitutions *) val substs: t -> basename list (** List of environment variables to set-up for the build *) val build_env: t -> env_update list (** List of command to run for building the package *) val build: t -> command list (** List of command to run for installing the package *) val install: t -> command list (** List of command to run for removing the package *) val remove: t -> command list (** Package dependencies *) val depends: t -> filtered_formula (** Optional dependencies *) val depopts: t -> filtered_formula (** External dependencies *) val depexts: t -> (string list * filter) list val extra_sources: t -> (basename * URL.t) list (** All extended "x-" fields as a map *) val extensions: t -> value OpamStd.String.Map.t (** Parse a single extended field (reports proper file position) *) val extended: t -> string -> (value -> 'a) -> 'a option val with_messages: (string * filter option) list -> t -> t val with_post_messages: (string * filter option) list -> t -> t (** Package conflicts *) val conflicts: t -> filtered_formula val conflict_class: t -> name list (** Contents of the 'features' field *) val features: t -> (OpamVariable.t * filtered_formula * string) list (** List of exported libraries *) val libraries: t -> (string * filter option) list (** List of exported syntax extensions *) val syntax: t -> (string * filter option) list (** Patches *) val patches: t -> (basename * filter option) list (** Homepage(s) *) val homepage: t -> string list (** Author(s) *) val author: t -> string list (** License(s) *) val license: t -> string list (** API documentation *) val doc: t -> string list (** Classification tags *) val tags: t -> string list (** Commands to build and run the tests *) val run_test: t -> command list (** Commands to build the documentation *) val deprecated_build_doc: t -> command list (** Commands to build the tests *) val deprecated_build_test: t -> command list (** Messages to display before taking action *) val messages: t -> (string * filter option) list (** Messages to display at end of install *) val post_messages: t -> (string * filter option) list (** Where to post bug reports. *) val bug_reports: t -> string list (** The package flags that are present for this package. *) val flags: t -> package_flag list (** Check the package for the given flag. Allows flags specified through tags for compatibility *) val has_flag: package_flag -> t -> bool (** The environment variables that this package exports *) val env: t -> env_update list val descr: t -> Descr.t option val synopsis: t -> string option val descr_body: t -> string option val url: t -> URL.t option val get_url: t -> url option (** Related metadata directory (not an actual field of the file, linked to the file location). This can be used to locate e.g. the files/ overlays *) val metadata_dir: t -> dirname option (** Names and hashes of the files below files/ *) val extra_files: t -> (OpamFilename.Base.t * OpamHash.t) list option (** Looks up the extra files, and returns their full paths, relative path to the package source, and hash. Doesn't check the hashes. *) val get_extra_files: t -> (filename * basename * OpamHash.t) list (** Returns the errors that were found when parsing the file, associated to their fields (that were consequently ignored) *) val format_errors: t -> (string * OpamPp.bad_format) list (** Sets the opam version *) val with_opam_version: opam_version -> t -> t (** The package source repository address *) val dev_repo: t -> url option val pin_depends: t -> (package * url) list (** construct as [name] *) val with_name: name -> t -> t val with_name_opt: name option -> t -> t (** construct as [version] *) val with_version: version -> t -> t val with_version_opt: version option -> t -> t (** Construct as [depends] *) val with_depends: filtered_formula -> t -> t (** Construct as [depopts] *) val with_depopts: filtered_formula -> t -> t val with_conflicts: filtered_formula -> t -> t val with_conflict_class: name list -> t -> t val with_features: (OpamVariable.t * filtered_formula * string) list -> t -> t (** Construct as [build] *) val with_build: command list -> t -> t val with_run_test: command list -> t -> t val with_install: command list -> t -> t (** Construct as [remove] *) val with_remove: command list -> t -> t (** Construct as [libraries] *) val with_libraries: (string * filter option) list -> t -> t (** Replace the [syntax] field of the given OPAM file. *) val with_syntax: (string * filter option) list -> t -> t (** Construct as [substs] *) val with_substs: basename list -> t -> t val with_build_env: env_update list -> t -> t val with_available: filter -> t -> t (** Construct as [maintainer] *) val with_maintainer: string list -> t -> t val with_author: string list -> t -> t val with_homepage: string list -> t -> t val with_license: string list -> t -> t (** Construct as [patches] *) val with_patches: (basename * filter option) list -> t -> t (** Construct using [bug_reports] *) val with_bug_reports: string list -> t -> t (** Construct using [depexts] *) val with_depexts: (string list * filter) list -> t -> t val with_flags: package_flag list -> t -> t val add_flags: package_flag list -> t -> t val with_tags: string list -> t -> t val with_env: env_update list -> t -> t val with_dev_repo: url -> t -> t val with_dev_repo_opt: url option -> t -> t val with_pin_depends: (package * url) list -> t -> t val with_extra_sources: (basename * URL.t) list -> t -> t val with_extensions: value OpamStd.String.Map.t -> t -> t val add_extension: t -> string -> value -> t val with_deprecated_build_doc: command list -> t -> t val with_deprecated_build_test: command list -> t -> t val with_descr: Descr.t -> t -> t val with_descr_opt: Descr.t option -> t -> t val with_synopsis: string -> t -> t (** If [synopsis] is not already set, split the string and use the first line as synopsis. *) val with_descr_body: string -> t -> t val with_url: URL.t -> t -> t val with_url_opt: URL.t option -> t -> t val with_metadata_dir: dirname option -> t -> t val with_extra_files: (OpamFilename.Base.t * OpamHash.t) list -> t -> t val with_extra_files_opt: (OpamFilename.Base.t * OpamHash.t) list option -> t -> t val with_format_errors: (string * OpamPp.bad_format) list -> t -> t (** Prints to a string, while keeping the format of the original file as much as possible. The original format is read from the given [format_from_string], the file [format_from], or the output file if it exists *) val to_string_with_preserved_format: ?format_from:(t typed_file) -> ?format_from_string:string -> t typed_file -> t -> string (** Writes an opam file, but preserving the existing formatting as much as possible. The original format is read from the given [format_from_string], the file [format_from], or the output file if it exists *) val write_with_preserved_format: ?format_from:(t typed_file) -> ?format_from_string:string -> t typed_file -> t -> unit (** Low-level values used for linting and similar processing *) (** Allow 'flag:xxx' tags as flags, for compat *) val flag_of_tag: string -> package_flag option val fields: (t, value) OpamFormat.I.fields_def val sections: (t, (string option * opamfile_item list) list) OpamFormat.I.fields_def (** Doesn't handle package name encoded in directory name *) val pp_raw_fields: (opamfile_item list, t) OpamPp.t (** Returns the raw print-AST contents of the file *) val contents: ?filename:'a typed_file -> t -> opamfile (** Returns all fields of the file as print-AST. Fields within sections are accessed through dot-separated paths (e.g. [url.checksum]) *) val to_list: ?filename:'a typed_file -> t -> (string * value) list (** Gets the print-AST for a single field in the file structure. Fields within sections can be accessed through [section.field]. *) val print_field_as_syntax: string -> t -> value option end (** Compiler aliases: [$opam/aliases]. Deprecated, used only for migration *) module Aliases: IO_FILE with type t = string switch_map (** Switch state file as table, also used for import/export. This includes compiler and root packages information, as well as pinned packages and their target (but not their local metadata). *) module LegacyState: sig type t = switch_selections include IO_FILE with type t := t end (** A newer format for switch state, using the opam file syntax rather than a table. This is more readable and extensible. *) module SwitchSelections: sig type t = switch_selections include IO_FILE with type t := t end (** An extended version of SwitchSelections that can include full opam files as [package "name" {}] sections, for storing overlays *) module SwitchExport: sig type t = { selections: switch_selections; overlays: OPAM.t OpamPackage.Name.Map.t; } include IO_FILE with type t := t end (** A simple list of packages and versions: (used for the older [$opam/$switch/{installed,installed_roots}], still needed to migrate from 1.2 repository, and for reinstall) *) module PkgList: IO_FILE with type t = package_set (** Cached environment updates (/environment) *) module Environment: IO_FILE with type t = env_update list (** Compiler version [$opam/compilers/]. Deprecated, only used to upgrade old data *) module Comp: sig include IO_FILE type compiler = string type compiler_version = string (** Create a pre-installed compiler description file *) val create_preinstalled: compiler -> compiler_version -> name list -> env_update list -> t (** Is it a pre-installed compiler description file *) val preinstalled: t -> bool (** Get OPAM version *) val opam_version: t -> opam_version (** Return the compiler name *) val name: t -> compiler (** Return the compiler version *) val version: t -> compiler_version (** Return the url of the compiler *) val src: t -> url option (** Return the list of patches to apply *) val patches: t -> url list (** Options to give to the "./configure" command *) val configure: t -> string list (** Options to give to the "make" command *) val make: t -> string list (** Options to give to build the package. If this one is provided, nothing should be specified for [configure] and [make]. *) val build: t -> command list (** Packages to install immediately after the creation of OCaml *) val packages: t -> formula (** Environment variable to set-up before running commands in the subtree *) val env: t -> env_update list val tags: t -> string list val with_src: url option -> t -> t val with_patches: url list -> t -> t val with_configure: string list -> t -> t val with_make: string list -> t -> t val with_build: command list -> t -> t val with_packages: formula -> t -> t (** Converts a compiler definition to package metadata. For compat. If [package] is unspecified, a package named "ocaml" is created for "standard" compilers (when the compiler name doesn't contain a "+" and is equal to the compiler version); otherwise, a package "ocaml-VARIANT" is created with "VARIANT" the part of the compiler name on the right of the "+". In both case, the version corresponds to the OCaml version and is [version comp]. *) val to_package: ?package:package -> t -> Descr.t option -> OPAM.t end (** {2 Configuration files} *) (** .install files *) module Dot_install: sig include IO_FILE (** List of files to install in $bin/ *) val bin: t -> (basename optional * basename option) list (** List of files to install in $sbin/ *) val sbin: t -> (basename optional * basename option) list (** List of files to install in $lib/ *) val lib: t -> (basename optional * basename option) list (** List of toplevel files *) val toplevel: t -> (basename optional * basename option) list (** C bindings *) val stublibs: t -> (basename optional * basename option) list (** List of architecture-independent files *) val share: t -> (basename optional * basename option) list (** List of files under the more general share prefix *) val share_root: t -> (basename optional * basename option) list (** List of etc files *) val etc: t -> (basename optional * basename option) list (** List of doc files *) val doc: t -> (basename optional * basename option) list (** Man pages *) val man: t -> (basename optional * basename option) list (** Executable files under lib/ *) val libexec: t -> (basename optional * basename option) list (** Not relative to the package's lib dir *) val lib_root: t -> (basename optional * basename option) list (** Not relative to the package's lib dir, and with +x set *) val libexec_root: t -> (basename optional * basename option) list (** List of other files to install *) val misc: t -> (basename optional * filename) list end (** .changes files, bound to the OpamDirTrack module *) module Changes: sig type t = OpamDirTrack.t include IO_FILE with type t := t end (** .config files *) module Dot_config: sig include IO_FILE (** Create a new .config file (containing only variables) *) val create: (variable * variable_contents) list -> t (** Dependency towards file-system paths and their hashes *) val file_depends: t -> (filename * OpamHash.t) list val with_file_depends: (filename * OpamHash.t) list -> t -> t (** Sets all bindings in the file *) val with_vars: (variable * variable_contents) list -> t -> t (** Top-level variables *) val variable: t -> variable -> variable_contents option (** The list of top-level variables *) val variables: t -> variable list (** Lists all the variable bindings in the file *) val bindings: t -> (variable * variable_contents) list (** Sets the given variable, overriding any previous definition. With [None], unsets the variable*) val set: variable -> variable_contents option -> t -> t end (** {2 Repository files} *) (** Association between package names and repositories *) module Package_index: IO_FILE with type t = (repository_name * string option) package_map (** Repository config: [$opam/repo/$repo/config]. Deprecated, for migration only *) module Repo_config_legacy : sig type t = { repo_name : repository_name; repo_root : dirname; repo_url : url; repo_priority : int; } include IO_FILE with type t := t end module Repos_config: IO_FILE with type t = (url * trust_anchors option) option OpamRepositoryName.Map.t module Switch_config: sig type t = { opam_version: OpamVersion.t; synopsis: string; repos: repository_name list option; paths: (std_path * string) list; variables: (variable * variable_contents) list; opam_root: dirname option; wrappers: Wrappers.t; env: env_update list; } val variable: t -> variable -> variable_contents option val path: t -> std_path -> string option val wrappers: t -> Wrappers.t include IO_FILE with type t := t end (** Pinned package files (only used for migration from 1.2, the inclusive State module is now used instead) *) module Pinned_legacy: sig type pin_option = | Version of version | Source of url include IO_FILE with type t = pin_option name_map end (** Repository metadata *) module Repo: sig include IO_FILE val create: ?browse:string -> ?upstream:string -> ?opam_version:OpamVersion.t -> ?redirect:(string * filter option) list -> ?root_url:url -> ?dl_cache:string list -> ?announce:(string * filter option) list -> ?stamp:string -> unit -> t (** The minimum OPAM version required for this repository, if defined *) val opam_version : t -> OpamVersion.t option (** Base URL for browsing packages on the WWW *) val browse: t -> string option (** Base URL for browsing OPAM repository source on the WWW *) val upstream: t -> string option (** The root URL of the repository (not an actual file field, determined at runtime by opam) *) val root_url: t -> url option (** Redirections. *) val redirect: t -> (string * filter option) list (** Cache URLs, either full or relative to the repo root *) val dl_cache: t -> string list val announce: t -> (string * filter option) list val stamp: t -> string option val with_opam_version : OpamVersion.t -> t -> t val with_browse: string -> t -> t val with_upstream: string -> t -> t val with_redirect: (string * filter option) list -> t -> t val with_root_url: url -> t -> t val with_dl_cache: string list -> t -> t val with_announce: (string * filter option) list -> t -> t val with_stamp: string -> t -> t val with_stamp_opt: string option -> t -> t end (** {2 urls.txt file *} *) module File_attributes: IO_FILE with type t = file_attribute_set module Stats: sig (** Display statistics about file access. *) val print: unit -> unit end (** Helper module for manipulation of the raw syntax ([opamfile]) format. (the specific file handling modules are derived from this one) *) module Syntax : sig val pp_channel: 'a typed_file -> in_channel -> out_channel -> (unit, opamfile) OpamPp.t val of_channel: 'a typed_file -> in_channel -> opamfile val to_channel: 'a typed_file -> out_channel -> opamfile -> unit val of_string: 'a typed_file -> string -> opamfile val to_string: 'a typed_file -> opamfile -> string val to_string_with_preserved_format: 'a typed_file -> ?format_from:'a typed_file -> ?format_from_string:string -> empty:'a -> ?sections:('a, (string option * opamfile_item list) list) OpamFormat.I.fields_def -> fields:('a, value) OpamFormat.I.fields_def -> (opamfile, filename * 'a) OpamPp.t -> 'a -> string end (**/**) module type SyntaxFileArg = sig val internal: string type t val empty: t val pp: (opamfile, filename * t) OpamPp.t end module SyntaxFile(X: SyntaxFileArg) : IO_FILE with type t := X.t module type LineFileArg = sig val internal: string type t val empty: t val pp: (string list list, t) OpamPp.t end module LineFile (X: LineFileArg) : IO_FILE with type t := X.t opam-2.0.5/src/format/opamFormatConfig.mli0000644000175000017500000000232013511367404017470 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Configuration options for the format lib (record, global reference and setter) *) type t = private { strict : bool; (** Fail early with errors in OPAM files *) skip_version_checks : bool; (** Ignore mismatching OPAM versions in files *) all_parens : bool; (** Affects the OPAM format printer; for backwards-compatibility *) } type 'a options_fun = ?strict:bool -> ?skip_version_checks:bool -> ?all_parens:bool -> 'a include OpamStd.Config.Sig with type t := t and type 'a options_fun := 'a options_fun opam-2.0.5/src/format/opamTypesBase.ml0000644000175000017500000001332413511367404016646 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes include OpamCompat let std_path_of_string = function | "prefix" -> Prefix | "lib" -> Lib | "bin" -> Bin | "sbin" -> Sbin | "share" -> Share | "doc" -> Doc | "etc" -> Etc | "man" -> Man | "toplevel" -> Toplevel | "stublibs" -> Stublibs | _ -> failwith "Wrong standard path" let string_of_std_path = function | Prefix -> "prefix" | Lib -> "lib" | Bin -> "bin" | Sbin -> "sbin" | Share -> "share" | Doc -> "doc" | Etc -> "etc" | Man -> "man" | Toplevel -> "toplevel" | Stublibs -> "stublibs" let all_std_paths = [ Prefix; Lib; Bin; Sbin; Share; Doc; Etc; Man; Toplevel; Stublibs ] let string_of_shell = function | SH_fish -> "fish" | SH_csh -> "csh" | SH_zsh -> "zsh" | SH_sh -> "sh" | SH_bash -> "bash" let file_null = "" let pos_file filename = OpamFilename.to_string filename, -1, -1 let pos_null = file_null, -1, -1 let pos_best (f1,_li1,col1 as pos1) (f2,_li2,_col2 as pos2) = if f1 = file_null then pos2 else if f2 = file_null then pos1 else if col1 = -1 then pos2 else pos1 let string_of_pos (file,line,col) = file ^ if line >= 0 then ":" ^ string_of_int line ^ if col >= 0 then ":" ^ string_of_int col else "" else "" let string_of_user_action = function | Query -> "query" | Install -> "install" | Upgrade -> "upgrade" | Reinstall -> "reinstall" | Remove -> "remove" | Switch -> "switch" | Import -> "import" (* Command line arguments *) let env_array l = (* The env list may contain successive bindings of the same variable, make sure to keep only the last *) let bindings = List.fold_left (fun acc (k,v,_) -> OpamStd.String.Map.add k v acc) OpamStd.String.Map.empty l in let a = Array.make (OpamStd.String.Map.cardinal bindings) "" in OpamStd.String.Map.fold (fun k v i -> a.(i) <- String.concat "=" [k;v]; succ i) bindings 0 |> ignore; a let string_of_filter_ident (pkgs,var,converter) = OpamStd.List.concat_map ~nil:"" "+" ~right:":" (function None -> "_" | Some n -> OpamPackage.Name.to_string n) pkgs ^ OpamVariable.to_string var ^ (match converter with | Some (it,ifu) -> "?"^it^":"^ifu | None -> "") let filter_ident_of_string s = match OpamStd.String.rcut_at s ':' with | None -> [], OpamVariable.of_string s, None | Some (p,last) -> let get_names s = List.map (function "_" -> None | s -> Some (OpamPackage.Name.of_string s)) (OpamStd.String.split s '+') in match OpamStd.String.rcut_at p '?' with | None -> get_names p, OpamVariable.of_string last, None | Some (p,val_if_true) -> let converter = Some (val_if_true, last) in match OpamStd.String.rcut_at p ':' with | None -> [], OpamVariable.of_string p, converter | Some (packages,var) -> get_names packages, OpamVariable.of_string var, converter let all_package_flags = [ Pkgflag_LightUninstall; (* Pkgflag_AllSwitches; This has no "official" existence yet and does nothing *) Pkgflag_Verbose; Pkgflag_Plugin; Pkgflag_Compiler; Pkgflag_Conf; ] let string_of_pkg_flag = function | Pkgflag_LightUninstall -> "light-uninstall" | Pkgflag_Verbose -> "verbose" | Pkgflag_Plugin -> "plugin" | Pkgflag_Compiler -> "compiler" | Pkgflag_Conf -> "conf" | Pkgflag_Unknown s -> s let pkg_flag_of_string = function | "light-uninstall" -> Pkgflag_LightUninstall | "verbose" -> Pkgflag_Verbose | "plugin" -> Pkgflag_Plugin | "compiler" -> Pkgflag_Compiler | "conf" -> Pkgflag_Conf | s -> Pkgflag_Unknown s let action_contents = function | `Remove p | `Install p | `Reinstall p | `Build p -> p | `Change (_,_,p) -> p let full_action_contents = function | `Remove p | `Install p | `Reinstall p | `Build p -> [p] | `Change (_,p1,p2) -> [p1; p2] let map_atomic_action f = function | `Remove p -> `Remove (f p) | `Install p -> `Install (f p) let map_highlevel_action f = function | #atomic_action as a -> map_atomic_action f a | `Change (direction, p1, p2) -> `Change (direction, f p1, f p2) | `Reinstall p -> `Reinstall (f p) let map_concrete_action f = function | #atomic_action as a -> map_atomic_action f a | `Build p -> `Build (f p) let map_action f = function | #highlevel_action as a -> map_highlevel_action f a | #concrete_action as a -> map_concrete_action f a let string_of_cause to_string = let list_to_string l = match List.map to_string l with | a::b::c::_::_::_ -> Printf.sprintf "%s, %s, %s, etc." a b c | l -> String.concat ", " l in function | Upstream_changes -> "upstream changes" | Use pkgs -> Printf.sprintf "uses %s" (list_to_string pkgs) | Required_by pkgs -> Printf.sprintf "required by %s" (list_to_string pkgs) | Conflicts_with pkgs -> Printf.sprintf "conflicts with %s" (list_to_string pkgs) | Requested -> "" | Unknown -> "" let map_success f = function | Success x -> Success (f x) | Conflicts c -> Conflicts c let iter_success f = function | Success x -> f x | Conflicts _ -> () opam-2.0.5/src/format/opamTypesBase.mli0000644000175000017500000000577213511367404017027 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Helper functions on the base types (from [OpamTypes]) *) (** This module contains basic utility functions and stringifiers for the basic OPAM types present in OpamTypes.ml *) open OpamTypes include module type of struct include OpamCompat end val string_of_std_path: std_path -> string val std_path_of_string: string -> std_path val all_std_paths: std_path list (** Extract a package from a package action. *) val action_contents: [< 'a action ] -> 'a val map_atomic_action: ('a -> 'b) -> 'a atomic_action -> 'b atomic_action val map_highlevel_action: ('a -> 'b) -> 'a highlevel_action -> 'b highlevel_action val map_concrete_action: ('a -> 'b) -> 'a concrete_action -> 'b concrete_action val map_action: ('a -> 'b) -> 'a action -> 'b action (** Extract a packages from a package action. This returns all concerned packages, including the old version for an up/down-grade. *) val full_action_contents: 'a action -> 'a list (** Pretty-prints the cause of an action *) val string_of_cause: ('pkg -> string) -> 'pkg cause -> string (** Pretty-print *) val string_of_shell: shell -> string (** The empty file position *) val pos_null: pos (** [pos_best pos1 pos2] returns the most detailed position between [pos1] and [pos2] (defaulting to [pos1]) *) val pos_best: pos -> pos -> pos (** Position in the given file, with unspecified line and column *) val pos_file: filename -> pos (** Prints a file position *) val string_of_pos: pos -> string val string_of_user_action: user_action -> string (** Makes sure to keep only the last binding for a given variable; doesn't preserve order *) val env_array: env -> string array (** Parses the data suitable for a filter.FIdent from a string. May raise [Failure msg] on bad package names. A self-reference [_] parses to [None] *) val filter_ident_of_string: string -> name option list * variable * (string * string) option val string_of_filter_ident: name option list * variable * (string * string) option -> string val pkg_flag_of_string: string -> package_flag val string_of_pkg_flag: package_flag -> string val all_package_flags: package_flag list (** Map on a solver result *) val map_success: ('a -> 'b) -> ('a,'fail) result -> ('b,'fail) result val iter_success: ('a -> unit) -> ('a, 'b) result -> unit opam-2.0.5/src/format/opamPath.mli0000644000175000017500000002573713511367404016027 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Defines the file hierarchy in ~/.opam *) open OpamTypes (** {2 Global paths} *) (** Type of path root *) type t = dirname (** State cache *) val state_cache: t -> filename (** Global lock file for the whole opamroot. Opam should generally read-lock this (e.g. initialisation and format upgrades require a write lock) *) val lock: t -> filename (** Main configuration file: {i $opam/config} *) val config: t -> OpamFile.Config.t OpamFile.t (** The list of configuration files location used by default ({i /etc/opamrc} and {i ~/.opamrc}). More general (lower priority) first. *) val init_config_files: unit -> OpamFile.InitConfig.t OpamFile.t list (** Lock for updates on the main config file (write lock when changes to switches, repositories lists are expected. No lock needed otherwise) *) val config_lock: t -> filename (** Archives dir *) val archives_dir: t -> dirname (** Archive file: {i $opam/archives/$NAME.$VERSION+opam.tar.gz} *) val archive: t -> package -> filename (** Global lock file for the repositories mirrors: {i $opam/repo/lock} *) val repos_lock: t -> filename (** Global config file for the repositories mirrors: {i $opam/repo/repos-config} *) val repos_config: t -> OpamFile.Repos_config.t OpamFile.t (** Init scripts location: {i $opam/opam-init} *) val init: t -> dirname (** Installation dir for configured hooks: ${i $opam/opam-init/hooks} *) val hooks_dir: t -> dirname (** Log dir {i $opam/log} *) val log: t -> dirname (** The directory where global backups are stored *) val backup_dir: t -> dirname (** Backup file for state export *) val backup: t -> switch_selections OpamFile.t (** The directory for plugins data {i $opam/plugins} *) val plugins: t -> dirname (** The directory for shared plugin binaries {i $opam/plugins/bin} *) val plugins_bin: t -> dirname (** The globally installed binary of the given plugin {i $opam/plugins/bin/opam-foo} *) val plugin_bin: t -> name -> filename (** The directory for a given plugin's data {i $opam/plugins/$name}. ["bin"] is forbidden. *) val plugin: t -> name -> dirname (** Switch related paths *) module Switch: sig (** Locations of opam internal dirs and files *) (** The switch prefix: {i $opam/$switch} *) val root: t -> switch -> dirname (** The name of the subdir of the switch prefix where opam data is stored (".opam-switch") *) val meta_dirname: string (** The subdirectory of the prefix where opam data lives: {i $opam/$switch/.opam-switch}*) val meta: t -> switch -> dirname (** lock file: {i $meta/lock} *) val lock: t -> switch -> filename (** The directory where backups are stored for this switch *) val backup_dir: t -> switch -> dirname (** Backup file for state export *) val backup: t -> switch -> switch_selections OpamFile.t (** Switch selections {i $meta/switch-state} *) val selections: t -> switch -> switch_selections OpamFile.t (** Temporary folders used to decompress and compile the corresponding archives: {i $meta/build/$packages} *) val build: t -> switch -> package -> dirname (** Temporary folders used to decompress the corresponding archives, used only for package removal {i $meta/remove/$packages} *) val remove: t -> switch -> package -> dirname (** Temporary folder: {i $meta/build} *) val build_dir: t -> switch -> dirname (** Temporary folder: {i $meta/remove} *) val remove_dir: t -> switch -> dirname (** Installed files for a given package: {i $meta/install/$name.install} *) val install: t -> switch -> name -> OpamFile.Dot_install.t OpamFile.t (** File registering the changes made by the installation of the given package {i $meta/install/$name.changes} *) val changes: t -> switch -> name -> OpamDirTrack.t OpamFile.t (** Installed files: {i $meta/install/} *) val install_dir: t -> switch -> dirname (** Packages to reinstall on next upgrade: {i $meta/reinstall} *) val reinstall: t -> switch -> OpamFile.PkgList.t OpamFile.t (** Configuration folder: {i $meta/config} *) val config_dir: t -> switch -> dirname (** Global config for the switch: {i $meta/switch-config} *) val switch_config: t -> switch -> OpamFile.Switch_config.t OpamFile.t (** Package-specific configuration file for installed packages: {i $meta/config/$name.config} *) val config: t -> switch -> name -> OpamFile.Dot_config.t OpamFile.t (** Clean, uncompressed sources for this switch: {i $meta/sources/} *) val sources_dir: t -> switch -> dirname (** Clean, uncompressed source directory for this package: {i $meta/sources/$name.$version/} *) val sources: t -> switch -> package -> dirname (** Mirror of the sources for a given pinned package: {i $meta/sources/$name/} (without version) *) val pinned_package: t -> switch -> name -> dirname (** Cached environment updates. *) val environment: t -> switch -> OpamFile.Environment.t OpamFile.t (** Like [environment], but from the switch prefix dir *) val env_relative_to_prefix: dirname -> OpamFile.Environment.t OpamFile.t (** Directory where the metadata of installed packages is mirrored. {i $meta/packages/} *) val installed_opams: t -> switch -> dirname (** The mirror of the package definition for the given installed package {i $meta/packages/$name.$version/} *) val installed_package_dir: t -> switch -> package -> dirname (** The mirror of the opam file for the given installed package {i $meta/packages/$name.$version/opam} *) val installed_opam: t -> switch -> package -> OpamFile.OPAM.t OpamFile.t (** Mirror of the extra files attached to the package definitions of installed packages {i $meta/packages/$name.$version/files/} *) val installed_opam_files_dir: t -> switch -> package -> dirname (** Locations for the visible part of the installation *) (** Default config *) module Default : sig (** Library path for a given package: {i $prefix/lib/$name} *) val lib: t -> switch -> name -> dirname (** Library path: {i $prefix/lib} *) val lib_dir: t -> switch -> dirname (** DLL paths *) val stublibs: t -> switch -> dirname (** toplevel path: {i $prefix/lib/toplevel} *) val toplevel: t -> switch -> dirname (** Documentation path for a given package: {i $prefix/doc/$name} *) val doc: t -> switch -> name -> dirname (** Documentation path: {i $prefix/doc/} *) val doc_dir: t -> switch -> dirname (** Shared directory: {i $prefix/share} *) val share_dir: t -> switch -> dirname (** Share directory for a given package: {i $prefix/share/$package} *) val share: t -> switch -> name -> dirname (** Etc directory: {i $prefix/etc} *) val etc_dir: t -> switch -> dirname (** Etc directory for a given package: {i $prefix/etc/$package} *) val etc: t -> switch -> name -> dirname (** Man pages path: {i $prefix/man/}. The optional [num] argument will add a {i manN } suffix if specified *) val man_dir: ?num:string -> t -> switch -> dirname (** Installed binaries: {i $prefix/bin} *) val bin: t -> switch -> dirname (** Installed system binaries: {i $prefix/sbin} *) val sbin: t -> switch -> dirname end (** Actual config handling the global-config.config indirections *) (** Package-independent dirs *) val get_stdpath: t -> switch -> OpamFile.Switch_config.t -> std_path -> dirname (** Library path: {i $prefix/lib} *) val lib_dir: t -> switch -> OpamFile.Switch_config.t -> dirname (** DLL paths *) val stublibs: t -> switch -> OpamFile.Switch_config.t -> dirname (** toplevel path: {i $prefix/lib/toplevel} *) val toplevel: t -> switch -> OpamFile.Switch_config.t -> dirname (** Documentation path: {i $prefix/doc/} *) val doc_dir: t -> switch -> OpamFile.Switch_config.t -> dirname (** Shared directory: {i $prefix/share} *) val share_dir: t -> switch -> OpamFile.Switch_config.t -> dirname (** Etc directory: {i $prefix/etc} *) val etc_dir: t -> switch -> OpamFile.Switch_config.t -> dirname (** Man pages path: {i $prefix/man/}. The optional [num] argument will add a {i manN } suffix if specified *) val man_dir: ?num:string -> t -> switch -> OpamFile.Switch_config.t -> dirname (** Installed binaries: {i $prefix/bin} *) val bin: t -> switch -> OpamFile.Switch_config.t -> dirname (** Installed system binaries: {i $prefix/sbin} *) val sbin: t -> switch -> OpamFile.Switch_config.t -> dirname (** Package dependent dirs *) (** Library path for a given package: {i $prefix/lib/$name} *) val lib: t -> switch -> OpamFile.Switch_config.t -> name -> dirname (** Documentation path for a given package: {i $prefix/doc/$name} *) val doc: t -> switch -> OpamFile.Switch_config.t -> name -> dirname (** Share directory for a given package: {i $prefix/share/$package} *) val share: t -> switch -> OpamFile.Switch_config.t -> name -> dirname (** Etc directory for a given package: {i $prefix/etc/$package} *) val etc: t -> switch -> OpamFile.Switch_config.t -> name -> dirname module Overlay: sig (** Switch metadata overlay (over the global metadata): {i $meta/overlay/} *) val dir: t -> switch -> dirname (** Switch metadata overlay (over the global metadata): {i $meta/overlay/$name.$version} *) val package: t -> switch -> name -> dirname (** OPAM overlay: {i $meta/overlay/$name.$version/opam} *) val opam: t -> switch -> name -> OpamFile.OPAM.t OpamFile.t (** OPAM temp overlay (for user editing): {i $meta/overlay/$name.$version/opam_} *) val tmp_opam: t -> switch -> name -> OpamFile.OPAM.t OpamFile.t (** URL overlay: {i $meta/overlay/$name.$version/url} *) val url: t -> switch -> name -> OpamFile.URL.t OpamFile.t (** Descr orverlay *) val descr: t -> switch -> name -> OpamFile.Descr.t OpamFile.t (** Files overlay *) val files: t -> switch -> name -> dirname end end (** Location of package-specific files relative to their build directory *) module Builddir: sig (** package.install file: {i $builddir/$name.install} *) val install: dirname -> package -> OpamFile.Dot_install.t OpamFile.t (** package.config file: {i $builddir/$name.config} *) val config: dirname -> package -> OpamFile.Dot_config.t OpamFile.t end opam-2.0.5/src/format/opamFormatConfig.ml0000644000175000017500000000316113511367404017323 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2015 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type t = { strict: bool; skip_version_checks: bool; all_parens: bool; } type 'a options_fun = ?strict:bool -> ?skip_version_checks:bool -> ?all_parens:bool -> 'a let default = { strict = false; skip_version_checks = false; all_parens = false; } let setk k t ?strict ?skip_version_checks ?all_parens = let (+) x opt = match opt with Some x -> x | None -> x in k { strict = t.strict + strict; skip_version_checks = t.skip_version_checks + skip_version_checks; all_parens = t.all_parens + all_parens; } let set t = setk (fun x () -> x) t (* Global configuration reference *) let r = ref default let update ?noop:_ = setk (fun cfg () -> r := cfg) !r let initk k = let open OpamStd.Config in setk (setk (fun c -> r := c; k)) !r ?strict:(env_bool "STRICT") ?skip_version_checks:(env_bool "SKIPVERSIONCHECKS") ?all_parens:(env_bool "ALLPARENS") let init ?noop:_ = initk (fun () -> ()) opam-2.0.5/src/format/opamRepositoryName.mli0000644000175000017500000000156113511367404020100 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** The type for repository names *) include OpamStd.ABSTRACT (** Default repository name *) val default: t opam-2.0.5/src/format/opamLineLexer.mll0000644000175000017500000000334313511367404017012 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) { type token = | WORD of string | NEWLINE | EOF let word = Buffer.create 57 } let normalchar = [^' ' '\t' '\n' '\\'] rule main = parse | '\n' { Lexing.new_line lexbuf; NEWLINE } | [' ' '\t']+ { main lexbuf } | (normalchar* as w) '\\' { Buffer.reset word ; Buffer.add_string word w; escaped lexbuf } | (normalchar* as w) { WORD w } | eof { EOF } and escaped = parse | (_ normalchar*) as w '\\' { Buffer.add_string word w; escaped lexbuf } | (_ normalchar*) as w { Buffer.add_string word w; WORD (Buffer.contents word) } { let main lexbuf = let rec aux lines words = match main lexbuf with | WORD "" -> aux lines words | WORD s -> aux lines (s::words) | NEWLINE -> let lines = if words = [] then lines else List.rev words::lines in aux lines [] | EOF -> let lines = if words = [] then lines else List.rev words::lines in List.rev lines in aux [] [] } opam-2.0.5/src/format/opamVariable.mli0000644000175000017500000000476513511367404016656 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** OPAM variables with scope (global or module), used in "opam" package definition files in "filters" *) (** {2 Variable names} *) include OpamStd.ABSTRACT (** Shortcut to variables *) type variable = t (** Variable contents *) type variable_contents = | B of bool | S of string | L of string list (** Pretty print of variable contents *) val string_of_variable_contents: variable_contents -> string (** Variable contents constructors *) val string: string -> variable_contents val int: int -> variable_contents val bool: bool -> variable_contents val dirname: OpamFilename.Dir.t -> variable_contents module Full: sig (** Fully qualified variable. *) include OpamStd.ABSTRACT type scope = | Global (** Note: this is attributed to unqualified variables, and may also design self-referring ones *) | Self (** Variable in a package-specific file referring to that package [_:varname] *) | Package of OpamPackage.Name.t (** [pkgname:varname] *) (** Returns the scope of the variable *) val scope: t -> scope (** Returns the unqualified variable name *) val variable: t -> variable val is_global: t -> bool (** Return the package corresponding to the scope of the variable *) val package: ?self:OpamPackage.Name.t -> t -> OpamPackage.Name.t option (** Create a variable local for a given library/syntax extension *) val create: OpamPackage.Name.t -> variable -> t (** Create a global variable *) val global: variable -> t (** Create a variable in the [Self] scope *) val self: variable -> t (** Looks up for an environment override through the environment, by means of [OPAMVAR_glovar] or [OPAMVAR_pkg_pkgvar] *) val read_from_env: t -> variable_contents option end opam-2.0.5/src/format/opamTypes.mli0000644000175000017500000002551113511367404016225 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Definitions of many types used throughout *) (** {2 Error and continuation handling} *) type 'a success = [ `Successful of 'a ] type 'a error = [ | `Error of 'a | `Exception of exn ] type ('a,'b) status = [ 'a success | 'b error ] (** {2 Untyped generic file format} *) include module type of struct include OpamParserTypes end (** {2 Filenames} *) (** Basenames *) type basename = OpamFilename.Base.t (** Directory names (translated to absolute) *) type dirname = OpamFilename.Dir.t (** Filenames *) type filename = OpamFilename.t (** Set of files *) type filename_set = OpamFilename.Set.t (** Map of files *) type 'a filename_map = 'a OpamFilename.Map.t (** Predefined installation directories within a switch *) type std_path = | Prefix | Lib | Bin | Sbin | Share | Doc | Etc | Man | Toplevel | Stublibs (** Download result *) type 'a download = | Up_to_date of 'a | Not_available of string option * string (** Arguments are respectively the short and long version of an error message. The usage is: the first argument is displayed on normal mode (nothing if [None]), and the second one on verbose mode. *) | Result of 'a (** {2 Packages} *) (** Packages are ([name] * [version]) tuple *) type package = OpamPackage.t = private { name: OpamPackage.Name.t; version: OpamPackage.Version.t; } (** Set of packages *) type package_set = OpamPackage.Set.t (** Map of packages *) type 'a package_map = 'a OpamPackage.Map.t (** Package names *) type name = OpamPackage.Name.t (** Set of package names *) type name_set = OpamPackage.Name.Set.t (** Map of package names *) type 'a name_map = 'a OpamPackage.Name.Map.t (** Package versions *) type version = OpamPackage.Version.t (** Set of package versions *) type version_set = OpamPackage.Version.Set.t (** OPAM versions *) type opam_version = OpamVersion.t (** {2 Variables} *) (** Variables *) type variable = OpamVariable.t (** Fully qualified variables (ie. with the name of sections/sub-sections they appear in) *) type full_variable = OpamVariable.Full.t (** Content of user-defined variables *) type variable_contents = OpamVariable.variable_contents = | B of bool | S of string | L of string list (** A map from variables to their contents (i.e an environment) *) type variable_map = OpamVariable.variable_contents OpamVariable.Map.t (** Opam package flags *) type package_flag = | Pkgflag_LightUninstall (** The package doesn't require downloading to uninstall *) | Pkgflag_Verbose (** The package's scripts output is to be displayed to the user *) | Pkgflag_Plugin (** The package is an opam plugin that will install a [opam-] exec, and may be auto-installed when doing [opam ] *) | Pkgflag_Compiler (** Package may be used for 'opam switch' *) | Pkgflag_Conf (** Virtual package: no source, no install or remove instructions, .install, but likely has depexts *) | Pkgflag_Unknown of string (** Used for error reporting, otherwise ignored *) (** At some point we want to abstract so that the same functions can be used over CUDF and OPAM packages *) module type GenericPackage = sig include OpamParallel.VERTEX val name_to_string: t -> string val version_to_string: t -> string end (** {2 Formulas} *) (** A generic formula *) type 'a generic_formula = 'a OpamFormula.formula = | Empty | Atom of 'a | Block of 'a generic_formula | And of 'a generic_formula * 'a generic_formula | Or of 'a generic_formula * 'a generic_formula (** Formula atoms *) type atom = OpamFormula.atom (** Formula over versionned packages *) type formula = OpamFormula.t (** AND formulat *) type 'a conjunction = 'a OpamFormula.conjunction (** OR formulat *) type 'a disjunction = 'a OpamFormula.disjunction (** {2 Repositories} *) (** Repository names *) type repository_name = OpamRepositoryName.t (** Maps of repository names *) type 'a repository_name_map = 'a OpamRepositoryName.Map.t type url = OpamUrl.t (*= { transport: string; path: string; hash: string option; backend: OpamUrl.backend; } *) type trust_anchors = { quorum: int; fingerprints: string list; } (** Repositories *) type repository = { repo_name : repository_name; repo_root : dirname; (** The root of opam's local mirror for this repo *) repo_url : url; repo_trust : trust_anchors option; } (** {2 Variable-based filters} *) type filter = | FBool of bool | FString of string | FIdent of (name option list * variable * (string * string) option) (** packages (or None for self-ref through "_"), variable name, string converter (val_if_true, val_if_false_or_undef) *) | FOp of filter * relop * filter | FAnd of filter * filter | FOr of filter * filter | FNot of filter | FDefined of filter | FUndef of filter (** Returned by reduce functions when the filter could not be resolved to an atom (due to undefined variables or string expansions). The argument contains the partially reduced filter, where strings may still contain expansions (and are otherwise escaped). Used both for partial evaluation, and error messaging. Not allowed as an argument to other filters *) (** {2 Filtered formulas (to express conditional dependencies)} These are first reduced to only the dependency-flag variables build, doc, dev, test defined in [Opam formulas] *) type 'a filter_or_constraint = | Filter of filter | Constraint of (relop * 'a) type filtered_formula = (name * filter filter_or_constraint OpamFormula.formula) OpamFormula.formula (** {2 Solver} *) (** Used internally when computing sequences of actions *) type 'a atomic_action = [ | `Remove of 'a | `Install of 'a ] (** Used to compact the atomic actions and display to the user in a more meaningful way *) type 'a highlevel_action = [ | 'a atomic_action | `Change of [ `Up | `Down ] * 'a * 'a | `Reinstall of 'a ] (** Sub-type of [highlevel_action] corresponding to an installed package that changed state or version *) type 'a inst_action = [ | `Install of 'a | `Change of [ `Up | `Down ] * 'a * 'a ] (** Used when applying solutions, separates build from install *) type 'a concrete_action = [ | 'a atomic_action | `Build of 'a ] type 'a action = [ | 'a atomic_action | 'a highlevel_action | 'a concrete_action ] (** The possible causes of an action. *) type 'a cause = | Use of 'a list | Required_by of 'a list | Conflicts_with of 'a list | Upstream_changes | Requested | Unknown (** Solver result *) type solver_result = | Nothing_to_do | OK of package action list (** List of successful actions *) | Aborted | No_solution | Partial_error of package action list * package action list * package action list (** List of successful actions, list of actions with errors, list of remaining undone actions *) (** Solver result *) type ('a, 'b) result = | Success of 'a | Conflicts of 'b type solver_criteria = [ `Default | `Upgrade | `Fixup ] (** Solver request *) type 'a request = { criteria: solver_criteria; wish_install: 'a conjunction; wish_remove : 'a conjunction; wish_upgrade: 'a conjunction; extra_attributes: string list; } (** user request action *) type user_action = Query | Install | Upgrade | Reinstall | Remove | Switch | Import (** Solver universe *) type universe = { u_packages : package_set; u_installed: package_set; u_available: package_set; u_depends : filtered_formula package_map; u_depopts : filtered_formula package_map; u_conflicts: formula package_map; u_action : user_action; u_installed_roots: package_set; u_pinned : package_set; u_base : package_set; u_reinstall: package_set; u_attrs : (string * package_set) list; } (** {2 Command line arguments} *) (** Pin kind *) type pin_kind = [ `version | OpamUrl.backend ] (** Shell compatibility modes *) type shell = OpamStd.Sys.shell = SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish (** {2 Generic command-line definitions with filters} *) (** A command argument *) type simple_arg = | CString of string | CIdent of string (** Command argument *) type arg = simple_arg * filter option (** Command *) type command = arg list * filter option (** {2 Switches} *) (** Compiler switches *) type switch = OpamSwitch.t (** Set of compiler switches *) type switch_set = OpamSwitch.Set.t (** Map of compile switches *) type 'a switch_map = 'a OpamSwitch.Map.t type switch_selections = { sel_installed: package_set; sel_roots: package_set; sel_compiler: package_set; sel_pinned: package_set; } (** {2 Misc} *) (** The different kinds of locks *) type lock = | Read_lock of (unit -> unit) (** The function does not modify anything, but it needs the state not to change while it is running. *) | Global_lock of (unit -> unit) (** Take the global lock, all subsequent calls to OPAM are blocked. *) | Switch_lock of (unit -> switch) * (unit -> unit) (** Take a global read lock and a switch lock. The first function is called with the read lock, then the second function is called with the returned switch write-locked. *) | Global_with_switch_cont_lock of (unit -> switch * (unit -> unit)) (** Call the function in a global lock, then relax to a switch lock and call the function it returned *) (** A line in {i urls.tx} *) type file_attribute = OpamFilename.Attribute.t (** All the lines in {i urls.txt} *) type file_attribute_set = OpamFilename.Attribute.Set.t (** Optional contents *) type 'a optional = { c : 'a; (** Contents *) optional: bool; (** Is the contents optional *) } (** Upgrade statistics *) type stats = { s_install : int; s_reinstall: int; s_upgrade : int; s_downgrade: int; s_remove : int; } (** Environement variables: var name, value, optional comment *) type env = (string * string * string option) list (** Environment updates *) type env_update = string * env_update_op * string * string option (** var, update_op, value, comment *) (** Tags *) type tags = OpamStd.String.Set.t OpamStd.String.SetMap.t (** {2 Repository and global states} *) (** Checksums *) type checksums = string list (** {2 JSON} *) type json = OpamJson.t opam-2.0.5/src/format/opamPackage.mli0000644000175000017500000001027013511367404016450 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** The package type, and package name type (name+version, values often called "nv" in the code) *) (** {2 Package name and versions} *) (** Versions *) module Version: sig include OpamStd.ABSTRACT (** Compare two versions using the Debian version scheme *) val compare: t -> t -> int end (** Names *) module Name: sig include OpamStd.ABSTRACT (** Compare two package names *) val compare: t -> t -> int end type t = private { name: Name.t; version: Version.t; } (** Package (name x version) pairs *) include OpamStd.ABSTRACT with type t := t (** Return the package name *) val name: t -> Name.t (** Return None if [nv] is not a valid package name *) val of_string_opt: string -> t option (** Return the version name *) val version: t -> Version.t (** Create a new pair (name x version) *) val create: Name.t -> Version.t -> t (** To fit in the GenericPackage type, for generic display functions *) val name_to_string: t -> string val version_to_string: t -> string (** Guess the package name from a filename. This function extracts [name] and [version] from {i /path/to/$name.$version/opam}, or {i /path/to/$name.$version.opam} *) val of_filename: OpamFilename.t -> t option (** Guess the package name from a directory name. This function extracts {i $name} and {i $version} from {i /path/to/$name.$version/} *) val of_dirname: OpamFilename.Dir.t -> t option (** Guess the package name from an archive file. This function extract {i $name} and {i $version} from {i /path/to/$name.$version+opam.tar.gz} *) val of_archive: OpamFilename.t -> t option (** Convert a set of pairs to a map [name -> versions] *) val to_map: Set.t -> Version.Set.t Name.Map.t (** The converse of [to_map] *) val of_map: Version.Set.t Name.Map.t -> Set.t (** Returns the keys in a package map as a package set *) val keys: 'a Map.t -> Set.t (** Extract the versions from a collection of packages *) val versions_of_packages: Set.t -> Version.Set.t (** Return the list of versions for a given package *) val versions_of_name: Set.t -> Name.t -> Version.Set.t (** Extract the naes from a collection of packages *) val names_of_packages: Set.t -> Name.Set.t (** Returns true if the set contains a package with the given name *) val has_name: Set.t -> Name.t -> bool (** Return all the packages with the given name *) val packages_of_name: Set.t -> Name.t -> Set.t (** Return a package with the given name *) val package_of_name: Set.t -> Name.t -> t (** Return a package with the given name, if any *) val package_of_name_opt: Set.t -> Name.t -> t option (** Return all the packages with one of the given names *) val packages_of_names: Set.t -> Name.Set.t -> Set.t (** Removes all packages with the given name from a set of packages *) val filter_name_out: Set.t -> Name.t -> Set.t (** Return the maximal available version of a package name from a set. Raises [Not_found] if no such package available. *) val max_version: Set.t -> Name.t -> t (** Compare two packages *) val compare: t -> t -> int (** Are two packages equal? *) val equal: t -> t -> bool (** Hash a package *) val hash: t -> int (** Return all the package descriptions in a given directory *) val list: OpamFilename.Dir.t -> Set.t (** Return all the package descriptions in the current directory (and their eventual prefixes). *) val prefixes: OpamFilename.Dir.t -> string option Map.t (** {2 Errors} *) (** Parallel executions. *) module Graph: OpamParallel.GRAPH with type V.t = t opam-2.0.5/src/format/opamFormula.ml0000644000175000017500000004145113511367404016356 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type relop = [`Eq|`Neq|`Geq|`Gt|`Leq|`Lt] let neg_relop = function | `Eq -> `Neq | `Neq -> `Eq | `Geq -> `Lt | `Gt -> `Leq | `Leq -> `Gt | `Lt -> `Geq type version_constraint = relop * OpamPackage.Version.t type atom = OpamPackage.Name.t * version_constraint option let string_of_atom = function | n, None -> OpamPackage.Name.to_string n | n, Some (r,c) -> Printf.sprintf "%s (%s %s)" (OpamPackage.Name.to_string n) (OpamPrinter.relop r) (OpamPackage.Version.to_string c) let short_string_of_atom = function | n, None -> OpamPackage.Name.to_string n | n, Some (`Eq,c) -> Printf.sprintf "%s.%s" (OpamPackage.Name.to_string n) (OpamPackage.Version.to_string c) | n, Some (r,c) -> Printf.sprintf "%s%s%s" (OpamPackage.Name.to_string n) (OpamPrinter.relop r) (OpamPackage.Version.to_string c) let string_of_atoms atoms = OpamStd.List.concat_map " & " short_string_of_atom atoms type 'a conjunction = 'a list let string_of_conjunction string_of_atom c = Printf.sprintf "(%s)" (OpamStd.List.concat_map " & " string_of_atom c) type 'a disjunction = 'a list let string_of_disjunction string_of_atom c = Printf.sprintf "(%s)" (OpamStd.List.concat_map " | " string_of_atom c) type 'a cnf = 'a list list let string_of_cnf string_of_atom cnf = let string_of_clause c = let left, right = match c with [_] -> "", "" | _ -> "(", ")" in OpamStd.List.concat_map ~left ~right " | " string_of_atom c in OpamStd.List.concat_map " & " string_of_clause cnf type 'a dnf = 'a list list let string_of_dnf string_of_atom cnf = let string_of_clause c = let left, right = match c with [_] -> "", "" | _ -> "(", ")" in OpamStd.List.concat_map ~left ~right " & " string_of_atom c in OpamStd.List.concat_map " | " string_of_clause cnf type 'a formula = | Empty | Atom of 'a | Block of 'a formula | And of 'a formula * 'a formula | Or of 'a formula * 'a formula let make_and a b = match a, b with | Empty, r | r, Empty -> r | a, b -> And (a, b) let make_or a b = match a, b with | Empty, r | r, Empty -> r (* we're not assuming Empty is true *) | a, b -> Or (a, b) let string_of_formula string_of_a f = let rec aux ?(in_and=false) f = let paren_if ?(cond=false) s = if cond || OpamFormatConfig.(!r.all_parens) then Printf.sprintf "(%s)" s else s in match f with | Empty -> "0" | Atom a -> paren_if (string_of_a a) | Block x -> Printf.sprintf "(%s)" (aux x) | And(x,y) -> paren_if (Printf.sprintf "%s & %s" (aux ~in_and:true x) (aux ~in_and:true y)) | Or(x,y) -> paren_if ~cond:in_and (Printf.sprintf "%s | %s" (aux x) (aux y)) in aux f let rec map f = function | Empty -> Empty | Atom x -> f x | And(x,y) -> make_and (map f x) (map f y) | Or(x,y) -> make_or (map f x) (map f y) | Block x -> match map f x with | Empty -> Empty | x -> Block x (* Maps top-down *) let rec map_formula f t = let t = f t in match t with | Block x -> Block (map_formula f x) | And(x,y) -> make_and (map_formula f x) (map_formula f y) | Or(x,y) -> make_or (map_formula f x) (map_formula f y) | x -> x let rec map_up_formula f t = let t = match t with | Block x -> f (Block (map_up_formula f x)) | And(x,y) -> f (make_and (map_up_formula f x) (map_up_formula f y)) | Or(x,y) -> f (make_or (map_up_formula f x) (map_up_formula f y)) | Atom x -> f (Atom x) | Empty -> Empty in f t let neg neg_atom = map_formula (function | And(x,y) -> Or(x,y) | Or(x,y) -> And(x,y) | Atom x -> Atom (neg_atom x) | x -> x) let rec iter f = function | Empty -> () | Atom x -> f x | Block x -> iter f x | And(x,y) -> iter f x; iter f y | Or(x,y) -> iter f x; iter f y let rec fold_left f i = function | Empty -> i | Atom x -> f i x | Block x -> fold_left f i x | And(x,y) -> fold_left f (fold_left f i x) y | Or(x,y) -> fold_left f (fold_left f i x) y let rec fold_right f i = function | Empty -> i | Atom x -> f i x | Block x -> fold_right f i x | And(x,y) -> fold_right f (fold_right f i y) x | Or(x,y) -> fold_right f (fold_right f i y) x type version_formula = version_constraint formula type t = (OpamPackage.Name.t * version_formula) formula let rec eval atom = function | Empty -> true | Atom x -> atom x | Block x -> eval atom x | And(x,y) -> eval atom x && eval atom y | Or(x,y) -> eval atom x || eval atom y let rec partial_eval atom = function | Empty -> `Formula Empty | Atom x -> atom x | And(x,y) -> (match partial_eval atom x, partial_eval atom y with | `False, _ | _, `False -> `False | `True, f | f, `True -> f | `Formula x, `Formula y -> `Formula (And (x,y))) | Or(x,y) -> (match partial_eval atom x, partial_eval atom y with | `True, _ | _, `True -> `True | `False, f | f, `False -> f | `Formula x, `Formula y -> `Formula (Or (x,y))) | Block x -> partial_eval atom x let check_relop relop c = match relop with | `Eq -> c = 0 | `Neq -> c <> 0 | `Geq -> c >= 0 | `Gt -> c > 0 | `Leq -> c <= 0 | `Lt -> c < 0 let eval_relop relop v1 v2 = check_relop relop (OpamPackage.Version.compare v1 v2) let check_version_formula f v = eval (fun (relop, vref) -> eval_relop relop v vref) f let check (name,cstr) package = name = OpamPackage.name package && match cstr with | None -> true | Some (relop, v) -> eval_relop relop (OpamPackage.version package) v let packages_of_atoms pkgset atoms = (* Conjunction for constraints over the same name, but disjunction on the package names *) let by_name = List.fold_left (fun acc (n,_ as atom) -> OpamPackage.Name.Map.update n (fun a -> atom::a) [] acc) OpamPackage.Name.Map.empty atoms in OpamPackage.Name.Map.fold (fun name atoms acc -> OpamPackage.Set.union acc @@ OpamPackage.Set.filter (fun nv -> List.for_all (fun a -> check a nv) atoms) (OpamPackage.packages_of_name pkgset name)) by_name OpamPackage.Set.empty let to_string t = let string_of_constraint (relop, version) = Printf.sprintf "%s %s" (OpamPrinter.relop relop) (OpamPackage.Version.to_string version) in let string_of_pkg = function | n, Empty -> OpamPackage.Name.to_string n | n, (Atom _ as c) -> Printf.sprintf "%s %s" (OpamPackage.Name.to_string n) (string_of_formula string_of_constraint c) | n, c -> Printf.sprintf "%s (%s)" (OpamPackage.Name.to_string n) (string_of_formula string_of_constraint c) in string_of_formula string_of_pkg t (* convert a formula to a CNF *) let cnf_of_formula t = let rec mk_left x y = match y with | Block y -> mk_left x y | And (a,b) -> And (mk_left x a, mk_left x b) | Empty -> x | _ -> Or (x,y) in let rec mk_right x y = match x with | Block x -> mk_right x y | And (a,b) -> And (mk_right a y, mk_right b y) | Empty -> y | _ -> mk_left x y in let rec mk = function | Empty -> Empty | Block x -> mk x | Atom x -> Atom x | And (x,y) -> And (mk x, mk y) | Or (x,y) -> mk_right (mk x) (mk y) in mk t (* convert a formula to DNF *) let dnf_of_formula t = let rec mk_left x y = match y with | Block y -> mk_left x y | Or (a,b) -> Or (mk_left x a, mk_left x b) | _ -> And (x,y) in let rec mk_right x y = match x with | Block x -> mk_right x y | Or (a,b) -> Or (mk_right a y, mk_right b y) | _ -> mk_left x y in let rec mk = function | Empty -> Empty | Block x -> mk x | Atom x -> Atom x | Or (x,y) -> Or (mk x, mk y) | And (x,y) -> mk_right (mk x) (mk y) in mk t let verifies f nv = let name_formula = map (fun ((n, _) as a) -> if n = OpamPackage.name nv then Atom a else Empty) (dnf_of_formula f) in name_formula <> Empty && eval (fun (_name, cstr) -> check_version_formula cstr (OpamPackage.version nv)) name_formula let packages pkgset f = let names = fold_left (fun acc (name, _) -> OpamPackage.Name.Set.add name acc) OpamPackage.Name.Set.empty f in (* dnf allows us to transform the formula into a union of intervals, where ignoring atoms for different package names works. *) let dnf = dnf_of_formula f in OpamPackage.Name.Set.fold (fun name acc -> (* Ignore conjunctions where [name] doesn't appear *) let name_formula = map (fun ((n, _) as a) -> if n = name then Atom a else Empty) dnf in OpamPackage.Set.union acc @@ OpamPackage.Set.filter (fun nv -> let v = OpamPackage.version nv in eval (fun (_name, cstr) -> check_version_formula cstr v) name_formula) (OpamPackage.packages_of_name pkgset name)) names OpamPackage.Set.empty (* Convert a t an atom formula *) let to_atom_formula (t:t): atom formula = map (fun (x, c) -> match c with | Empty -> Atom (x, None) | cs -> map (fun c -> Atom (x, Some c)) cs) t (* Convert an atom formula to a t-formula *) let of_atom_formula (a:atom formula): t = let atom (n, v) = match v with | None -> Atom (n, Empty) | Some (r,v) -> Atom (n, Atom (r,v)) in map atom a let ands l = List.fold_left make_and Empty l let rec ands_to_list = function | Empty -> [] | And (e,f) -> List.rev_append (rev_ands_to_list e) (ands_to_list f) | Block f -> ands_to_list f | x -> [x] and rev_ands_to_list = function | Empty -> [] | Block f -> rev_ands_to_list f | And (e,f) -> List.rev_append (ands_to_list f) (rev_ands_to_list e) | x -> [x] let of_conjunction c = of_atom_formula (ands (List.rev_map (fun x -> Atom x) c)) let ors l = List.fold_left make_or Empty l let rec ors_to_list = function | Empty -> [] | Or (e,f) -> List.rev_append (rev_ors_to_list e) (ors_to_list f) | Block f -> ors_to_list f | x -> [x] and rev_ors_to_list = function | Empty -> [] | Or (e,f) -> List.rev_append (ors_to_list f) (rev_ors_to_list e) | Block f -> rev_ors_to_list f | x -> [x] let is_conjunction t = let rec aux = function | Or _ -> false | And (a,b) -> aux a && aux b | Block a -> aux a | _ -> true in aux t let is_disjunction t = let rec aux = function | And _ -> false | Or (a,b) -> aux a && aux b | Block a -> aux a | _ -> true in aux t let atoms t = fold_right (fun accu x -> x::accu) [] (to_atom_formula t) let to_cnf t = let atf = to_atom_formula t in let atoms = fold_right (fun acc a -> a::acc) [] in let conj = rev_ands_to_list atf in if List.for_all is_disjunction conj then List.rev_map atoms conj (* this gives a nice speedup *) else List.rev_map atoms @@ rev_ands_to_list @@ cnf_of_formula atf let to_dnf t = let atf = to_atom_formula t in let atoms = fold_right (fun acc a -> a::acc) [] in let disj = rev_ors_to_list atf in if List.for_all is_conjunction disj then List.rev_map atoms disj else List.rev_map atoms @@ rev_ors_to_list @@ dnf_of_formula atf let to_conjunction t = if is_conjunction t then atoms t else failwith (Printf.sprintf "%s is not a valid conjunction" (to_string t)) let to_disjunction t = if is_disjunction t then atoms t else failwith (Printf.sprintf "%s is not a valid disjunction" (to_string t)) let of_disjunction d = of_atom_formula (ors (List.rev_map (fun x -> Atom x) d)) let get_disjunction_formula version_set cstr = (* rev_ors_to_list cstr |> * List.fold_left *) List.rev_map (fun ff -> match ands_to_list ff with | [] -> assert false | [Atom _] as at -> at | _ -> OpamPackage.Version.Set.filter (check_version_formula ff) version_set |> OpamPackage.Version.Set.elements |> List.map (fun v -> Atom (`Eq, v))) (rev_ors_to_list cstr) |> List.flatten let set_to_disjunction set t = List.map (function | And _ -> failwith (Printf.sprintf "%s is not a valid disjunction" (to_string t)) | Or _ | Block _ | Empty -> assert false | Atom (name, Empty) -> [name, None] | Atom (name, Atom a) -> [name, Some a] | Atom (name, cstr) -> get_disjunction_formula (OpamPackage.versions_of_name set name) cstr |> List.map (function | Atom (relop, v) -> name, Some (relop, v) | _ -> assert false)) (ors_to_list t) |> List.flatten let simplify_ineq_formula vcomp f = let vals = fold_left (fun acc (_op, x) -> x::acc) [] f in let vals = List.sort_uniq vcomp vals in let vals_a = Array.of_list vals in let val_of_int i = vals_a.(i/2) in let int_of_val = let m = List.mapi (fun i v -> v, 2 * i + 1) vals in fun v -> List.assoc v m in (* One integer for each value appearing in f, plus one for each interval *) let rec mk_ranges acc n = if n < 0 then acc else mk_ranges (n::acc) (n-1) in let ranges = mk_ranges [] (2 * Array.length vals_a + 2) in let int_formula = map (fun (op, x) -> Atom (op, int_of_val x)) f in let vals = List.map (fun i -> eval (fun (relop, iref) -> check_relop relop (i - iref)) int_formula, i) ranges in if List.for_all (fun (t, _) -> not t) vals then None else let rec aux = function | (true, _) :: ((true, _) :: _ as r) -> aux r | (false, _) :: ((false, _) :: _ as r) -> aux r | (true, _) :: (false, x) :: ((true, _) :: _ as r) when x mod 2 = 1 -> (`Neq, x) :: aux r | (false, _) :: (true, x) :: ((false, _) :: _ as r) when x mod 2 = 1 -> (`Eq, x) :: aux r | (true, _) :: ((false, x) :: _ as r) -> (if x mod 2 = 1 then `Lt, x else `Leq, x-1) :: aux r | (false, _) :: ((true, x) :: _ as r) -> (if x mod 2 = 1 then `Geq, x else `Gt, x-1) :: aux r | [_] | []-> [] in let rec aux2 = function | (`Geq|`Gt|`Neq as op, i) :: r -> let rec find_upper acc = function | (`Leq|`Lt as op, i) :: r -> ands (List.rev_append acc [Atom (op, val_of_int i)]) :: aux2 r | (`Neq, i) :: r -> find_upper (Atom (`Neq, val_of_int i) :: acc) r | r -> ands (List.rev acc) :: aux2 r in find_upper [Atom (op, val_of_int i)] r | (op, i) :: r -> Atom (op, val_of_int i) :: aux2 r | [] -> [Empty] in Some (ors (aux2 (aux vals))) let simplify_version_formula f = simplify_ineq_formula OpamPackage.Version.compare f (** Takes an ordered list of atoms and a predicate, returns a formula describing the subset of matching atoms *) let gen_formula l f = let l = List.map (fun x -> f x, x) l in let rec aux (t, x as bound) l = match t, l with | true, (false, y) :: (true, _) :: r | false, (true, y) :: (false, _) :: r -> let a = (if t then `Neq else `Eq), y in (match aux bound r with | b :: r -> b :: a :: r | r -> a :: r) | true, (true, _) :: r | false, (false, _) :: r -> aux bound r | true, (false, _ as bound') :: r | false, (true, _ as bound') :: r -> ((if t then `Geq else `Lt), x) :: aux bound' r | _, [] -> [(if t then `Geq else `Lt), x] in let rec aux2 = function | (`Geq|`Neq), _ as a :: r -> let rec find_upper acc = function | `Lt, _ as a :: r -> ands (List.rev_append acc [Atom a]) :: aux2 r | `Neq, _ as a :: r -> find_upper (Atom a :: acc) r | r -> ands (List.rev acc) :: aux2 r in find_upper [Atom a] r | a :: r -> Atom a :: aux2 r | [] -> [Empty] in match l with | [] -> Some Empty | (t, x) :: r -> match aux (t, x) r with | [] -> assert false | [`Geq, _] -> Some Empty | [`Lt, _] -> None | _ :: r -> Some (ors (aux2 r)) let formula_of_version_set set subset = let module S = OpamPackage.Version.Set in match gen_formula (OpamPackage.Version.Set.elements set) (fun x -> OpamPackage.Version.Set.mem x subset) with | Some f -> f | None -> invalid_arg "Empty subset" let simplify_version_set set f = let module S = OpamPackage.Version.Set in if S.is_empty set then Empty else let set = fold_left (fun set (_relop, v) -> S.add v set) set f in gen_formula (S.elements set) (check_version_formula f) |> OpamStd.Option.default f opam-2.0.5/src/format/opamFormat.mli0000644000175000017500000002311113511367404016343 0ustar nicoonicoo(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** OPAM files syntax and conversion tools *) open OpamTypes open OpamPp (** Get the position out of a value *) val value_pos: value -> pos (** {3 low-level Pps for the Lines parser ([string list list])} *) type lines = string list list (** Provided an empty element, addition and fold operations with signatures as per Set.S, and a pp from lines to elements, returns a pp parsing from lines *) val lines_set: empty:'set -> add:('elt -> 'set -> 'set) -> fold:(('elt -> lines -> lines) -> 'set -> lines -> lines) -> (string list, 'elt) t -> (lines, 'set) t (** Provided an empty element, addition and fold operations with signatures as per Map.S, and a pp from lines to key, value pairs, returns a pp parsing from lines *) val lines_map : empty:'map -> add:('k -> 'v -> 'map -> 'map) -> fold:(('k -> 'v -> lines -> lines) -> 'map -> lines -> lines) -> (string list, 'k * 'v) t -> (lines, 'map) t (** {3 Pps for the type [value], used by opam-syntax files ([opamfile])} *) module V : sig (** These base converters raise [Unexpected] when not run on the right input (which is then converted to [Bad_format] by the parser. *) val bool : (value, bool) t val int : (value, int) t (** positive or null integer *) val pos_int : (value, int) t val ident : (value, string) t val string : (value, string) t (** Trimmed string *) val string_tr : (value, string) t (** Command arguments, i.e. strings or idents *) val simple_arg : (value, simple_arg) t (** Strings or bools *) val variable_contents : (value, variable_contents) t (** "[a b c]"; also allows just "a" to be parsed as a singleton list *) val list : (value, value list) t (** "(a b c)" *) val group : (value, value list) t (** Options in the [value] type sense, i.e. a value with an optional list of parameters in braces: ["value {op1 op2}"] *) val option : (value, value * value list) t val map_group : (value, 'a) t -> (value, 'a list) t (** An expected list depth may be specified to enable removal of extra brackets (never use [~depth] for an inner list) *) val map_list : ?depth:int -> (value, 'a) t -> (value, 'a list) t (** Normalises to the given list depth when parsing, and removes brackets that can be made implicit when printing *) val list_depth : int -> (value, value) t (** Maps on the two terms of an option constructor. *) val map_option : (value, 'a) t -> (value list, 'b) t -> (value, 'a * 'b) t (** Maps over two options (e.g. [v {op1} {op2}]) *) val map_options_2 : (value, 'a) t -> (value list, 'b) t -> (value list, 'c) t -> (value, 'a * 'b * 'c) t (** Maps over three options (e.g. [v {op1} {op2} {op3}]) *) val map_options_3 : (value, 'a) t -> (value list, 'b) t -> (value list, 'c) t -> (value list, 'd) t -> (value, 'a * 'b * 'c * 'd) t (** A pair is simply a list with two elements in the [value] type *) val map_pair : (value, 'a) t -> (value, 'b) t -> (value, 'a * 'b) t (** A triple is simply a list with three elements in the [value] type *) val map_triple : (value, 'a) t -> (value, 'b) t -> (value, 'c) t -> (value, 'a * 'b * 'c) t val url : (value, url) t (** Specialised url parser when the backend is already known *) val url_with_backend : OpamUrl.backend -> (value, url) t val compiler_version : (value, string) t val filter_ident : (value, name option list * variable * (string * string) option) t val filter : (value list, filter) t (** Arguments in commands (term + optional filter) *) val arg : (value, simple_arg * filter option) t val command : (value, (simple_arg * filter option) list * filter option) t (** Simple dependency constraints *) val constraints : (value, 'a) t -> (value list, (OpamFormula.relop * 'a) OpamFormula.formula) t (** Dependency constraints mixed with filters *) val filtered_constraints : (value, 'version) t -> (value list, 'version filter_or_constraint OpamFormula.formula) t (** Package versions *) val version: (value, version) t (** Package versions as filters, as they may appear in dependency (may be an expanded string or an ident) *) val ext_version: (value, filter) t (** A package name, encoded as a string, but with restrictions *) val pkgname: (value, name) t (** Returns an atom parser [("package" {>= "version"})] from a constraint and a version parser*) val package_atom: (value list, 'a) t -> (value, name * 'a) t (** Takes a parser for constraints. Lists without operator will be understood as conjunctions or disjunctions depending on the first argument. *) val package_formula : [< `Conj | `Disj ] -> (value list, 'a) t -> (value, (name * 'a) OpamFormula.formula) t (** Like [package_formula], but takes the list items directly *) val package_formula_items : [< `Conj | `Disj ] -> (value list, 'a) t -> (value list, (name * 'a) OpamFormula.formula) t (** Environment variable updates syntax *) val env_binding : (value, env_update) t val os_constraint : (value, (bool * string) OpamFormula.formula) t end (** {3 Specific Pps for items lists and fields (opamfile)} *) module I : sig val file : (opamfile, filename * opamfile_item list) t val map_file : (opamfile_item list, 'a) t -> (opamfile, filename * 'a) t val item : (opamfile_item, string * value) t val items : (opamfile_item list, (string * value) list) t (** Suitable for the [fields] [sections] argument, when the sections are anonymous ([section_name = None]) *) val anonymous_section : ('a, 'b) t -> ((string option * 'a) list, 'b) t type ('a, 'value) fields_def = (string * ('a, 'value) field_parser) list (** Parses an item list into a record using a fields_def; errors in a field cause the field to be ignored, and are aggregated into the returned [field, bad_format] list. Errors are ignored when printing back. *) val fields : ?name:string -> empty:'a -> ?sections: ('a, (string option * (opamfile_item list)) list) fields_def -> ?mandatory_fields:string list -> ('a, value) fields_def -> (opamfile_item list, 'a * (string * bad_format) list) t (** Intended to be piped after [fields]. If the errors list is non-empty, this raises [Bad_format_list] if [strict], and otherwise prints warnings for all the errors. The errors are then dropped when parsing, and initialised to empty when printing. [strict] is taken from the global settings if unspecified. [condition] may be added to only show the errors when it returns [true], and only log them otherwise. *) val show_errors : ?name:string -> ?strict:bool -> ?condition:('a -> bool) -> unit -> ('a * (string * bad_format) list, 'a) t (** Intended to be piped after [fields], this processes the given function on the errors, then drops them when parsing. When printing, just sets empty errors. *) val on_errors : ?name:string -> ('a -> string * bad_format -> 'a) -> ('a * (string * bad_format) list, 'a) t (** Partitions items in an opamfile base on a condition on the variable names *) val partition_fields : (string -> bool) -> (opamfile_item list, opamfile_item list * opamfile_item list) t (** Partitions items in an opamfile base on a generic condition on the items *) val partition : (opamfile_item -> bool) -> (opamfile_item list, opamfile_item list * opamfile_item list) t (** Parse a single field from a file, return the result and the unchanged item list. The single field is ignored when printing back. *) val field : string -> (pos:pos -> value -> 'a) -> (opamfile_item list, 'a option * opamfile_item list) t (** Parse a single section with the given "kind", towards its name and contents *) val section : string -> (opamfile_item, (string option * opamfile_item list)) t (** Extracts a single item with the given variable name from an item list. The item is removed from the returned item list, and the two are re-combined when printing *) val extract_field : string -> (opamfile_item list, value option * opamfile_item list) t (** Checks the [opam_version] field; otherwise the identity *) val check_opam_version : ?optional:bool -> ?f:(opam_version -> bool) -> unit -> (opamfile_item list, opamfile_item list) t (** Signature handling (wip) *) (** A signature is a keyid, an algorithm and the signature proper *) type signature = string * string * string val signature : (value, signature) t exception Invalid_signature of pos * (string * string * string) list option (** Pp for signed files. Will assert fail if attempting to write a file with an invalid signature. *) val signed: check:(signature list -> string -> bool) -> (opamfile_item list, signature list * opamfile_item list) t end opam-2.0.5/shell/0000755000175000017500000000000013511367404012565 5ustar nicoonicooopam-2.0.5/shell/print_config.ml0000644000175000017500000000077313511367404015607 0ustar nicoonicoo#directory "+compiler-libs";; #load "ocamlcommon.cma";; set_binary_mode_out stdout true;; match List.tl (Array.to_list Sys.argv) with | ["dll"] -> print_endline Config.ext_dll | ["obj"] -> print_endline Config.ext_obj | ["lib"] -> print_endline Config.ext_lib | ["arch"] -> print_endline Config.architecture | ["ccomp_type"] -> print_endline Config.ccomp_type | ["system"] -> print_endline Config.system | ["os_type"] -> print_endline Sys.os_type | _ -> prerr_endline "print_config.ml: wrong usage"; exit 2 opam-2.0.5/shell/dot_ocamlinit0000644000175000017500000000014113511367404015331 0ustar nicoonicoolet () = try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") with Not_found -> () ;;opam-2.0.5/shell/check_linker0000644000175000017500000000066713511367404015142 0ustar nicoonicoo#!/usr/bin/env bash # Ensure that the Microsoft Linker isn't being messed up by /usr/bin/link FIRST=1 FAULT=0 PREPEND= while IFS= read -r line; do OUTPUT=$("$line" --version 2>/dev/null | head -1 | fgrep "Microsoft (R) Incremental Linker") if [ "x$OUTPUT" = "x" -a $FIRST -eq 1 ] ; then FAULT=1 elif [ $FAULT -eq 1 ] ; then PREPEND=$(dirname "$line"): FAULT=0 fi done < <(which --all link) echo $PATH_PREPEND$PREPEND opam-2.0.5/shell/bundle.sh0000755000175000017500000001424613511367404014404 0ustar nicoonicoo#!/usr/bin/env bash set -ue OCAMLV=4.04.1 OPAMV=2.0.5 OPAM_REPO=https://opam.ocaml.org/2.0 DEBUG= MAKESELF= INSTALL_PACKAGES=() TARGET= help() { echo "Usage: $0 [OPTIONS] PACKAGES..." echo " OPTIONS:" echo " --help -h This help" echo " --ocaml VERSION Select a version of OCaml to include. Must be able to compile opam." echo " --opam VERSION Select a version of opam to include. Must be at least 2.0.0~beta3" echo " --repo URL Archive or git repository containing the opam package repository to use" echo " --debug -d Add debug messages" echo " --makeself Generate a self-extracting bundle using 'makeself' instead of a tar archive" echo " -o FILE Output the bundle to the given FILE" echo " PACKAGES:" echo " Select the opam packages to be packed and installed by the bundle install script." } while [ $# -gt 0 ]; do case $1 in --help|-h) help; exit 0;; --ocaml) if [ $# -lt 2 ]; then echo "Missing argument to $1" >&2; exit 2; fi shift; OCAMLV=$1;; --opam) if [ $# -lt 2 ]; then echo "Missing argument to $1" >&2; exit 2; fi shift; OPAMV=$1;; --repo) if [ $# -lt 2 ]; then echo "Missing argument to $1" >&2; exit 2; fi OPAM_REPO=$1;; --debug) DEBUG=1;; --makeself) MAKESELF=1;; -o) if [ $# -lt 2 ]; then echo "Missing argument to $1" >&2; exit 2; fi TARGET="$(cd $(dirname "$1"); pwd)/$(basename "$1")";; -*) echo "Unrecognised option $1" >&2 help; exit 2;; *) INSTALL_PACKAGES+=("$1") esac shift done OPAMTAG=${OPAMV//\~/-} BOOTSTRAP_PACKAGES=("depext" "ocaml-base-compiler.$OCAMLV") PACKAGES=("${INSTALL_PACKAGES[@]}" "${BOOTSTRAP_PACKAGES[@]}") if [ -z "$TARGET" ]; then if [ -n "$MAKESELF" ]; then TARGET="$PWD/${INSTALL_PACKAGES[0]}-installer.sh" else TARGET="$PWD/${INSTALL_PACKAGES[0]}-bundle.tar.gz" fi fi comma() ( IFS=, ; echo "$*"; ) TMP=$(mktemp -d /tmp/opam-bundle.XXXX) CONTENT="$TMP/$(basename ${TARGET%%.*})" REPO="$CONTENT/repo" mkdir -p "$CONTENT" if [ -n "$DEBUG" ]; then trap "rm -rf /tmp/${TMP#/tmp/}" EXIT set -x fi title() { printf "\n\e[33m===================\e[m %-39s \e[33m===================\e[m\n\n" "$*" } title "Getting opam repository" if [ "X${OPAM_REPO%.git}" != "X$OPAM_REPO" ] || [ "X${OPAM_REPO#git}" != "X$OPAM_REPO" ]; then git clone "$OPAM_REPO" "$REPO" --depth 1 rm -rf "$REPO/.git" else wget "$OPAM_REPO/index.tar.gz" -O "$REPO.tar.gz" mkdir -p "$REPO" cd "$REPO" tar xzf "$REPO.tar.gz" rm -f "$REPO.tar.gz" fi cd "$REPO" opam admin upgrade rm -rf compilers title "Selecting and downloading packages" opam admin filter --or \ --resolve "ocaml-system.$OCAMLV",$(comma "${INSTALL_PACKAGES[@]}") \ --resolve $(comma "${BOOTSTRAP_PACKAGES[@]}") opam admin cache --link archives title "Downloading bootstrap archives" cd "$CONTENT" wget "https://github.com/ocaml/opam/releases/download/$OPAMTAG/opam-full-$OPAMTAG.tar.gz" cat <common.sh DIR=\$( cd \$(dirname "\$0") && pwd ) PREFIX="\$DIR/bootstrap" OPAMROOT="\$DIR/opam" LOG="\$DIR/\$(basename "\$0").log" title() { printf "\n\e[33m================\e[m %-45s \e[33m================\e[m\n\n" "\$*" } logged_cmd() { printf "\$1... " shift echo "+ [ \$1 ] \$*" >>\$LOG "\$@" >>\$LOG 2>&1 echo >>\$LOG printf "\e[32mDone\e[m\n" } trap "if [ \$? -ne 0 ]; then printf '\nSomething went wrong, see log in \$LOG\n'; fi" EXIT export PATH="\$PREFIX/bin:\$PATH" export CAML_LD_LIBRARY_PATH="\$PREFIX/lib/ocaml/stublibs" export OPAMROOT cd \$DIR EOF cat <bootstrap.sh #!/bin/sh -ue . "\$(dirname "\$0")/common.sh" if [ -x "\$PREFIX/bin/ocamlc" ]; then echo "Already compiled OCaml found" else title "Bootstrap: compiling OCaml" echo "This may take a while. Output is in \$LOG" logged_cmd "Uncompressing" tar xzf repo/archives/ocaml-base-compiler."$OCAMLV"/* cd "ocaml-$OCAMLV" logged_cmd "Configuring" ./configure -prefix "\$PREFIX" logged_cmd "Compiling" make world world.opt logged_cmd "Installing to temp prefix" make install cd "\$DIR" fi if [ -x "\$PREFIX/bin/opam" ]; then echo "Already compiled opam found" else title "Bootstrap: compiling opam" echo "This may take a while. Output is in \$LOG" logged_cmd "Uncompressing" tar xzf "opam-full-$OPAMTAG.tar.gz" cd "opam-full-$OPAMTAG" logged_cmd "Configuring" ./configure --prefix "\$PREFIX" logged_cmd "Compiling extra dependencies" make lib-ext logged_cmd "Compiling" make logged_cmd "Installing to temp prefix" make install cd "\$DIR" fi EOF cat <configure.sh #!/bin/sh -ue . \$(dirname \$0)/common.sh "\$DIR/bootstrap.sh" if [ -d "\$OPAMROOT/default" ]; then echo "Already initialised opam sandbox found" else title "Configure: initialising opam" if [ ! -f "\$OPAMROOT/config" ]; then logged_cmd "Initialising" opam init --bare --no-setup \$DIR/repo fi logged_cmd "Creating sandbox" opam switch create default ocaml-system fi title "Configure: bootstrapping auxiliary utilities" logged_cmd "Compiling bootstrap utilities" opam install depext --yes title "Configure: getting system dependencies" echo "You may be asked for 'sudo' access to install required system dependencies through your package system" opam depext ${INSTALL_PACKAGES[@]} touch has_depexts EOF cat <compile.sh #!/bin/sh -ue . \$(dirname \$0)/common.sh if [ \$# -ne 1 ] || [ "X\${1#-}" != "X\$1" ] ; then echo "Usage: \$0 PREFIX" echo " Bootstraps and compiles ${INSTALL_PACKAGES[*]}, then installs to the given prefix" exit 2 fi DESTDIR="\$1" if [ ! -e has_depexts ]; then "\$DIR/configure.sh"; fi title "Compile: installing packages" opam install --yes --destdir "\$DESTDIR" ${INSTALL_PACKAGES[@]} EOF chmod a+x bootstrap.sh configure.sh compile.sh cd $(dirname "$CONTENT") if [ -n "$MAKESELF" ]; then makeself $(basename "$CONTENT") "$TARGET" "$(basename "${TARGET%%.*}")" ./compile.sh else tar cz $(basename "$CONTENT") -f "$TARGET" fi echo "Bundle has been generated as $TARGET" opam-2.0.5/shell/bootstrap-ocaml.sh0000755000175000017500000001124413511367404016234 0ustar nicoonicoo#!/bin/sh -e GEN_CONFIG_ONLY=${GEN_CONFIG_ONLY:-0} if command -v curl > /dev/null; then CURL="curl -OLSfs" elif command -v wget > /dev/null; then CURL=wget else echo "This script requires curl or wget" exit 1 fi mkdir -p bootstrap cd bootstrap URL=`sed -ne 's/URL_ocaml *= *//p' ../src_ext/Makefile | tr -d '\r'` MD5=`sed -ne 's/MD5_ocaml *= *//p' ../src_ext/Makefile | tr -d '\r'` V=`echo ${URL}| sed -e 's|.*/\([^/]*\)\.tar\.gz|\1|'` FV_URL=`sed -ne 's/URL_flexdll *= *//p' ../src_ext/Makefile | tr -d '\r'` FLEXDLL=`echo ${FV_URL}| sed -e 's|.*/\([^/]*\)|\1|'` if [ ! -e ${V}.tar.gz ]; then cp ../src_ext/archives/${V}.tar.gz . 2>/dev/null || ${CURL} ${URL} fi ACTUALMD5=`openssl md5 ${V}.tar.gz 2> /dev/null | cut -f 2 -d ' '` if [ "$ACTUALMD5" != "$MD5" ]; then echo "Bad checksum for ${V}.tar.gz:" echo "- expected: $MD5" echo "- actual: $ACTUALMD5" exit 2 fi if [ ${GEN_CONFIG_ONLY} -eq 0 ] ; then tar -zxf ${V}.tar.gz else mkdir -p ${V} fi cd ${V} PATH_PREPEND= LIB_PREPEND= INC_PREPEND= if [ -n "$1" -a -n "${COMSPEC}" -a -x "${COMSPEC}" ] ; then case "$1" in "mingw"|"mingw64") BUILD=$1 ;; "msvc") BUILD=$1 if ! command -v ml > /dev/null ; then eval `../../shell/msvs-detect --arch=x86` if [ -n "${MSVS_NAME}" ] ; then PATH_PREPEND="${MSVS_PATH}" LIB_PREPEND="${MSVS_LIB};" INC_PREPEND="${MSVS_INC};" fi fi ;; "msvc64") BUILD=$1 if ! command -v ml64 > /dev/null ; then eval `../../shell/msvs-detect --arch=x64` if [ -n "${MSVS_NAME}" ] ; then PATH_PREPEND="${MSVS_PATH}" LIB_PREPEND="${MSVS_LIB};" INC_PREPEND="${MSVS_INC};" fi fi ;; *) if [ "$1" != "auto" ] ; then echo "Compiler architecture $1 not recognised -- mingw64, mingw, msvc64, msvc (or auto)" fi if [ -n "${PROCESSOR_ARCHITEW6432}" -o "${PROCESSOR_ARCHITECTURE}" = "AMD64" ] ; then TRY64=1 else TRY64=0 fi if [ ${TRY64} -eq 1 ] && command -v x86_64-w64-mingw32-gcc > /dev/null ; then BUILD=mingw64 elif command -v i686-w64-mingw32-gcc > /dev/null ; then BUILD=mingw elif [ ${TRY64} -eq 1 ] && command -v ml64 > /dev/null ; then BUILD=msvc64 PATH_PREPEND=`bash ../../shell/check_linker` elif command -v ml > /dev/null ; then BUILD=msvc PATH_PREPEND=`bash ../../shell/check_linker` else if [ ${TRY64} -eq 1 ] ; then BUILD=msvc64 BUILD_ARCH=x64 else BUILD=msvc BUILD_ARCH=x86 fi eval `../../shell/msvs-detect --arch=${BUILD_ARCH}` if [ -z "${MSVS_NAME}" ] ; then echo "No appropriate C compiler was found -- unable to build OCaml" exit 1 else PATH_PREPEND="${MSVS_PATH}" LIB_PREPEND="${MSVS_LIB};" INC_PREPEND="${MSVS_INC};" fi fi ;; esac if [ -n "${PATH_PREPEND}" ] ; then PATH_PREPEND="${PATH_PREPEND}:" fi PREFIX=`cd .. ; pwd`/ocaml WINPREFIX=`echo ${PREFIX} | cygpath -f - -m` if [ ${GEN_CONFIG_ONLY} -eq 0 ] ; then sed -e "s|^PREFIX=.*|PREFIX=${WINPREFIX}|" -e "s|/lib|/lib/ocaml|" config/Makefile.${BUILD} > config/Makefile cp config/s-nt.h byterun/caml/s.h cp config/m-nt.h byterun/caml/m.h fi cd .. if [ ! -e ${FLEXDLL} ]; then cp ../src_ext/archives/${FLEXDLL} . 2>/dev/null || ${CURL} ${FV_URL} fi cd ${V} if [ ${GEN_CONFIG_ONLY} -eq 0 ] ; then tar -xzf ../${FLEXDLL} rm -rf flexdll mv flexdll-* flexdll PATH="${PATH_PREPEND}${PREFIX}/bin:${PATH}" Lib="${LIB_PREPEND}${Lib}" Include="${INC_PREPEND}${Include}" make flexdll world.opt install fi OCAMLLIB=${WINPREFIX}/lib/ocaml else PREFIX=`cd .. ; pwd`/ocaml if [ ${GEN_CONFIG_ONLY} -eq 0 ] ; then ./configure -prefix "${PREFIX}" ${MAKE:-make} world opt.opt ${MAKE:-make} install fi OCAMLLIB=${PREFIX}/lib/ocaml fi if [ ${GEN_CONFIG_ONLY} -eq 0 ] ; then echo "${URL} ${FV_URL}" > ../installed-tarball fi # Generate src_ext/Makefile.config PATH_PREPEND=`echo "${PATH_PREPEND}" | sed -e 's/#/\\\\#/g' -e 's/\\$/$$/g'` echo "export PATH:=${PATH_PREPEND}${PREFIX}/bin:\$(PATH)" > ../../src_ext/Makefile.config if [ -n "${LIB_PREPEND}" ] ; then LIB_PREPEND=`echo ${LIB_PREPEND} | sed -e 's/#/\\\\#/g' -e 's/\\$/$$/g'` echo "export Lib:=${LIB_PREPEND}\$(Lib)" >> ../../src_ext/Makefile.config fi if [ -n "${INC_PREPEND}" ] ; then INC_PREPEND=`echo ${INC_PREPEND} | sed -e 's/#/\\\\#/g' -e 's/\\$/$$/g'` echo "export Include:=${INC_PREPEND}\$(Include)" >> ../../src_ext/Makefile.config fi echo "export OCAMLLIB=${OCAMLLIB}" >> ../../src_ext/Makefile.config opam-2.0.5/shell/subst_var.ml0000644000175000017500000000403013511367404015124 0ustar nicoonicoolet name = Printf.sprintf "@%s@" Sys.argv.(1) in let value = let file, magic = let root = let rec process acc dir = let dir' = Filename.dirname dir in let base = Filename.basename dir in if dir' = dir then failwith "Invalid invocation - couldn't locate build root" else let acc = Filename.concat acc Filename.parent_dir_name in if base = "_build" then acc else process acc dir' in process "" (Sys.getcwd ()) in let file = Filename.concat root "config.status" in if Sys.file_exists file then file, Printf.sprintf "S[\"%s\"]=\"" Sys.argv.(1) else if Sys.argv.(1) = "PACKAGE_VERSION" then Filename.concat root "configure.ac", "AC_INIT(opam," else "", "" in if file <> "" then let c = open_in file in let magic_l = String.length magic in (* End_of_file is permitted to leak as the failure of this build step *) let rec process () = let line = input_line c in let line_l = String.length line in if line_l > magic_l then if String.sub line 0 magic_l = magic then begin close_in c; Scanf.unescaped @@ String.sub line magic_l (line_l - magic_l - 1) end else process () else process () in process () else Sys.argv.(2) in let cin = open_in Sys.argv.(3) in let name_l = String.length name in let rec process () = match input_line cin with | exception End_of_file -> close_in cin | line -> begin try let idx = String.index line '@' in let line_l = String.length line in if line_l > idx + name_l - 1 && String.sub line idx name_l = name then begin if idx > 0 then print_string (String.sub line 0 idx); print_string value; print_endline (String.sub line (idx + name_l) (line_l - idx - name_l)); end else print_endline line with Not_found -> print_endline line end; process () in process () opam-2.0.5/shell/opam-bin-cache.sh0000755000175000017500000000267513511367404015701 0ustar nicoonicoo#!/bin/sh -uex COMMAND=$1; shift ID=$1; shift if [ -z "$ID" ]; then if [ $COMMAND = wrap ]; then exec "$@" else exit 0 fi fi CACHE_DIR=~/.cache/opam-bin-cache/$ID case $COMMAND in restore) NAME=$1; shift if [ -d "$CACHE_DIR" ]; then rm -f "$NAME.install" cp -aT "$CACHE_DIR/" "$OPAM_SWITCH_PREFIX/" else exit 0 fi;; wrap) if [ -d "$CACHE_DIR" ]; then exit 0 else exec "$@" fi;; store) if [ -d "$CACHE_DIR" ]; then exit 0 else for f in "$@"; do echo "STORING FILE: $f" if [ -d "$OPAM_SWITCH_PREFIX/$f" ]; then mkdir -p "$CACHE_DIR/$f" else mkdir -p "$(dirname "$CACHE_DIR/$f")" cp -aT "$OPAM_SWITCH_PREFIX/$f" "$CACHE_DIR/$f" fi done fi;; *) echo "Invalid command '$COMMAND'. Valid commands:" >&2 echo " restore ID NAME" >&2 echo " wrap ID COMMAND [ARGS]..." >&2 echo " store ID [FILES]..." >&2 exit 2 esac # Use as: # pre-install-commands: ["opam-bin-cache.sh" "restore" build-id name] {?build-id} # wrap-build-commands: ["opam-bin-cache.sh" "wrap" build-id] {?build-id} # wrap-install-commands: ["opam-bin-cache.sh" "wrap" build-id] {?build-id} # post-install-commands: ["opam-bin-cache.sh" "store" build-id installed-files] {?build-id & error-code = 0} opam-2.0.5/shell/wrap-remove.sh0000755000175000017500000000306713511367404015376 0ustar nicoonicoo#!/bin/sh -e USERID=$(id -u) GROUPID=$(id -g) # Run in separate user, network and mount namespace # -r maps USERID to root, which is needed for doing the mounts, then we map it # back to USERID in a child namespace for running the child process exec unshare -Umnr /bin/sh -es "$@" <\$tmpup & pid=\$! exec 3>\$tmpdown 4<\$tmpup # Synchronise to make sure the child ns is ready echo 'echo >&4' >&3; read sync <&4 # Setup the uid and gid map (reverse of what 'unshare -r' did) to get back to # the original uid echo "$USERID 0 1" >/proc/\$pid/uid_map echo "$GROUPID 0 1" >/proc/\$pid/gid_map # Exec the original command that was passed through argv to the child shell echo 'exec "\$@"' >&3 # Cleanup exec 3>&- 4<&- wait \$pid EOF opam-2.0.5/shell/install.sh0000755000175000017500000002176213511367404014602 0ustar nicoonicoo#!/bin/sh set -ue # (c) Copyright Fabrice Le Fessant INRIA/OCamlPro 2013 # (c) Copyright Louis Gesbert OCamlPro 2014-2017 VERSION='2.0.0~rc3' TAG=$(echo "$VERSION" | tr '~' '-') DEFAULT_BINDIR=/usr/local/bin usage() { echo "opam binary installer v.$VERSION" echo "Downloads and installs a pre-compiled binary of opam $VERSION to the system." echo "This can also be used to switch between opam versions" echo echo "Options:" echo " --no-backup Don't attempt to backup the current opam root" echo " --backup Force the backup the current opam root (even if it" echo " is from the 2.0 branch already)" echo " --fresh Create the opam $VERSION root from scratch" echo " --restore VERSION Restore a backed up opam binary and root" echo echo "The default is to backup if the current version of opam is 1.*, or when" echo "using '--fresh'" } RESTORE= NOBACKUP= FRESH= while [ $# -gt 0 ]; do case "$1" in --restore) if [ $# -lt 2 ]; then echo "Option $1 requires an argument"; exit 2; fi shift; RESTORE=$1;; --no-backup) NOBACKUP=1;; --backup) NOBACKUP=0;; --fresh) FRESH=1;; --help|-h) usage; exit 0;; *) usage; exit 2;; esac shift done EXISTING_OPAM=$(command -v opam || echo) EXISTING_OPAMV= if [ -n "$EXISTING_OPAM" ]; then EXISTING_OPAMV=$("$EXISTING_OPAM" --version || echo "unknown") fi FRESH=${FRESH:-0} OPAMROOT=${OPAMROOT:-$HOME/.opam} if [ ! -d "$OPAMROOT" ]; then FRESH=1; fi if [ -z "$NOBACKUP" ] && [ ! "$FRESH" = 1 ] && [ -z "$RESTORE" ]; then case "$EXISTING_OPAMV" in 2.*) NOBACKUP=1;; *) NOBACKUP=0;; esac fi xsudo() { local CMD=$1; shift local DST for DST in "$@"; do : ; done local DSTDIR=$(dirname "$DST") if [ ! -w "$DSTDIR" ]; then echo "Write access to $DSTDIR required, using 'sudo'." echo "Command: $CMD $@" if [ "$CMD" = "install" ]; then sudo "$CMD" -g root -o root "$@" else sudo "$CMD" "$@" fi else "$CMD" "$@" fi } if [ -n "$RESTORE" ]; then OPAM=$(command -v opam) OPAMV=$("$OPAM" --version) OPAM_BAK="$OPAM.$RESTORE" OPAMROOT_BAK="$OPAMROOT.$RESTORE" if [ ! -e "$OPAM_BAK" ] || [ ! -d "$OPAMROOT_BAK" ]; then echo "No backup of opam $RESTORE was found" exit 1 fi if [ "$NOBACKUP" = 1 ]; then printf "## This will clear $OPAM and $OPAMROOT. Continue ? [Y/n] " read R case "$R" in ""|"y"|"Y"|"yes") xsudo rm -f "$OPAM" rm -rf "$OPAMROOT";; *) exit 1 esac else xsudo mv "$OPAM" "$OPAM.$OPAMV" mv "$OPAMROOT" "$OPAMROOT.$OPAMV" fi xsudo mv "$OPAM_BAK" "$OPAM" mv "$OPAMROOT_BAK" "$OPAMROOT" printf "## Opam $RESTORE and its root were restored." if [ "$NOBACKUP" = 1 ]; then echo else echo " Opam $OPAMV was backed up." fi exit 0 fi TMP=${TMPDIR:-/tmp} ARCH=$(uname -m || echo unknown) case "$ARCH" in x86|i?86) ARCH="i686";; x86_64|amd64) ARCH="x86_64";; ppc|powerpc|ppcle) ARCH="ppc";; aarch64_be|aarch64|armv8b|armv8l) ARCH="arm64";; armv5*|armv6*|earmv6*|armv7*|earmv7*) ARCH="armhf";; *) ARCH=$(echo "$ARCH" | awk '{print tolower($0)}') esac OS=$(uname -s || echo unknown) case "$OS" in darwin|macos) OS=darwin;; *) OS=$(echo "$OS" | awk '{print tolower($0)}') esac OPAM_BIN="opam-${TAG}-${ARCH}-${OS}" OPAM_BIN_URL="https://github.com/ocaml/opam/releases/download/${TAG}/${OPAM_BIN}" download() { if command -v wget >/dev/null; then wget -q -O "$@" else curl -s -L -o "$@" fi } bin_sha512() { case "$OPAM_BIN" in opam-2.0.0-rc3-amd64-openbsd) echo "7313cd2c39dc28fa9c3de47ed2274ceee48865d74a4a9315dc120459cf57c9b3a5262b343412149cda5379b2ac2eb7cfb387764c8ca5b4e1e0831b275c4acf6f";; opam-2.0.0-rc3-arm64-linux) echo "589a8c1842c636caabf9108f95b5f288261f5e621b74b1afa731333f0d5010c10a967153f9c4ca5828ecd4e66326b0b1d679ccb8ad92d07aefc66ae85ea10971";; opam-2.0.0-rc3-armhf-linux) echo "0ebd8662b2d1972b12e38245d3625867fb173bf6939a8c728e0cc349867d5b31103488674665d77be9ad2dc881b3508a947640019b6b48c6821ccece481cf2bc";; opam-2.0.0-rc3-i686-linux) echo "18da8fb4ce5270e51becbde47e8b5b6a855a970820f85f01fcdca1a28cef1ad5b51f0c53f60f89f45192d0f310c4e441da267f2dbc3616e16f68128bb86af2ae";; opam-2.0.0-rc3-x86_64-darwin) echo "229c0623df54561285182570a72c7860f5398532fbfb33d7c90d345fba25fcd43f13e806aa232089da9303481f6c65535dedfff0077ba1d4b96f76b191ca24c6";; opam-2.0.0-rc3-x86_64-linux) echo "f479ec7dd891bb200376fd674a02ff5283c9ca812be5a83138739d39f9d7221ac920c530937573cf789d976b60c822efa49066cdf2b34f61e740835e6fb1a37c";; *) echo "no sha";; esac } check_sha512() { if command -v openssl > /dev/null && [ "$(openssl sha512 2>&1 < /dev/null)" = "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" ]; then sha512=`openssl sha512 "$TMP/$OPAM_BIN" 2> /dev/null | cut -f 2 -d ' '` check=`bin_sha512` test "x$sha512" = "x$check" else echo "openssl not found, binary integrity check can't be performed." return 0 fi } if [ -e "$TMP/$OPAM_BIN" ] && ! check_sha512 || [ ! -e "$TMP/$OPAM_BIN" ]; then echo "## Downloading opam $VERSION for $OS on $ARCH..." if ! download "$TMP/$OPAM_BIN" "$OPAM_BIN_URL"; then echo "There may not yet be a binary release for your architecture or OS, sorry." echo "See https://github.com/ocaml/opam/releases/tag/$TAG for pre-compiled binaries," echo "or run 'make cold' from https://github.com/ocaml/opam/archive/$TAG.tar.gz" echo "to build from scratch" exit 10 else if check_sha512; then echo "## Downloaded." else echo "Checksum mismatch, a problem occurred during download." exit 10 fi fi else echo "## Using already downloaded \"$TMP/$OPAM_BIN\"" fi if [ -n "$EXISTING_OPAM" ]; then DEFAULT_BINDIR=$(dirname "$EXISTING_OPAM") fi while true; do printf "## Where should it be installed ? [$DEFAULT_BINDIR] " read BINDIR if [ -z "$BINDIR" ]; then BINDIR="$DEFAULT_BINDIR"; fi if [ -d "$BINDIR" ]; then break else printf "## $BINDIR does not exist. Create ? [Y/n] " read R case "$R" in ""|"y"|"Y"|"yes") mkdir -p $BINDIR break;; esac fi done if [ -e "$EXISTING_OPAM" ]; then if [ "$NOBACKUP" = 1 ]; then xsudo rm -f "$EXISTING_OPAM" else xsudo mv "$EXISTING_OPAM" "$EXISTING_OPAM.$EXISTING_OPAMV" echo "## $EXISTING_OPAM backed up as $(basename $EXISTING_OPAM).$EXISTING_OPAMV" fi fi if [ -d "$OPAMROOT" ]; then if [ "$FRESH" = 1 ]; then if [ "$NOBACKUP" = 1 ]; then printf "## This will clear $OPAMROOT. Continue ? [Y/n] " read R case "$R" in ""|"y"|"Y"|"yes") rm -rf "$OPAMROOT";; *) exit 1 esac else mv "$OPAMROOT" "$OPAMROOT.$EXISTING_OPAMV" echo "## $OPAMROOT backed up as $(basename $OPAMROOT).$EXISTING_OPAMV" fi echo "## opam $VERSION installed. Please run 'opam init' to get started" elif [ ! "$NOBACKUP" = 1 ]; then echo "## Backing up $OPAMROOT to $(basename $OPAMROOT).$EXISTING_OPAMV (this may take a while)" if [ -e "$OPAMROOT.$EXISTING_OPAMV" ]; then echo "ERROR: there is already a backup at $OPAMROOT.$EXISTING_OPAMV" echo "Please move it away or run with --no-backup" fi FREE=$(df -k "$OPAMROOT" | awk 'NR>1 {print $4}') NEEDED=$(du -sk "$OPAMROOT" | awk '{print $1}') if ! [ $NEEDED -lt $FREE ]; then echo "Error: not enough free space to backup. You can retry with --no-backup," echo "--fresh, or remove '$OPAMROOT'" exit 1 fi cp -a "$OPAMROOT" "$OPAMROOT.$EXISTING_OPAMV" echo "## $OPAMROOT backed up as $(basename $OPAMROOT).$EXISTING_OPAMV" fi rm -f "$OPAMROOT"/repo/*/*.tar.gz* fi xsudo install -m 755 "$TMP/$OPAM_BIN" "$BINDIR/opam" echo "## opam $VERSION installed to $BINDIR" if [ ! "$FRESH" = 1 ]; then echo "## Converting the opam root format & updating" "$BINDIR/opam" init --reinit -ni fi WHICH=$(command -v opam || echo notfound) case "$WHICH" in "$BINDIR/opam") ;; notfound) echo "## Remember to add $BINDIR to your PATH";; *) echo "## WARNING: 'opam' command found in PATH does not match the installed one:" echo " - Installed: '$BINDIR/opam'" echo " - Found: '$WHICH'" echo "Make sure to remove the second or fix your PATH to use the new opam" echo esac if [ ! "$NOBACKUP" = 1 ]; then echo "## Run this script again with '--restore $EXISTING_OPAMV' to revert." fi rm -f $TMP/$OPAM_BIN opam-2.0.5/shell/opam_installer.sh0000755000175000017500000000500613511367404016136 0ustar nicoonicoo#!/bin/sh set -ue # NOTE: this file is here for legacy reasons. It is advised to use the newer # 'install.sh' instead. # (c) Copyright Fabrice Le Fessant INRIA/OCamlPro 2013 # (c) Copyright Louis Gesbert OCamlPro 2014-2015 VERSION='1.2.2' default_ocaml=4.05.0 usage() { cat <&2 for s in "$@"; do echo $s; done exit 1 } TMP=${TMPDIR:-/tmp} dlerror () { error "Couldn't download $url" \ "There may not yet be a binary release for your architecture or OS, sorry." } getopam() { opamfile=$2 url=$1/$opamfile if which wget >/dev/null; then wget -q -O "$TMP/$opamfile" "$url" || dlerror else curl -s -L -o "$TMP/$opamfile" "$url" || dlerror fi } if [ $# -lt 1 ] || [ $# -gt 2 ] || [ "${1#-}" != "$1" ]; then echo "opam binary installer v. $VERSION" usage fi BINDIR=$1 COMP=${2:-$default_ocaml} file="opam-$VERSION-$(uname -m || echo unknown)-$(uname -s || echo unknown)" echo Downloading opam... getopam "https://github.com/ocaml/opam/releases/download/$VERSION" $file mkdir -p "$BINDIR" 2>/dev/null || true if [ ! -w "$BINDIR" ]; then echo "You don't have write access to $BINDIR: sudo may ask for your password" if [ ! -d "$BINDIR" ]; then sudo mkdir -p "$BINDIR"; fi sudo install -g root -o root -m 755 $TMP/$file $BINDIR/opam else install -m 755 $TMP/$file $BINDIR/opam fi rm -f $TMP/$file OPAM=$(which opam || echo "$BINDIR/opam") if [ "$OPAM" != "$BINDIR/opam" ]; then echo "WARNING: you have a different version of opam installed at $OPAM" echo "It is highly recommended that you remove it." read -p "[press enter to continue]" x OPAM="$BINDIR/opam" fi if [ "$(id -u)" = "0" ]; then echo "Running as super-user: not running opam initialization." echo "You'll want to run \"$OPAM init --comp $COMP\" as user" else echo "Initializing with compiler $COMP" "$OPAM" init --comp "$COMP" fi echo "Installation done. If you need to uninstall, simply remove $BINDIR/opam" echo "and ~/.opam" opam-2.0.5/shell/wrap-install.sh0000755000175000017500000000312213511367404015537 0ustar nicoonicoo#!/bin/sh -e USERID=$(id -u) GROUPID=$(id -g) # Run in separate user, network and mount namespace # -r maps USERID to root, which is needed for doing the mounts, then we map it # back to USERID in a child namespace for running the child process exec unshare -Umnr /bin/sh -es "$@" <\$tmpup & pid=\$! exec 3>\$tmpdown 4<\$tmpup # Synchronise to make sure the child ns is ready echo 'echo >&4' >&3; read sync <&4 # Setup the uid and gid map (reverse of what 'unshare -r' did) to get back to # the original uid echo "$USERID 0 1" >/proc/\$pid/uid_map echo "$GROUPID 0 1" >/proc/\$pid/gid_map # Exec the original command that was passed through argv to the child shell echo 'exec "\$@"' >&3 # Cleanup exec 3>&- 4<&- wait \$pid EOF opam-2.0.5/shell/crunch.ml0000644000175000017500000000150213511367404014377 0ustar nicoonicoolet add_chan buf chan = try while true do let line = input_line chan in Buffer.add_string buf line; Buffer.add_char buf '\n' done with End_of_file -> () let () = let buf = Buffer.create 1024 in print_endline "(* THIS FILE IS AUTOMATICALLY GENERATED, EDIT ../Makefile INSTEAD *)"; for i = 1 to Array.length Sys.argv - 1 do let file = Sys.argv.(i) in let name = let file = Filename.basename file in if Filename.check_suffix file ".sh" then Filename.chop_extension file else String.map (function '.' -> '_' | c -> c) file in let c = open_in_bin file in Buffer.clear buf; add_chan buf c; close_in c; let contents = Buffer.contents buf in Printf.printf "let %s =\n\"%s\"\n\n" name (String.escaped contents) done opam-2.0.5/shell/msvs-detect0000644000175000017500000011452013511367404014751 0ustar nicoonicoo#!/usr/bin/env bash # ################################################################################################ # # MetaStack Solutions Ltd. # # ################################################################################################ # # Microsoft C Compiler Environment Detection Script # # ################################################################################################ # # Copyright (c) 2016, 2017, 2018 MetaStack Solutions Ltd. # # ################################################################################################ # # Author: David Allsopp # # 16-Feb-2016 # # ################################################################################################ # # Redistribution and use in source and binary forms, with or without modification, are permitted # # provided that the following two conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, this list of # # conditions and the following disclaimer. # # 2. Neither the name of MetaStack Solutions Ltd. nor the names of its contributors may be # # used to endorse or promote products derived from this software without specific prior # # written permission. # # # # This software is provided by the Copyright Holder 'as is' and any express or implied warranties # # including, but not limited to, the implied warranties of merchantability and fitness for a # # particular purpose are disclaimed. In no event shall the Copyright Holder be liable for any # # direct, indirect, incidental, special, exemplary, or consequential damages (including, but not # # limited to, procurement of substitute goods or services; loss of use, data, or profits; or # # business interruption) however caused and on any theory of liability, whether in contract, # # strict liability, or tort (including negligence or otherwise) arising in any way out of the use # # use of this software, even if advised of the possibility of such damage. # # ################################################################################################ # VERSION=0.3.2 # debug [level=2] message debug () { if [[ -z ${2+x} ]] ; then DEBUG_LEVEL=2 else DEBUG_LEVEL=$1 shift fi if [[ $DEBUG -ge $DEBUG_LEVEL ]] ; then echo "$1">&2 fi } # warning message warning () { if [[ $DEBUG -gt 0 ]] ; then echo "Warning: $1">&2 fi } # reg_string key value # Retrieves a REG_SZ value from the registry (redirected on WOW64) reg_string () { reg query "$1" /v "$2" 2>/dev/null | tr -d '\r' | sed -ne "s/ *$2 *REG_SZ *//p" } # reg64_string key value # As reg_string, but without WOW64 redirection (i.e. guaranteed access to 64-bit registry) reg64_string () { $REG64 query "$1" /v "$2" 2>/dev/null | tr -d '\r' | sed -ne "s/ *$2 *REG_SZ *//p" } # find_in list file # Increments $RET if file does not exist in any of the directories in the *-separated list find_in () { debug 4 "Looking for $2" if [[ -z $1 ]] ; then STATUS=1 else IFS=* STATUS=1 for f in $1; do if [[ -e "$f/$2" ]] ; then STATUS=0 break fi done unset IFS fi if [[ $STATUS -eq 1 ]] ; then debug 4 "$2 not found" fi ((RET+=$STATUS)) } # check_environment PATH INC LIB name arch # By checking for the presence of various files, verifies that PATH, INC and LIB provide a complete # compiler and indicates this in its return status. RET is assumed to be zero on entry. $ASSEMBLER # will contain the name of assembler for this compiler series (ml.exe or ml64.exe). # The following files are checked: # cl.exe PATH Microsoft C compiler # kernel32.lib LIB Implies Windows SDK present # link.exe PATH Microsoft Linker # ml[64].exe PATH Microsoft Assembler (ml.exe or ml64.exe) # msvcrt.lib LIB Implies C Runtime Libraries present # mt.exe PATH Microsoft Manifest Tool # oldnames.lib LIB Implies C Runtime Libraries present # rc.exe PATH Microsoft Resource Compiler (implies tools present) # stdlib.h INC Implies Microsoft C Runtime Libraries present # windows.h INC Implies Windows SDK present # oldnames.lib is included, because certain SDKs and older versions don't correctly install the # entire runtime if only some options (e.g. Dynamic Runtime and not Static) are selected. check_environment () { for tool in cl rc link ; do find_in "$1" $tool.exe done if [[ $RET -gt 0 ]] ; then warning "Microsoft C Compiler tools not all found - $4 ($5) excluded" return 1 fi RET=0 find_in "$2" windows.h find_in "$3" kernel32.lib if [[ $RET -gt 0 ]] ; then warning "Windows SDK not all found - $4 ($5) excluded" return 1 fi RET=0 find_in "$2" stdlib.h find_in "$3" msvcrt.lib find_in "$3" oldnames.lib if [[ $RET -gt 0 ]] ; then warning "Microsoft C runtime library not all found - $4 ($5) excluded" return 1 fi ASSEMBLER=ml${5#x} ASSEMBLER=${ASSEMBLER%86}.exe if [[ $ML_REQUIRED -eq 1 ]] ; then RET=0 find_in "$1" $ASSEMBLER if [[ $RET -gt 0 ]] ; then warning "Microsoft Assembler ($ASSEMBLER) not found - $4 ($5)" return 1 fi fi if [[ $MT_REQUIRED -eq 1 ]] ; then RET=0 find_in "$1" mt.exe if [[ $RET -gt 0 ]] ; then warning "Microsoft Manifest Tool not found - $4 ($5)" return 1 fi fi return 0 } # output VAR value arch # Outputs a command for setting VAR to value based on $OUTPUT. If $ENV_ARCH is arch, then an empty # value (i.e. no change) is output. output () { if [[ $3 = $ENV_ARCH ]] ; then VALUE= else VALUE=$2 fi case "$OUTPUT" in 0) echo "$1='${VALUE//\'/\'\"\'\"\'}'";; 1) VALUE=${VALUE//#/\\\#} echo "$1=${VALUE//\$/\$\$}";; esac } # DEBUG Debugging level # MODE Operation mode # 0 - Normal # 1 - --all # 2 - --help # 3 - --version # OUTPUT --output option # 0 - =shell # 1 - =make # MT_REQUIRED --with-mt # ML_REQUIRED --with-assembler # TARGET_ARCH Normalised --arch (x86, x64 or blank for both) # LEFT_ARCH \ If $TARGET_ARCH is blank, these will be x86 and x64 respectively, otherwise they # RIGHT_ARCH / equal $TARGET_ARCH # SCAN_ENV Controls from parsing whether the environment should be queried for a compiler DEBUG=0 MODE=0 OUTPUT=0 MT_REQUIRED=0 ML_REQUIRED=0 TARGET_ARCH= SCAN_ENV=0 # Parse command-line. At the moment, the short option which usefully combines with anything is -d, # so for the time being, combining short options is not permitted, as the loop becomes even less # clear with getopts. GNU getopt isn't installed by default on Cygwin... if [[ $@ != "" ]] ; then while true ; do case "$1" in # Mode settings ($MODE) -a|--all) MODE=1 shift 1;; -h|--help) MODE=2 shift;; -v|--version) MODE=3 shift;; # Simple flags ($MT_REQUIRED and $ML_REQUIRED) --with-mt) MT_REQUIRED=1 shift;; --with-assembler) ML_REQUIRED=1 shift;; # -o, --output ($OUTPUT) -o|--output) case "$2" in shell) ;; make) OUTPUT=1;; *) echo "$0: unrecognised option for $1: '$2'">&2 exit 2;; esac shift 2;; -oshell|--output=shell) shift;; -omake|--output=make) OUTPUT=1 shift;; -o*) echo "$0: unrecognised option for -o: '${1#-o}'">&2 exit 2;; --output=*) echo "$0: unrecognised option for --output: '${1#--output=}'">&2 exit 2;; # -x, --arch ($TARGET_ARCH) -x|--arch) case "$2" in 86|x86) TARGET_ARCH=x86;; 64|x64) TARGET_ARCH=x64;; *) echo "$0: unrecognised option for $1: '$2'">&2 exit 2 esac shift 2;; -x86|-xx86|--arch=x86|--arch=86) TARGET_ARCH=x86 shift;; -x64|-xx64|--arch=x64|--arch=64) TARGET_ARCH=x64 shift;; -x*) echo "$0: unrecognised option for -x: '${1#-x}'">&2 exit 2;; --arch=*) echo "$0: unrecognised option for --arch: '${1#--arch}'">&2 exit 2;; # -d, --debug ($DEBUG) -d*) DEBUG=${1#-d} if [[ -z $DEBUG ]] ; then DEBUG=1 fi shift;; --debug=*) DEBUG=${1#*=} shift;; --debug) DEBUG=1 shift;; # End of option marker --) shift break;; # Invalid options --*) echo "$0: unrecognised option: '${1%%=*}'">&2 exit 2;; -*) echo "$0: unrecognised option: '${1:1:1}'">&2 exit 2;; # MSVS_PREFERENCE (without end-of-option marker) *) break;; esac done if [[ -n ${1+x} ]] ; then if [[ $MODE -eq 1 ]] ; then echo "$0: cannot specify MSVS_PREFERENCE and --all">&2 exit 2 else MSVS_PREFERENCE="$@" fi fi fi # Options sanitising if [[ $MODE -eq 1 ]] ; then if [[ -n $TARGET_ARCH ]] ; then echo "$0: --all and --arch are mutually exclusive">&2 exit 2 fi MSVS_PREFERENCE= SCAN_ENV=1 elif [[ -z ${MSVS_PREFERENCE+x} ]] ; then MSVS_PREFERENCE='@;VS15.*;VS14.0;VS12.0;VS11.0;10.0;9.0;8.0;7.1;7.0' fi MSVS_PREFERENCE=${MSVS_PREFERENCE//;/ } if [[ -z $TARGET_ARCH ]] ; then LEFT_ARCH=x86 RIGHT_ARCH=x64 else LEFT_ARCH=$TARGET_ARCH RIGHT_ARCH=$TARGET_ARCH fi # Command line parsing complete (MSVS_PREFERENCE pending) NAME="Microsoft C Compiler Environment Detection Script" case $MODE in 2) echo "$NAME" echo "Queries the environment and registry to locate Visual Studio / Windows SDK" echo "installations and uses their initialisation scripts (SetEnv.cmd, vcvarsall.bat," echo "etc.) to determine INCLUDE, LIB and PATH alterations." echo echo "Usage:" echo " $0 [OPTIONS] [--] [MSVS_PREFERENCE]" echo echo "Options:" echo " -a, --all Display all available compiler packages" echo " -x, --arch=ARCH Only consider packages for ARCH (x86 or x64). Default is" echo " to return packages containing both architectures" echo " -d, --debug[=LEVEL] Set debug messages level" echo " -h, --help Display this help screen" echo " -o, --output=OUTPUT Set final output. Default is shell. Valid values:" echo " shell - shell assignments, for use with eval" echo " make - make assignments, for inclusion in a Makefile" echo " -v, --version Display the version" echo " --with-mt Only consider packages including the Manifest Tool" echo " --with-assembler Only consider packages including an assembler" echo echo "If MSVS_PREFERENCE is not given, then the environment variable MSVS_PREFERENCE" echo "is read. MSVS_PREFERENCE is a semicolon separated list of preferred versions." echo "Three kinds of version notation are supported:" echo " 1. @ - which refers to the C compiler found in PATH (if it can be identified)" echo " (this allows the C compiler corresponding to the opposite architecture to" echo " be selected, if possible)." echo " 2. mm.n - which refers to a Visual Studio version (e.g. 14.0, 7.1) but which" echo " also allows an SDK to provide the compiler (e.g. Windows SDK 7.1 provides" echo " 10.0). Visual Studio packages are always preferred ahead of SDKs." echo " 3. SPEC - an actual package specification. Visual Studio packages are VSmm.n" echo " (e.g. VS14.0, VS7.1) and SDK packages are SDKm.n (e.g. SDK7.1)." echo " Any Visual Studio 2017 update can be selected with VS15.*" echo "The default behaviour is to match the environment compiler followed by the most" echo "recent version of the compiler." exit 0;; 3) echo "$NAME" echo "Version $VERSION" exit 0;; esac # Known compiler packages. Visual Studio .NET 2002 onwards. Detection is in place for Visual Studio # 2005 Express, but because it doesn't include a Windows SDK, it can only ever be detected if the # script has been launched from within a Platform SDK command prompt (this provides the Windows # Headers and Libraries which allows this script to detect the rest). # Each element is either a Visual Studio or SDK package and the value is the syntax for a bash # associative array to be eval'd. Each of these contains the following properties: # NAME - the friendly name of the package # ENV - (VS only) the version-specific portion of the VSCOMNTOOLS environment variable # VERSION - (VS only) version number of the package # ARCH - Lists the architectures available in this version # ARCH_SWITCHES - The script is assumed to accept x86 and x64 to indicate architecture. This key # contains another eval'd associative array allowing alternate values to be given # SETENV_RELEASE - (SDK only) script switch necessary to select release than debugging versions # EXPRESS - (VS only) the prefix to the registry key to detect the Express edition # EXPRESS_ARCH - (VS only) overrides ARCH if Express edition is detected # EXPRESS_ARCH_SWITCHES - (VS only) overrides ARCH_SWITCHES if Express edition is detected # VC_VER - (SDK only) specifies the version of the C Compilers included in the SDK (SDK # equivalent of the VERSION key) # REG_KEY - (SDK only) registry key to open to identify this package installation # REG_VALUE - (SDK only) registry value to query to identify this package installation # VSWHERE - (VS 2017+) is 1 if the compiler can only be detected using vswhere # For a while, Windows SDKs followed a standard pattern which is stored in the SDK element and # copied to the appropriate version. SDKs after 7.1 do not include compilers, and so are not # captured (as of Visual Studio 2015, the Windows SDK is official part of Visual Studio). declare -A COMPILERS SDK52_KEY='HKLM\SOFTWARE\Microsoft\MicrosoftSDK\InstalledSDKs\8F9E5EF3-A9A5-491B-A889-C58EFFECE8B3' COMPILERS=( ["VS7.0"]='( ["NAME"]="Visual Studio .NET 2002" ["ENV"]="" ["VERSION"]="7.0" ["ARCH"]="x86")' ["VS7.1"]='( ["NAME"]="Visual Studio .NET 2003" ["ENV"]="71" ["VERSION"]="7.1" ["ARCH"]="x86")' ["VS8.0"]='( ["NAME"]="Visual Studio 2005" ["ENV"]="80" ["VERSION"]="8.0" ["EXPRESS"]="VC" ["ARCH"]="x86 x64" ["EXPRESS_ARCH"]="x86")' ["VS9.0"]='( ["NAME"]="Visual Studio 2008" ["ENV"]="90" ["VERSION"]="9.0" ["EXPRESS"]="VC" ["ARCH"]="x86 x64" ["EXPRESS_ARCH"]="x86")' ["VS10.0"]='( ["NAME"]="Visual Studio 2010" ["ENV"]="100" ["VERSION"]="10.0" ["EXPRESS"]="VC" ["ARCH"]="x86 x64" ["EXPRESS_ARCH"]="x86")' ["VS11.0"]='( ["NAME"]="Visual Studio 2012" ["ENV"]="110" ["VERSION"]="11.0" ["EXPRESS"]="WD" ["ARCH"]="x86 x64" ["EXPRESS_ARCH_SWITCHES"]="([\"x64\"]=\"x86_amd64\")")' ["VS12.0"]='( ["NAME"]="Visual Studio 2013" ["ENV"]="120" ["VERSION"]="12.0" ["EXPRESS"]="WD" ["ARCH"]="x86 x64" ["EXPRESS_ARCH_SWITCHES"]="([\"x64\"]=\"x86_amd64\")")' ["VS14.0"]='( ["NAME"]="Visual Studio 2015" ["ENV"]="140" ["VERSION"]="14.0" ["ARCH"]="x86 x64")' ["VS15.*"]='( ["NAME"]="Visual Studio 2017" ["VSWHERE"]="1")' ["SDK5.2"]='( ["NAME"]="Windows Server 2003 SP1 SDK" ["VC_VER"]="8.0" ["REG_KEY"]="$SDK52_KEY" ["REG_VALUE"]="Install Dir" ["SETENV_RELEASE"]="/RETAIL" ["ARCH"]="x64" ["ARCH_SWITCHES"]="([\"x64\"]=\"/X64\")")' ["SDK"]='( ["NAME"]="Generalised Windows SDK" ["SETENV_RELEASE"]="/Release" ["ARCH"]="x86 x64" ["ARCH_SWITCHES"]="([\"x86\"]=\"/x86\" [\"x64\"]=\"/x64\")")' ["SDK6.1"]='( ["NAME"]="Windows Server 2008 with .NET 3.5 SDK" ["VC_VER"]="9.0")' ["SDK7.0"]='( ["NAME"]="Windows 7 with .NET 3.5 SP1 SDK" ["VC_VER"]="9.0")' ["SDK7.1"]='( ["NAME"]="Windows 7 with .NET 4 SDK" ["VC_VER"]="10.0")' ) # FOUND is ultimately an associative array containing installed compiler packages. It's # hijacked here as part of MSVS_PREFERENCE validation. # Ultimately, it contains a copy of the value from COMPILERS with the following extra keys: # IS_EXPRESS - (VS only) indicates whether the Express edition was located # SETENV - (SDK only) the full location of the SetEnv.cmd script # ASSEMBLER - the name of the assembler (ml or ml64) # MSVS_PATH \ # MSVS_INC > prefix values for PATH, INCLUDE and LIB determined by running the scripts. # MSVS_LIB / declare -A FOUND # Check that MSVS_PREFERENCE is valid and contains no repetitions. for v in $MSVS_PREFERENCE ; do if [[ -n ${FOUND[$v]+x} ]] ; then echo "$0: corrupt MSVS_PREFERENCE: repeated '$v'">&2 exit 2 fi if [[ $v != "@" ]] ; then if [[ -z ${COMPILERS[$v]+x} && -z ${COMPILERS["VS$v"]+x} && -z ${COMPILERS[${v%.*}.*]+x} ]] ; then echo "$0: corrupt MSVS_PREFERENCE: unknown compiler '$v'">&2 exit 2 fi else SCAN_ENV=1 fi FOUND["$v"]="" done # Reset FOUND for later use. FOUND=() # Scan the environment for a C compiler, and check that it's valid. Throughout the rest of the # script, it is assumed that if ENV_ARCH is set then there is a valid environment compiler. if [[ $SCAN_ENV -eq 1 ]] ; then if which cl >/dev/null 2>&1 ; then # Determine its architecture from the Microsoft Logo line. ENV_ARCH=$(cl 2>&1 | head -1 | tr -d '\r') case "${ENV_ARCH#* for }" in x64|AMD64) ENV_ARCH=x64;; 80x86|x86) ENV_ARCH=x86;; *) echo "Unable to identify C compiler architecture from '${ENV_ARCH#* for }'">&2 echo "Environment C compiler discarded">&2 unset ENV_ARCH;; esac # Environment variable names are a bit of a nightmare on Windows - they are actually case # sensitive (at the kernel level) but not at the user level! To compound the misery is that SDKs # use Include and Lib where vcvars32 tends to use INCLUDE and LIB. Windows versions also contain # a mix of Path and PATH, but fortunately Cygwin normalises that to PATH for us! For this # reason, use env to determine the actual case of the LIB and INCLUDE variables. if [[ -n ${ENV_ARCH+x} ]] ; then RET=0 ENV_INC=$(env | sed -ne 's/^\(INCLUDE\)=.*/\1/pi') ENV_LIB=$(env | sed -ne 's/^\(LIB\)=.*/\1/pi') if check_environment "${PATH//:/*}" \ "${!ENV_INC//;/*}" \ "${!ENV_LIB//;/*}" \ "Environment C compiler" \ "$ENV_ARCH" ; then ENV_CL=$(which cl) ENV_cl=${ENV_CL,,} ENV_cl=${ENV_cl/bin\/*_/bin\/} debug "Environment appears to include a compiler at $ENV_CL" if [[ -n $TARGET_ARCH && $TARGET_ARCH != $ENV_ARCH ]] ; then debug "But architecture doesn't match required value" unset ENV_ARCH fi else unset ENV_ARCH fi fi fi fi # Even if launched from a 64-bit Command Prompt, Cygwin is usually 32-bit and so the scripts # executed will inherit that fact. This is a problem when querying the registry, but fortunately # WOW64 provides a mechanism to break out of the 32-bit environment by mapping $WINDIR/sysnative to # the real 64-bit programs. # Thus: # MS_ROOT is the 32-bit Microsoft Registry key (all Visual Studio keys are located there) # REG64 is the processor native version of the reg utility (allowing 64-bit keys to be read for # the SDKs) if [[ -n ${PROCESSOR_ARCHITEW6432+x} ]] ; then debug "WOW64 detected" MS_ROOT='HKLM\SOFTWARE\Microsoft' REG64=$WINDIR/sysnative/reg else MS_ROOT='HKLM\SOFTWARE\Wow6432Node\Microsoft' REG64=reg fi # COMPILER contains each eval'd element from COMPILERS declare -A COMPILER # Scan the registry for compiler package (vswhere is later) for i in "${!COMPILERS[@]}" ; do eval COMPILER=${COMPILERS[$i]} if [[ -n ${COMPILER["ENV"]+x} ]] ; then # Visual Studio package - test for its environment variable ENV=VS${COMPILER["ENV"]}COMNTOOLS if [[ -n ${!ENV+x} ]] ; then debug "$ENV is a candidate" TEST_PATH=${!ENV%\"} TEST_PATH=$(cygpath -u -f - <<< ${TEST_PATH#\"}) if [[ -e $TEST_PATH/vsvars32.bat ]] ; then debug "Directory pointed to by $ENV contains vsvars32.bat" EXPRESS=0 # Check for the primary Visual Studio registry value indicating installation INSTALL_DIR=$(reg_string "$MS_ROOT\\VisualStudio\\${COMPILER["VERSION"]}" InstallDir) if [[ -z $INSTALL_DIR ]] ; then if [[ -n ${COMPILER["EXPRESS"]+x} ]] ; then TEST_KEY="$MS_ROOT\\${COMPILER["EXPRESS"]}Express\\${COMPILER["VERSION"]}" INSTALL_DIR=$(reg_string "$TEST_KEY" InstallDir) # Exception for Visual Studio 2005 Express, which doesn't set the registry correctly, so # set INSTALL_DIR to a fake value to pass the next test. if [[ ${COMPILER["VERSION"]} = "8.0" ]] ; then INSTALL_DIR=$(cygpath -w "$TEST_PATH") EXPRESS=1 else if [[ -z $INSTALL_DIR ]] ; then warning "vsvars32.bat found, but registry value not located (Exp or Pro)" else EXPRESS=1 fi fi else warning "vsvars32.bat found, but registry value not located" fi fi if [[ -n $INSTALL_DIR ]] ; then if [[ ${TEST_PATH%/} = $(cygpath -u "$INSTALL_DIR\\..\\Tools") ]] ; then RESULT=${COMPILERS[$i]%)} DISPLAY=${COMPILER["NAME"]} if [[ $EXPRESS -eq 1 ]] ; then DISPLAY="$DISPLAY Express" fi FOUND+=(["$i"]="$RESULT [\"DISPLAY\"]=\"$DISPLAY\" [\"IS_EXPRESS\"]=\"$EXPRESS\")") debug "${COMPILER["NAME"]} accepted for further detection" else warning "$ENV doesn't agree with registry" fi else warning "vsvars32.bat found, but registry settings not found" fi else warning "$ENV set, but vsvars32.bat not found" fi fi elif [[ -n ${COMPILER["REG_KEY"]+x} ]] ; then # SDK with explicit registry detection value INSTALL_DIR=$(reg64_string "${COMPILER["REG_KEY"]}" "${COMPILER["REG_VALUE"]}") if [[ -n $INSTALL_DIR ]] ; then TEST_PATH=$(cygpath -u "$INSTALL_DIR") if [[ -e $TEST_PATH/SetEnv.cmd ]] ; then RESULT=${COMPILERS[$i]%)} FOUND+=(["$i"]="$RESULT [\"DISPLAY\"]=\"${COMPILER["NAME"]}\" [\"SETENV\"]=\"$INSTALL_DIR\\SetEnv.cmd\")") debug "${COMPILER["NAME"]} accepted for further detection" else warning "Registry set for Windows Server 2003 SDK, but SetEnv.cmd not found" fi fi fi done # Now enumerate installed SDKs for v6.0+ SDK_ROOT='HKLM\SOFTWARE\Microsoft\Microsoft SDKs\Windows' for i in $(reg query "$SDK_ROOT" 2>/dev/null | tr -d '\r' | sed -ne '/Windows\\v/s/.*\\//p') ; do debug "Analysing SDK key $SDK_ROOT\\$i" INSTALL_DIR=$(reg_string "$SDK_ROOT\\$i" InstallationFolder) if [[ -n $INSTALL_DIR ]] ; then TEST_PATH=$(cygpath -u "$INSTALL_DIR") if [[ -e $TEST_PATH/Bin/SetEnv.cmd ]] ; then if [[ -z ${COMPILERS["SDK${i#v}"]+x} ]] ; then warning "SDK $i is not known to this script - assuming compatibility" DISPLAY="Windows SDK $i" else eval COMPILER=${COMPILERS["SDK${i#v}"]} DISPLAY=${COMPILER['NAME']} fi RESULT=${COMPILERS['SDK']%)} FOUND+=(["SDK${i/v/}"]="$RESULT [\"DISPLAY\"]=\"$DISPLAY\" [\"SETENV\"]=\"$INSTALL_DIR\\Bin\\SetEnv.cmd\")") else if [[ -n ${COMPILERS["SDK${i#v}"]+x} ]] ; then warning "Registry set for Windows SDK $i, but SetEnv.cmd not found" fi fi else warning "Registry key for Windows SDK $i doesn't contain expected InstallationFolder value" fi done # Now enumerate Visual Studio 2017+ instances VSWHERE=$(dirname $(realpath $0))/vswhere.exe if [[ ! -x $VSWHERE ]] ; then VSWHERE="$(printenv 'ProgramFiles(x86)')\\Microsoft Visual Studio\\Installer\\vswhere.exe" VSWHERE=$(echo $VSWHERE| cygpath -f -) fi if [[ -x $VSWHERE ]] ; then debug "$VSWHERE found" while IFS= read -r line; do case ${line%: *} in instanceId) INSTANCE=${line#*: };; installationPath) INSTANCE_PATH=${line#*: };; installationVersion) INSTANCE_VER=${line#*: } INSTANCE_VER=${INSTANCE_VER%.*} INSTANCE_VER=${INSTANCE_VER%.*};; displayName) INSTANCE_NAME=${line#*: } debug "Looking at $INSTANCE in $INSTANCE_PATH ($INSTANCE_VER $INSTANCE_NAME)" if [[ -e "$(echo $INSTANCE_PATH| cygpath -f -)/VC/Auxiliary/Build/vcvarsall.bat" ]] ; then debug "vcvarsall.bat found" FOUND+=(["VS$INSTANCE_VER"]="([\"DISPLAY\"]=\"$INSTANCE_NAME\" [\"ARCH\"]=\"x86 x64\" [\"SETENV\"]=\"$INSTANCE_PATH\\VC\\Auxiliary\\Build\\vcvarsall.bat\" [\"SETENV_RELEASE\"]=\"\")") else warning "vcvarsall.bat not found for $INSTANCE" fi;; esac done < <("$VSWHERE" -all -nologo | tr -d '\r') fi if [[ $DEBUG -gt 1 ]] ; then for i in "${!FOUND[@]}" ; do echo "Inspect $i">&2 done fi # Basic scanning is complete, now interrogate the packages which seem to be installed and ensure # that they pass the check_environment tests. # CANDIDATES is a hash table of the keys of FOUND. The result of the next piece of processing is to # derive two arrays PREFERENCE and TEST. TEST will contain a list of the keys of FOUND in the order # in which they should be evaluated. PREFERENCE contains a parsed version of MSVS_PREFERENCE but # filtered on the basis of the compiler packages already identified. The current "hoped for" # preference is stored in $pref (the index into PREFERENCE) and $PREF (which is # ${PREFERENCE[$pref]}). These two arrays together allow testing to complete quickly if the desired # version is found (note that often this won't be possible as the @ environment option requires all # packages to be tested in order to be sure that the environment compiler is not ambiguous). declare -A CANDIDATES for i in "${!FOUND[@]}" ; do CANDIDATES[$i]=""; done # For --all, act as though MSVS_PREFERENCE were "@" because this causes all packages to be tested. if [[ $MODE -eq 1 ]] ; then PREFER_ENV=1 PREFERENCE=("@") else PREFER_ENV=0 PREFERENCE=() fi TEST=() for i in $MSVS_PREFERENCE ; do if [[ $i = "@" ]] ; then if [[ -n ${ENV_ARCH+x} ]] ; then PREFERENCE+=("@") PREFER_ENV=1 else debug "Preference @ ignored since no environment compiler selected" fi else if [[ -n ${COMPILERS[$i]+x} || -n ${COMPILERS[${i%.*}.*]+x} ]] ; then if [[ -n ${CANDIDATES[$i]+x} ]] ; then unset CANDIDATES[$i] TEST+=($i) PREFERENCE+=($i) elif [[ ${i#*.} = "*" ]] ; then INSTANCES= for j in "${!CANDIDATES[@]}" ; do if [[ "${j%.*}.*" = $i ]] ; then unset CANDIDATES[$j] INSTANCES="$INSTANCES $j" fi done INSTANCES="$(sort -r <<< "${INSTANCES// /$'\n'}")" eval TEST+=($INSTANCES) eval PREFERENCE+=($INSTANCES) fi else if [[ -n ${CANDIDATES["VS$i"]+x} ]] ; then unset CANDIDATES["VS$i"] TEST+=("VS$i") PREFERENCE+=("VS$i") fi SDKS= for j in "${!COMPILERS[@]}" ; do eval COMPILER=${COMPILERS[$j]} if [[ -n ${COMPILER["VC_VER"]}+x ]] ; then if [[ $i = ${COMPILER["VC_VER"]} && -n ${CANDIDATES[$j]+x} ]] ; then unset CANDIDATES[$j] SDKS="$j $SDKS" fi fi done SDKS=${SDKS% } SDKS="$(sort -r <<< "${SDKS// /$'\n'}")" SDKS=${SDKS//$'\n'/ } eval TEST+=($SDKS) eval PREFERENCE+=($SDKS) fi fi done # If MSVS_PREFERENCE includes @, add any remaining items from CANDIDATES to TEST, otherwise remove # them from FOUND so that they don't accidentally get reported on later. for i in "${!CANDIDATES[@]}" ; do if [[ $PREFER_ENV -eq 1 ]] ; then TEST+=($i) else unset FOUND[$i] fi done # Initialise pref and PREF to ${PREFERENCE[0]} pref=0 PREF=${PREFERENCE[0]} if [[ $DEBUG -gt 1 ]] ; then for i in "${!TEST[@]}" ; do echo "Test ${TEST[$i]}">&2 done fi # Now run each compiler's environment script and then test whether it is suitable. During this loop, # attempt to identify the environment C compiler (if one was found). The environment C compiler is # strongly identified if the full location of cl matches the one in PATH and both LIB and INCLUDE # contain the strings returned by the script in an otherwise empty environment (if one or both of # the LIB and INCLUDE variables do not contain the string returned, then the compiler is weakly # identified). If the environment compiler is strongly identified by more than one package, then it # is not identified at all; if it is strongly identified by no packages but weakly identified by # exactly 1, then we grudgingly accept that that's probably the one. ENV_COMPILER= WEAK_ENV= # ARCHINFO contains the appropriate ARCH_SWITCHES associative array for each compiler. declare -A ARCHINFO for i in "${TEST[@]}" ; do CURRENT=${FOUND[$i]} eval COMPILER=$CURRENT # At the end of this process, the keys of FOUND will be augmented with the architecture found in # each case (so if "VS14.0" was in FOUND from the scan and both the x86 and x64 compilers are # valid, then at the end of this loop FOUND will contain "VS14.0-x86" and "VS14.0-x64"). unset FOUND[$i] if [[ ${COMPILER["IS_EXPRESS"]}0 -gt 0 && -n ${COMPILER["EXPRESS_ARCH_SWITCHES"]+x} ]] ; then eval ARCHINFO=${COMPILER["EXPRESS_ARCH_SWITCHES"]} elif [[ -n ${COMPILER["ARCH_SWITCHES"]+x} ]] ; then eval ARCHINFO=${COMPILER["ARCH_SWITCHES"]} else ARCHINFO=() fi # Determine the script to be executed and any non-architecture specific switches needed. # $ENV is will contain the value of the environment variable for the compiler (empty for an SDK) # which is required for Visual Studio 7.x shim later. if [[ -n ${COMPILER["ENV"]+x} ]] ; then ENV=VS${COMPILER["ENV"]}COMNTOOLS ENV=${!ENV%\"} ENV=${ENV#\"} if [[ ${COMPILER["ENV"]}0 -ge 800 ]] ; then SCRIPT="$(cygpath -d -f - <<< $ENV)\\..\\..\\VC\\vcvarsall.bat" SCRIPT_SWITCHES= else SCRIPT="$(cygpath -d -f - <<< $ENV)\\vsvars32.bat" SCRIPT_SWITCHES= fi else ENV= SCRIPT=${COMPILER["SETENV"]} SCRIPT_SWITCHES=${COMPILER["SETENV_RELEASE"]} fi # For reasons of escaping, the script is executed using its basename so the directory needs # prepending to PATH. DIR=$(dirname "$SCRIPT" | cygpath -u -f -) if [[ ${COMPILER["IS_EXPRESS"]} -gt 0 && -n ${COMPILER["EXPRESS_ARCH"]+x} ]] ; then ARCHS=${COMPILER["EXPRESS_ARCH"]} else ARCHS=${COMPILER["ARCH"]} fi for arch in $ARCHS ; do # Determine the command line switch for this architecture if [[ -n ${ARCHINFO[$arch]+x} ]] ; then ARCH_SWITCHES=${ARCHINFO[$arch]} else ARCH_SWITCHES=$arch fi # Run the script in order to determine changes made to PATH, INCLUDE and LIB. These scripts # always prepend changes to the environment variables. MSVS_PATH= MSVS_LIB= MSVS_INC= COMMAND='%EXEC_SCRIPT% && echo XMARKER && echo !PATH! && echo !LIB! && echo !INCLUDE!' # Note that EXEC_SCRIPT must have ARCH_SWITCHES first for older Platform SDKs (newer ones parse # arguments properly) if [[ $DEBUG -gt 3 ]] ; then printf "Scanning %s... " "$(basename "$SCRIPT") $ARCH_SWITCHES $SCRIPT_SWITCHES">&2 fi num=0 while IFS= read -r line; do case $num in 0) MSVS_PATH=${line%% };; 1) MSVS_LIB=${line%% };; 2) MSVS_INC=${line%% };; esac ((num++)) done < <(INCLUDE= LIB= PATH="$DIR:$PATH" \ EXEC_SCRIPT="$(basename "$SCRIPT") $ARCH_SWITCHES $SCRIPT_SWITCHES" \ cmd /v:on /c $COMMAND 2>/dev/null | fgrep XMARKER -A 3 | tr -d '\015' | tail -3) if [[ $DEBUG -gt 3 ]] ; then echo done>&2 fi if [[ -n $MSVS_PATH ]] ; then # Translate MSVS_PATH back to Cygwin notation (/cygdrive, etc. and colon-separated) MSVS_PATH=$(cygpath "$MSVS_PATH" -p) # Remove the actual PATH (and the extra $DIR added to run the script) MSVS_PATH=${MSVS_PATH%:$DIR:$PATH} # Guarantee that MSVS_PATH ends with a single : MSVS_PATH="${MSVS_PATH%%:}:" fi # Ensure that both variables end with a semi-colon (it doesn't matter if for some erroneous # reason they have come back blank, because check_environment will shortly fail) MSVS_LIB="${MSVS_LIB%%;};" MSVS_INC="${MSVS_INC%%;};" # Visual Studio .NET 2002 and 2003 do not include mt in PATH, for not entirely clear reasons. # This shim detects that scenario and adds the winnt folder to MSVS_PATH. RET=0 if [[ ${i/.*/} = "VS7" ]] ; then find_in "${MSVS_PATH//:/*}" mt.exe if [[ $RET -eq 1 ]] ; then MSVS_PATH="$MSVS_PATH$(cygpath -u -f - <<< $ENV\\Bin\\winnt):" RET=0 fi fi # Ensure that these derived values give a valid compiler. if check_environment "${MSVS_PATH//:/*}" "${MSVS_INC//;/*}" "${MSVS_LIB//;/*}" "$i" $arch ; then # Put the package back into FOUND, but augmented with the architecture name and with the # derived values. FOUND["$i-$arch"]="${CURRENT%)} [\"MSVS_PATH\"]=\"$MSVS_PATH\" \ [\"MSVS_INC\"]=\"$MSVS_INC\" \ [\"MSVS_LIB\"]=\"$MSVS_LIB\" \ [\"ASSEMBLER\"]=\"$ASSEMBLER\")" #"# fixes vim syn match error # Check to see if this is a match for the environment C compiler. if [[ -n ${ENV_ARCH+x} ]] ; then TEST_cl=$(PATH="$MSVS_PATH:$PATH" which cl) TEST_cl=${TEST_cl,,} TEST_cl=${TEST_cl/bin\/*_/bin\/} if [[ $TEST_cl = $ENV_cl ]] ; then if [[ ${!ENV_INC/"$MSVS_INC"/} != "${!ENV_INC}" && \ ${!ENV_LIB/"$MSVS_LIB"/} != "${!ENV_LIB}" ]] ; then debug "$i-$arch is a strong candidate for the Environment C compiler" if [[ -n ${ENV_COMPILER+x} ]] ; then if [[ -z ${ENV_COMPILER} ]] ; then ENV_COMPILER=$i-$arch unset WEAK_ENV else # More than one strong candidate - no fall back available unset ENV_COMPILER unset WEAK_ENV fi fi else debug "$i-$arch is a weak candidate for the Environment C compiler" if [[ -n ${WEAK_ENV+x} ]] ; then if [[ -z ${WEAK_ENV} ]] ; then WEAK_ENV=$i-$arch else # More than one weak candidate - no fall back available unset WEAK_ENV fi fi fi fi fi fi done # Does this package match the current preference? Note that PREFERENCE and TEST are constructed in # a cunning (and hopefully not too "You are not expected to understand this" way) such that $PREF # will always equal $i, unless $PREF = "@". if [[ $PREF = $i ]] ; then # In which case, check that the architecture(s)s were found if [[ -n ${FOUND["$i-$LEFT_ARCH"]+x} && -n ${FOUND["$i-$RIGHT_ARCH"]+x} ]] ; then debug "Solved TARGET_ARCH=$TARGET_ARCH with $i" SOLUTION=$i break fi fi if [[ $PREF != "@" ]] ; then ((pref++)) PREF=${PREFERENCE[$pref]} fi done # If we got this far, then either we failed to find a compiler at all, or we were looking for the # environment compiler (or --all was specified). # Adopt a weak match for the environment compiler, if that's the best we can do. if [[ -n ${ENV_COMPILER+x} && -z ${ENV_COMPILER} && -n ${WEAK_ENV} ]] ; then warning "Assuming Environment C compiler is $WEAK_ENV" ENV_COMPILER=$WEAK_ENV fi declare -A FLIP FLIP=(["x86"]="x64" ["x64"]="x86") if [[ $MODE -eq 0 ]] ; then if [[ $PREF = "@" && -n ${ENV_COMPILER} ]] ; then SOLUTION=${ENV_COMPILER%-$ENV_ARCH} # If --arch wasn't specified, then ensure that the other architecture was also found. If --arch # was specified, then validate that the compiler was valid. This should always happen, unless # something went wrong running the script to get MSVS_PATH, MSVS_LIB and MSVS_INC. if [[ -n ${FOUND["$SOLUTION-${FLIP[$ENV_ARCH]}"]+x} || -n ${FOUND["$SOLUTION-$TARGET_ARCH"]+x} ]] ; then debug "Solved with $SOLUTION" else unset SOLUTION unset ENV_ARCH fi fi if [[ -z ${SOLUTION+x} ]] ; then ((pref++)) debug "Search remaining: ${PREFERENCE[*]}" TEST_ARCH=$TARGET_ARCH for i in "${PREFERENCE[@]:$pref}" ; do if [[ -n ${FOUND["$i-$LEFT_ARCH"]+x} && -n ${FOUND["$i-$RIGHT_ARCH"]+x} ]] ; then debug "Solved TARGET_ARCH='$TARGET_ARCH' with $i" SOLUTION=$i break fi done fi fi debug "Solution: $SOLUTION" if [[ -n ${ENV_COMPILER} && $MODE -eq 1 ]] ; then echo "Identified Environment C compiler as $ENV_COMPILER" fi if [[ $MODE -eq 1 ]] ; then echo "Installed and usable packages:" for i in "${!FOUND[@]}" ; do echo " $i" done | sort exit 0 fi if [[ -n $SOLUTION ]] ; then eval COMPILER=${FOUND[$SOLUTION-$LEFT_ARCH]} output MSVS_NAME "${COMPILER["DISPLAY"]}" $LEFT_ARCH output MSVS_PATH "${COMPILER["MSVS_PATH"]}" $LEFT_ARCH output MSVS_INC "${COMPILER["MSVS_INC"]}" $LEFT_ARCH output MSVS_LIB "${COMPILER["MSVS_LIB"]}" $LEFT_ARCH if [[ $ML_REQUIRED -eq 1 ]] ; then output MSVS_ML "${COMPILER["ASSEMBLER"]%.exe}" always fi if [[ -z $TARGET_ARCH ]] ; then eval COMPILER=${FOUND[$SOLUTION-$RIGHT_ARCH]} output MSVS64_PATH "${COMPILER["MSVS_PATH"]}" $RIGHT_ARCH output MSVS64_INC "${COMPILER["MSVS_INC"]}" $RIGHT_ARCH output MSVS64_LIB "${COMPILER["MSVS_LIB"]}" $RIGHT_ARCH if [[ $ML_REQUIRED -eq 1 ]] ; then output MSVS64_ML "${COMPILER["ASSEMBLER"]%.exe}" always fi fi exit 0 else exit 1 fi opam-2.0.5/shell/wrap-build.sh0000755000175000017500000000224413511367404015174 0ustar nicoonicoo#!/bin/sh -e USERID=$(id -u) GROUPID=$(id -g) # Run in separate user, network and mount namespace # -r maps USERID to root, which is needed for doing the mounts, then we map it # back to USERID in a child namespace for running the child process exec unshare -Umnr /bin/sh -es "$@" <\$tmpup & pid=\$! exec 3>\$tmpdown 4<\$tmpup # Synchronise to make sure the child ns is ready echo 'echo >&4' >&3; read sync <&4 # Setup the uid and gid map (reverse of what 'unshare -r' did) to get back to # the original uid echo "$USERID 0 1" >/proc/\$pid/uid_map echo "$GROUPID 0 1" >/proc/\$pid/gid_map # Exec the original command that was passed through argv to the child shell echo 'exec "\$@"' >&3 # Cleanup exec 3>&- 4<&- wait \$pid EOF opam-2.0.5/shell/context_flags.ml0000644000175000017500000000112013511367404015751 0ustar nicoonicoo#directory "+compiler-libs";; #load "ocamlcommon.cma";; let p = String.index Sys.ocaml_version '.' in let _ocaml_major = String.sub Sys.ocaml_version 0 p |> int_of_string in let p = succ p in let _ocaml_minor = String.sub Sys.ocaml_version p (String.index_from Sys.ocaml_version p '.' - p) |> int_of_string in match Sys.argv.(1) with | "flags" -> Printf.printf "()" | "clibs" -> if Sys.win32 then Printf.printf "(-ladvapi32 -lgdi32 -luser32 -lshell32)" else Printf.printf "()" | _ -> Printf.eprintf "Unrecognised context instruction: %s\n" Sys.argv.(1); exit 1 opam-2.0.5/shell/md5check.ml0000644000175000017500000000074613511367404014611 0ustar nicoonicoolet file, md5 = if Array.length Sys.argv <> 3 then ( Printf.eprintf "usage: ocaml %s \n" Sys.argv.(0); exit 1 ) else Sys.argv.(1), Sys.argv.(2) let md5_of_file = Digest.to_hex (Digest.file file) let () = if md5 <> md5_of_file then ( Printf.eprintf "MD5 for %s differ:\n\ \ expected: %s\n\ \ actual: %s\n" file md5 md5_of_file; Sys.remove file; exit 1 ) else Printf.printf "%s has the expected MD5.\n" file opam-2.0.5/opam-admin.opam0000644000175000017500000000000013511367404014344 0ustar nicoonicooopam-2.0.5/dune-project0000644000175000017500000000003413511367404013775 0ustar nicoonicoo(lang dune 1.2) (name opam) opam-2.0.5/Makefile0000644000175000017500000001311013511367404013112 0ustar nicoonicooifeq ($(findstring clean,$(MAKECMDGOALS)),) -include Makefile.config endif all: opam opam-installer @ ifeq ($(DUNE),) DUNE_EXE = src_ext/dune-local/_build_bootstrap/install/default/bin/dune$(EXE) ifeq ($(shell command -v cygpath 2>/dev/null),) DUNE := $(DUNE_EXE) else DUNE := $(shell echo "$(DUNE_EXE)" | cygpath -f - -a) endif else DUNE_EXE= endif OPAMINSTALLER = ./opam-installer$(EXE) ALWAYS: @ DUNE_DEP = ALWAYS $(DUNE_EXE) JBUILDER_ARGS ?= DUNE_ARGS ?= $(JBUILDER_ARGS) DUNE_PROFILE ?= release src_ext/dune-local/_build_bootstrap/install/default/bin/dune$(EXE): src_ext/dune-local.stamp cd src_ext/dune-local && ocaml bootstrap.ml && ./boot.exe --release src_ext/dune-local.stamp: $(MAKE) -C src_ext dune-local.stamp dune: $(DUNE_DEP) @$(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) @install opam: $(DUNE_DEP) opam.install $(LN_S) -f _build/default/src/client/opamMain.exe $@$(EXE) ifneq ($(MANIFEST_ARCH),) @mkdir -p Opam.Runtime.$(MANIFEST_ARCH) @cp -f src/client/Opam.Runtime.$(MANIFEST_ARCH).manifest Opam.Runtime.$(MANIFEST_ARCH)/ @cd Opam.Runtime.$(MANIFEST_ARCH) && $(LN_S) -f ../src/client/libstdc++-6.dll . @cd Opam.Runtime.$(MANIFEST_ARCH) && $(LN_S) -f ../src/client/libwinpthread-1.dll . @cd Opam.Runtime.$(MANIFEST_ARCH) && $(LN_S) -f ../src/client/$(RUNTIME_GCC_S).dll . endif opam-installer: $(DUNE_DEP) $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) src/tools/opam_installer.exe $(LN_S) -f _build/default/src/tools/opam_installer.exe $@$(EXE) opam-admin.top: $(DUNE_DEP) $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) src/tools/opam_admin_top.bc $(LN_S) -f _build/default/src/tools/opam_admin_top.bc $@$(EXE) lib-ext: $(MAKE) -j -C src_ext lib-ext lib-pkg: $(MAKE) -j -C src_ext lib-pkg download-ext: $(MAKE) -C src_ext cache-archives download-pkg: $(MAKE) -C src_ext archives-pkg clean-ext: $(MAKE) -C src_ext distclean clean: $(MAKE) -C doc $@ rm -f *.install *.env *.err *.info *.out opam$(EXE) opam-admin.top$(EXE) opam-installer$(EXE) rm -rf _build Opam.Runtime.* distclean: clean clean-ext rm -rf autom4te.cache bootstrap rm -f Makefile.config config.log config.status aclocal.m4 rm -f src/*.META src/*/.merlin src/stubs/dune src/client/*.dll rm -f src/tools/opam-putenv.inc src/client/manifest.inc src/client/opamManifest.inc OPAMINSTALLER_FLAGS = --prefix "$(DESTDIR)$(prefix)" OPAMINSTALLER_FLAGS += --mandir "$(DESTDIR)$(mandir)" # With ocamlfind, prefer to install to the standard directory rather # than $(prefix) if there are no overrides ifdef OCAMLFIND ifndef DESTDIR ifneq ($(OCAMLFIND),no) LIBINSTALL_DIR ?= $(shell PATH="$(PATH)" $(OCAMLFIND) printconf destdir) endif endif endif ifneq ($(LIBINSTALL_DIR),) OPAMINSTALLER_FLAGS += --libdir "$(LIBINSTALL_DIR)" endif opam-devel.install: $(DUNE_DEP) $(DUNE) build $(DUNE_ARGS) -p opam opam.install sed -e "s/bin:/libexec:/" opam.install > $@ opam-%.install: $(DUNE_DEP) $(DUNE) build $(DUNE_ARGS) -p opam-$* $@ opam.install: ALWAYS $(DUNE_DEP) $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) opam-installer.install opam.install opam-actual.install: opam.install man @echo 'bin: [' > $@ @grep -h 'bin/[^/]*' $< >> $@ @echo ']' >> $@ @echo 'man: [' >>$@ @$(patsubst %,echo ' "'%'"' >>$@;,$(wildcard doc/man/*.1)) @echo ']' >>$@ @echo 'doc: [' >>$@ @$(foreach x,$(wildcard doc/man-html/*.html),\ echo ' "$x" {"man/$(notdir $x)"}' >>$@;) @$(foreach x,$(wildcard doc/pages/*.html),\ echo ' "$x" {"$(notdir $x)"}' >>$@;) @echo ']' >>$@ OPAMLIBS = core format solver repository state client opam-%: $(DUNE_DEP) $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) opam-$*.install opam-lib: $(DUNE_DEP) $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) $(patsubst %,opam-%.install,$(OPAMLIBS)) installlib-%: opam-installer opam-%.install $(if $(wildcard src_ext/lib/*),\ $(error Installing the opam libraries is incompatible with embedding \ the dependencies. Run 'make clean-ext' and try again)) $(OPAMINSTALLER) $(OPAMINSTALLER_FLAGS) opam-$*.install uninstalllib-%: opam-installer opam-%.install $(OPAMINSTALLER) -u $(OPAMINSTALLER_FLAGS) opam-$*.install libinstall: $(DUNE_DEP) opam-admin.top $(OPAMLIBS:%=installlib-%) @ install: opam-actual.install $(OPAMINSTALLER) $(OPAMINSTALLER_FLAGS) $< $(OPAMINSTALLER) $(OPAMINSTALLER_FLAGS) opam-installer.install libuninstall: $(OPAMLIBS:%=uninstalllib-%) @ uninstall: opam-actual.install $(OPAMINSTALLER) -u $(OPAMINSTALLER_FLAGS) $< checker: $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) src/tools/opam_check.exe .PHONY: tests tests-local tests-git tests: $(DUNE_DEP) $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) opam.install src/tools/opam_check.exe $(DUNE) runtest --force --no-buffer --profile=$(DUNE_PROFILE) $(DUNE_ARGS) src/ tests/ # tests-local, tests-git tests-%: $(MAKE) -C tests $* .PHONY: doc doc: all $(MAKE) -C doc .PHONY: man man-html man man-html: opam opam-installer $(MAKE) -C doc $@ configure: configure.ac m4/*.m4 aclocal -I m4 autoconf release-%: $(MAKE) -C release TAG="$*" ifeq ($(OCAML_PORT),) ifneq ($(COMSPEC),) ifeq ($(shell which gcc 2>/dev/null),) OCAML_PORT=auto endif endif endif .PHONY: compiler cold compiler: env MAKE=$(MAKE) ./shell/bootstrap-ocaml.sh $(OCAML_PORT) cold: compiler env PATH="`pwd`/bootstrap/ocaml/bin:$$PATH" ./configure $(CONFIGURE_ARGS) env PATH="`pwd`/bootstrap/ocaml/bin:$$PATH" $(MAKE) lib-ext env PATH="`pwd`/bootstrap/ocaml/bin:$$PATH" $(MAKE) cold-%: env PATH="`pwd`/bootstrap/ocaml/bin:$$PATH" $(MAKE) $* .PHONY: run-appveyor-test run-appveyor-test: env PATH="`pwd`/bootstrap/ocaml/bin:$$PATH" ./appveyor_test.sh opam-2.0.5/opam-state.opam0000644000175000017500000000157113511367404014412 0ustar nicoonicooopam-version: "1.2" version: "2.0.5" maintainer: "opam-devel@lists.ocaml.org" authors: [ "Vincent Bernardoff " "Raja Boujbel " "Roberto Di Cosmo " "Thomas Gazagnaire " "Louis Gesbert " "Fabrice Le Fessant " "Anil Madhavapeddy " "Guillem Rieu " "Ralf Treinen " "Frederic Tuong " ] homepage: "https://opam.ocaml.org/" bug-reports: "https://github.com/ocaml/opam/issues" dev-repo: "https://github.com/ocaml/opam.git" build: [ ["./configure" "--disable-checks" "--prefix" prefix] [make "%{name}%.install"] ] depends: [ "opam-repository" {= "2.0.5"} "dune" {build & >= "1.2.1"} ] available: ocaml-version >= "4.02.3" opam-2.0.5/appveyor.patch0000644000175000017500000000176013511367404014350 0ustar nicoonicooFrom 9ef1fc2a03a4a34067b3a7d4f70507cf9326387e Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 19 Jan 2018 09:32:57 +0000 Subject: [PATCH] Use dra27 jbuilder/ocaml-mccs/flexdll - Need unreleased flexdll 0.38 to build mccs on mingw. --- src_ext/Makefile | 4 ++-- src_ext/Makefile.sources | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src_ext/Makefile b/src_ext/Makefile index 1a350068..964a818c 100644 --- a/src_ext/Makefile +++ b/src_ext/Makefile @@ -12,8 +12,8 @@ endif URL_ocaml = http://caml.inria.fr/pub/distrib/ocaml-4.07/ocaml-4.07.1.tar.gz MD5_ocaml = 0b180b273ce5cc2ac68f347c9b06d06f -URL_flexdll = https://github.com/alainfrisch/flexdll/archive/0.37.tar.gz -MD5_flexdll = cc456a89382e60d84130cddd53977486 +URL_flexdll = https://github.com/dra27/flexdll/archive/linking-c++.tar.gz +MD5_flexdll = 75bd0efc328ad9f8f2e01414464d217b ifndef FETCH ifneq ($(shell command -v curl 2>/dev/null),) -- 2.12.0.windows.1 opam-2.0.5/.ocamlinit0000644000175000017500000000104613511367404013437 0ustar nicoonicoo#use "topfind";; #require "opam-client";; OpamClientConfig.opam_init ();; let gt = OpamGlobalState.load `Lock_none;; OpamConsole.msg "Opam global state for %s loaded in 'gt'\n" OpamStateConfig.(OpamFilename.Dir.to_string !r.root_dir);; let rt = OpamRepositoryState.load `Lock_none gt;; OpamConsole.msg "Opam repository state loaded in 'rt'\n";; let st = OpamSwitchState.load `Lock_none gt rt (OpamStateConfig.get_switch ());; OpamConsole.msg "Opam switch state of '%s' loaded in 'st'\n" (OpamSwitch.to_string (OpamStateConfig.get_switch ()));; opam-2.0.5/opam-client.opam0000644000175000017500000000167613511367404014556 0ustar nicoonicooopam-version: "1.2" version: "2.0.5" maintainer: "opam-devel@lists.ocaml.org" authors: [ "Vincent Bernardoff " "Raja Boujbel " "Roberto Di Cosmo " "Thomas Gazagnaire " "Louis Gesbert " "Fabrice Le Fessant " "Anil Madhavapeddy " "Guillem Rieu " "Ralf Treinen " "Frederic Tuong " ] homepage: "https://opam.ocaml.org/" bug-reports: "https://github.com/ocaml/opam/issues" dev-repo: "https://github.com/ocaml/opam.git" build: [ ["./configure" "--disable-checks" "--prefix" prefix] [make "%{name}%.install"] ] depends: [ "opam-state" {= "2.0.5"} "opam-solver" {= "2.0.5"} "re" {>= "1.7.2"} "cmdliner" {>= "0.9.8"} "dune" {build & >= "1.2.1"} ] available: ocaml-version >= "4.02.3" opam-2.0.5/appveyor.yml0000644000175000017500000000226013511367404014046 0ustar nicoonicooplatform: - x64 image: Visual Studio 2017 environment: global: CYG_ROOT: cygwin64 CYG_ARCH: x86_64 OCAML_PORT: CYG_CACHE: C:/cygwin/var/cache/setup CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/ DEP_MODE: lib-ext matrix: - CYG_ROOT: cygwin CYG_ARCH: x86 # - CYG_ROOT: cygwin64 # CYG_ARCH: x86_64 # DEP_MODE: lib-pkg - OCAML_PORT: msvc DEP_MODE: lib-pkg - OCAML_PORT: msvc64 - OCAML_PORT: mingw - OCAML_PORT: mingw64 DEP_MODE: lib-pkg cache: - C:\projects\opam\bootstrap - C:\projects\opam\src_ext\archives init: - "echo System architecture: %PLATFORM%" install: - call "%APPVEYOR_BUILD_FOLDER%\appveyor_build.cmd" install build_script: - call "%APPVEYOR_BUILD_FOLDER%\appveyor_build.cmd" build test_script: - call "%APPVEYOR_BUILD_FOLDER%\appveyor_build.cmd" test # Uncomment this to enable Remote Desktop on the build worker at the end of the # build. The worker is available for the remainder of the allocated hour. #on_finish: # - ps: $blockRdp = $true; iex ((new-object net.webclient).DownloadString('https://raw.githubusercontent.com/appveyor/ci/master/scripts/enable-rdp.ps1')) opam-2.0.5/.ocplint0000644000175000017500000001564013511367404013135 0ustar nicoonicoo(*************************************) (* Never edit options files while *) (* the program is running *) (*************************************) (* SECTION : Header *) (* These options must be read first *) (*************************************) (* [ignore]: Module to ignore during the lint. *) ignore = [ ] (* [db_persistence]: Time before erasing cached results (in days). *) db_persistence = 1 (* [jobs]: Number of parallel jobs *) jobs = 4 plugin_typedtree = { (* [enabled]: A plugin with linters on typed tree *) enabled = true fully_qualified_identifiers = { (* [enabled]: Enable/Disable linter "Fully-Qualified Identifiers". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Fully-Qualified Identifiers" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Fully-Qualified Identifiers" *) warnings = "+A-1" ignored_modules = [ Pervasives; StringCompat; ] ignore_operators = true ignore_depth = 2 } polymorphic_function = { (* [enabled]: Enable/Disable linter "Polymorphic function". *) enabled = false (* [ignore]: Module to ignore durint the lint of "Polymorphic function" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Polymorphic function" *) warnings = "+A" } } plugin_text = { (* [enabled]: A plugin with linters on the source *) enabled = true code_length = { (* [enabled]: Enable/Disable linter "Code Length". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Code Length" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Code Length" *) warnings = "+A-1" (* [max_line_length]: Maximum line length *) max_line_length = 80 } useless_space_line = { (* [enabled]: Enable/Disable linter "Useless space character and empty line at the end of file.". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Useless space character and empty line at the end of file." *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Useless space character and empty line at the end of file." *) warnings = "+A" } not_that_char = { (* [enabled]: Enable/Disable linter "Detect use of unwanted chars in files". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Detect use of unwanted chars in files" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Detect use of unwanted chars in files" *) warnings = "+A" } } plugin_patch = { (* [enabled]: Detect pattern with semantic patch. *) enabled = true sempatch_lint = { (* [enabled]: Enable/Disable linter "Lint from semantic patches.". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Lint from semantic patches." *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Lint from semantic patches." *) warnings = "+A-1" } } plugin_parsing = { (* [enabled]: Analyses requiring to re-parse the file *) enabled = true raw_syntax = { (* [enabled]: Enable/Disable linter "Raw Syntax". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Raw Syntax" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Raw Syntax" *) warnings = "+A-2-7-8" } } plugin_parsetree = { (* [enabled]: A plugin with linters on parsetree *) enabled = true code_identifier_length = { (* [enabled]: Enable/Disable linter "Code Identifier Length". *) enabled = false (* [ignore]: Module to ignore durint the lint of "Code Identifier Length" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Code Identifier Length" *) warnings = "+A" (* [min_identifier_length]: Identifiers with a shorter name will trigger a warning *) min_identifier_length = 2 (* [max_identifier_length]: Identifiers with a longer name will trigger a warning *) max_identifier_length = 30 } code_list_on_singleton = { (* [enabled]: Enable/Disable linter "List function on singleton". *) enabled = true (* [ignore]: Module to ignore durint the lint of "List function on singleton" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "List function on singleton" *) warnings = "+A" } phys_comp_allocated_lit = { (* [enabled]: Enable/Disable linter "Physical comparison between allocated litterals.". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Physical comparison between allocated litterals." *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Physical comparison between allocated litterals." *) warnings = "+A" } fabrice_good_practices = { (* [enabled]: Enable/Disable linter "Good Practices". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Good Practices" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Good Practices" *) warnings = "+A" } check_constr_args = { (* [enabled]: Enable/Disable linter "Check Constructor Arguments". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Check Constructor Arguments" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Check Constructor Arguments" *) warnings = "+A" } code_redefine_stdlib_module = { (* [enabled]: Enable/Disable linter "Refedine Stdlib Module". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Refedine Stdlib Module" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Refedine Stdlib Module" *) warnings = "+A-1-2" } } plugin_indent = { (* [enabled]: A plugin with linters on the source *) enabled = true ocp_indent = { (* [enabled]: Enable/Disable linter "Indention with ocp-indent". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Indention with ocp-indent" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Indention with ocp-indent" *) warnings = "+A-1" } } plugin_file_system = { (* [enabled]: A plugin with linters on file system like interface missing, etc *) enabled = true interface_missing = { (* [enabled]: Enable/Disable linter "Missing interface". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Missing interface" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Missing interface" *) warnings = "+A" } project_files = { (* [enabled]: Enable/Disable linter "File Names". *) enabled = true (* [ignore]: Module to ignore durint the lint of "File Names" *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "File Names" *) warnings = "+A" } } plugin_complex = { (* [enabled]: A plugin with linters on different inputs *) enabled = true interface_module_type_name = { (* [enabled]: Enable/Disable linter "Checks on module type name.". *) enabled = true (* [ignore]: Module to ignore durint the lint of "Checks on module type name." *) ignore = [ ] (* [warnings]: Enable/Disable warnings from "Checks on module type name." *) warnings = "+A" } } opam-2.0.5/release/0000755000175000017500000000000013511367404013076 5ustar nicoonicooopam-2.0.5/release/release.sh0000755000175000017500000000161213511367404015055 0ustar nicoonicoo#!/usr/bin/env bash set -uex # This script is expected to run on Linux with docker available, and to have two # remotes "some-osx" and "some-openbsd", with the corresponding OSes, ocaml deps # installed LC_ALL=C DIR=$(dirname $0) cd "$DIR" if [[ $# -eq 0 || "x$1" =~ "x-" ]]; then echo "Usage: $0 TAG [archive|builds]" exit 1 fi TAG="$1"; shift if [[ $# -eq 0 || " $* " =~ " archive " ]]; then make TAG="$TAG" GIT_URL="https://github.com/ocaml/opam.git" "out/opam-full-$TAG.tar.gz" ( cd out && git-upload-release ocaml opam "$TAG" "opam-full-$TAG.tar.gz"; ) fi if [[ $# -eq 0 || " $* " =~ " builds " ]]; then make TAG="$TAG" all & make TAG="$TAG" remote REMOTE=some-osx REMOTE_DIR=opam-release & make TAG="$TAG" remote REMOTE=some-openbsd REMOTE_MAKE=gmake REMOTE_DIR=opam-release & wait cd out && for f in opam-$TAG-*; do git-upload-release ocaml opam "$TAG" $f done fi opam-2.0.5/release/Makefile0000644000175000017500000001013213511367404014533 0ustar nicoonicooTAG = master VERSION = $(shell git describe $(TAG)) OPAM_VERSION = $(subst -,~,$(VERSION)) GIT_URL = .. FULL_ARCHIVE_URL = https://github.com/ocaml/opam/releases/download/$(VERSION)/opam-full-$(VERSION).tar.gz TARGETS = x86_64-linux i686-linux armhf-linux arm64-linux # todo: x86_64-darwin OCAMLV = 4.04.2 # currently hardcoded in Dockerfile.in OCAML_URL = https://caml.inria.fr/pub/distrib/ocaml-$(basename $(OCAMLV))/ocaml-$(OCAMLV).tar.gz HOST_OS = $(shell uname -s | tr A-Z a-z) HOST = $(shell uname -m | sed 's/amd64/x86_64/')-$(HOST_OS) all: $(patsubst %,out/opam-$(VERSION)-%,$(TARGETS)) out/opam-full-$(VERSION).tar.gz: mkdir -p out cd out && curl -OfL $(FULL_ARCHIVE_URL) || { \ git clone $(GIT_URL) -b $(TAG) --depth 1 opam-full-$(VERSION); \ sed 's/^AC_INIT(opam,.*)/AC_INIT(opam,$(OPAM_VERSION))/' > \ opam-full-$(VERSION)/configure.ac.tmp; \ mv opam-full-$(VERSION)/configure.ac.tmp \ opam-full-$(VERSION)/configure.ac; \ $(MAKE) -C opam-full-$(VERSION) configure download-ext; \ tar cz --exclude-vcs opam-full-$(VERSION) -f $(notdir $@); \ rm -rf opam-full-$(VERSION); \ } build/Dockerfile.x86_64-linux: Dockerfile.in mkdir -p build && sed 's/%TARGET_TAG%/amd64-jessie/g' $^ | sed 's/%CONF%//g' >$@ build/Dockerfile.i686-linux: Dockerfile.in mkdir -p build && sed 's/%TARGET_TAG%/i386-jessie/g' $^ | sed 's/%CONF%/-host i686-linux/g' >$@ build/Dockerfile.armhf-linux: Dockerfile.in mkdir -p build && sed 's/%TARGET_TAG%/armhf-jessie/g' $^ | sed 's/%CONF%//g' >$@ build/Dockerfile.arm64-linux: Dockerfile.in mkdir -p build && sed 's/%TARGET_TAG%/arm64-jessie/g' $^ | sed 's/%CONF%//g' >$@ build/%.image: build/Dockerfile.% docker build -t opam-build-$* -f $^ build touch $@ # Actually, this is for debian 8 jessie, and varies wildly CLINKING_linux = \ -Wl,-Bstatic \ -lunix -lbigarray -lmccs_stubs -lmccs_glpk_stubs \ -lstdc++ \ -Wl,-Bdynamic \ -static-libgcc CLINKING_darwin = \ -lunix -lbigarray -lmccs_stubs -lmccs_glpk_stubs \ -lstdc++ CLINKING_openbsd = $(CLINKING_darwin) LINKING = (-noautolink $(patsubst %,-cclib %,$(CLINKING_$(1)))) EXPORTS_openbsd = \ CPATH=/usr/local/include: \ LIBRARY_PATH=/usr/local/lib: \ %: opam-$(VERSION)-% opam-$(VERSION)-%: out/opam-$(VERSION)-% ln -sf $^ $@ # host: opam-$(VERSION)-$(HOST) # Build for the local host. Containerised builds, below, are preferred, but not always available build/$(HOST).env: mkdir -p build/$(HOST) cd build/$(HOST) && curl -OL $(OCAML_URL) cd build/$(HOST) && tar xzf ocaml-$(OCAMLV).tar.gz cd build/$(HOST)/ocaml-$(OCAMLV) && \ ./configure -prefix $(shell pwd)/build/$(HOST) && \ $(MAKE) world opt.opt && \ $(MAKE) install rm -rf build/$(HOST)/ocaml-$(OCAMLV) build/$(HOST)/ocaml-$(OCAMLV).tar.gz touch $@ # Actually builds out/opam-$(VERSION)-$(HOST), but we don't want to override the # rule that goes through a container host: out/opam-full-$(VERSION).tar.gz build/$(HOST).env rm -rf build/opam-full-$(VERSION) cd build && tar xzf ../$< ( export \ PATH=$(shell pwd)/build/$(HOST)/bin:$$PATH \ MAKE=$(MAKE) \ $(EXPORTS_$(HOST_OS)); \ cd build/opam-full-$(VERSION) && \ ./configure && \ echo "$(call LINKING,$(HOST_OS))" >src/client/linking.sexp && \ $(MAKE) lib-ext DUNE_ARGS="--root=`pwd`"; \ $(MAKE) opam DUNE_ARGS="--root=`pwd`"; \ ) cp build/opam-full-$(VERSION)/opam out/opam-$(VERSION)-$(HOST) strip out/opam-$(VERSION)-$(HOST) rm -rf build/opam-full-$(VERSION) # Containerised builds out/opam-$(VERSION)-%-linux: build/%-linux.image out/opam-full-$(VERSION).tar.gz docker run --rm -v `pwd`/out:/src \ -e "VERSION=$(VERSION)" \ -e "TARGET=$*-linux" \ -e "LINKING=$(call LINKING,$(HOST_OS))" \ opam-build-$*-linux clean: rm -rf build distclean: clean rm -rf out REMOTE_DIR = /tmp/opam-release REMOTE_MAKE = make remote: out/opam-full-$(VERSION).tar.gz ssh "$(REMOTE)" "mkdir -p $(REMOTE_DIR)/out" scp Makefile "$(REMOTE):$(REMOTE_DIR)/" scp "$^" "$(REMOTE):$(REMOTE_DIR)/$^" ssh "$(REMOTE)" 'sh -c "cd $(REMOTE_DIR) && ulimit -s 8192 && $(REMOTE_MAKE) host TAG=$(TAG) VERSION=$(VERSION) OCAMLV=$(OCAMLV)"' scp "$(REMOTE):$(REMOTE_DIR)/out/opam-$(VERSION)*" out/ opam-2.0.5/release/Dockerfile.in0000644000175000017500000000175013511367404015500 0ustar nicoonicooFROM multiarch/debian-debootstrap:%TARGET_TAG% # May need configuration on the host: # docker run --rm --privileged multiarch/qemu-user-static:register --reset LABEL Description="opam release builds" Vendor="OCamlPro" Version="1.0" RUN apt-get update && apt-get install bzip2 g++ make patch wget libltdl-dev --yes && apt-get clean --yes RUN useradd -U --create-home opam ADD https://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-4.04.2.tar.gz /root/ WORKDIR /root RUN tar xzf ocaml-4.04.2.tar.gz WORKDIR ocaml-4.04.2 RUN ./configure %CONF% -prefix /usr/local RUN make world opt.opt RUN make install RUN rm -rf /root/ocaml-4.04.2 /root/ocaml-4.04.2.tar.gz ENV PATH /usr/local/bin:/usr/bin:/bin USER opam VOLUME /src WORKDIR /home/opam/ CMD tar xzf /src/opam-full-${VERSION}.tar.gz && \ cd opam-full-${VERSION} && \ echo "(${LINKING})" > src/client/linking.sexp && \ ./configure --with-mccs && \ make lib-ext opam && \ strip opam && \ cp opam /src/opam-${VERSION}-${TARGET} opam-2.0.5/opam-devel.opam0000644000175000017500000000250613511367404014370 0ustar nicoonicooopam-version: "1.2" version: "2.0.5" maintainer: "opam-devel@lists.ocaml.org" authors: [ "Vincent Bernardoff " "Raja Boujbel " "Roberto Di Cosmo " "Thomas Gazagnaire " "Louis Gesbert " "Fabrice Le Fessant " "Anil Madhavapeddy " "Guillem Rieu " "Ralf Treinen " "Frederic Tuong " ] homepage: "https://opam.ocaml.org" bug-reports: "https://github.com/ocaml/opam/issues" dev-repo: "https://github.com/ocaml/opam.git" build: [ ["./configure" "--disable-checks" "--prefix" prefix] [make "%{name}%.install"] ] build-test: [make "tests"] depends: [ "opam-client" {= "2.0.5"} "cmdliner" {>= "0.9.8"} "dune" {build & >= "1.2.1"} ] post-messages: [ "The development version of opam has been successfully compiled into %{lib}%/%{name}%. You should not run it from there, please install the binaries to your PATH, e.g. with sudo cp %{lib}%/%{name}%/* /usr/local/bin If you just want to give it a try without altering your current installation, you could use instead: alias opam2=\"OPAMROOT=~/.opam2 %{lib}%/%{name}%/opam\"" {success} ] available: ocaml-version >= "4.02.3" opam-2.0.5/doc/0000755000175000017500000000000013511367404012223 5ustar nicoonicooopam-2.0.5/doc/Makefile0000644000175000017500000000447713511367404013677 0ustar nicoonicoo-include ../Makefile.config ifeq ($(DUNE),) DUNE_EXE = ../src_ext/dune-local/_build_bootstrap/install/default/bin/dune$(EXE) ifeq ($(shell command -v cygpath 2>/dev/null),) DUNE := $(DUNE_EXE) else DUNE := $(shell echo "$(DUNE_EXE)" | cygpath -f - -a) endif else DUNE_EXE= endif DUNE_PROFILE ?= release DUNE_ARGS ?= ifndef OPAM OPAM = $(DUNE) exec --profile=$(DUNE_PROFILE) -- opam endif TOPICS = $(shell $(OPAM) help topics) TOPICS_ADMIN = cache filter index lint list upgrade HELPFMT = --help=groff ifndef OPAM_INSTALLER OPAM_INSTALLER = $(DUNE) exec --profile=$(DUNE_PROFILE) -- opam-installer endif .PHONY: man html pages all: man html pages man: rm -rf man mkdir -p man $(OPAM) $(HELPFMT) > man/opam.1 2> man/err for i in $(TOPICS); do\ $(OPAM) $$i $(HELPFMT) > man/opam-$$i.1 2>> man/err ; \ done $(OPAM) admin $(HELPFMT) > man/opam-admin.1 2>> man/err for i in $(TOPICS_ADMIN); do\ $(OPAM) admin $$i $(HELPFMT) > man/opam-admin-$$i.1 2>> man/err ; \ done $(OPAM_INSTALLER) $(HELPFMT) > man/opam-installer.1 2>> man/err # Dune doesn't (yet) support --no-print-directory @sed -f man.sed man/err > man/err2 @if test -s man/err2 ; then cat man/err2 ; false ; fi man-html: man rm -rf man-html mkdir -p $@ echo '' >$@/index.html echo '' >>$@/index.html echo ' Opam man-pages index' >>$@/index.html echo '' >>$@/index.html echo '

Opam $(version) man-pages index

' >>$@/index.html echo '
    ' >>$@/index.html for f in man/*; do\ man2html -r $$f | sed 1,2d > $@/$$(basename $$f .1).html;\ echo "
  • $$(basename $$f .1)
    • " >>$@/index.html;\ done echo '
' >>$@/index.html echo '' >>$@/index.html html: rm -rf html cd .. && $(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) @doc cp -r ../_build/default/_doc/_html html sed 's/%{OPAMVERSION}%/'$(version)'/g' index.html > html/index.html # Not to break older links, add manpages to the `ocamldoc` dir mkdir -p html/ocamldoc cd html/ocamldoc && for f in ../*/*/index.html; do\ ln -sf $$f $$(basename $$(dirname $$f)).html;\ done pages/%.html: pages/%.md omd $^ -o $@ PAGES=$(wildcard pages/*.md) pages: $(PAGES:.md=.html) clean: rm -rf dependencies.dot man html/ocamldoc man-html pages/*.html html/index.html opam-2.0.5/doc/release/0000755000175000017500000000000013511367404013643 5ustar nicoonicooopam-2.0.5/doc/release/readme.md0000644000175000017500000000215313511367404015423 0ustar nicoonicoo## Steps to follow for each release * Update version (and copyright year) in `configure.ac`, `shell/opam_installer.sh` * Run `make configure` to regenerate `./configure` * Run `make tests`, `opam-rt` (with and without aspcud) -- now checked by travis * Run `make doc` to re-generate the API documetation -- * update the CHANGELOG * tag the release (git tag -a 1.2.1; git push origin 1.2.1) * create a release on github based on your tag (https://github.com/ocaml/opam/releases/new) -- * Generate an inclusive source tarball (and the binary for your current arch while you're at it): ``` ./shell/release.sh full-archive binary publish -n git-name:git-token ``` * Check that it's been properly uploaded on https://github.com/ocaml/opam/releases * Ask people on other archs (and with write access to opam) to run ``` wget https://raw.github.com/ocaml/opam/master/shell/release.sh && \ bash -ue ./release.sh -t $VERSION ``` -- * Add some news about the release on the platform blog * Update the installation instructions in doc/pages * Update the opam-lib, opamfu, opam2web opam packages * Announce ! (platform-list, caml-list) opam-2.0.5/doc/modules0000644000175000017500000002362613511367404013627 0ustar nicoonicooWarning: this file may not contain the most up-to-date information. You should refer to index.html instead. src │ ├── core Generic standard and system library │   │   [ opam-core lib ] │   ├── opamVersion.ml (generated) Current OPAM version │   ├── opamCoreConfig.ml Configuration options for this lib (record, global reference and setter) │   ├── opamVersionCompare.ml Version comparison function used throughout. From the Dose suite. │   ├── opamJson.ml Wrapper on Jsonm; only needed for some debug options │   ├── opamStd.ml Generic stdlib functions (String, List, Option, Sys submodules...) │   ├── opamConsole.ml Console output, ANSI color, logging and user querying │   ├── opamCompat.ml.4.01/4.02 Compatibility layer (Bytes, etc.) for different OCaml versions │   │   # system handling │   ├── opamProcess.ml Process and job handling, with logs, termination status, etc. │   ├── opamSystem.ml Bindings of lots of filesystem and system operations │   ├── opamFilename.ml Higher level file and directory name manipulation AND file operations, wrappers on OpamSystem using the filename type │   ├── opamParallel.ml Parallel execution of jobs following a directed graph │   ├── opamUrl.ml URL parsing and printing, with support for our different backends | | # Windows support │   ├── opamStubsTypes.ml Types in the stubs definitions (shared between both implementations) │   └── opamStubs.ml C stubs for Windows. A "dummy" alternate is provided for Unix, which doesn't require any C code │ ├── format Definition of OPAM datastructures and its file interface │   │   [ opam-format lib ] │   ├── opamFormatConfig.ml Configuration options for this lib (record, global reference and setter) │   ├── opamTypes.mli Definitions of many types used throughout │   ├── opamTypesBase.ml Helper functions on the base types. Often opened │   │   # basic types, used as keys │   ├── opamCompiler.ml The compiler type (string, version pairs) │   ├── opamPackage.ml The package type, and package name type (name+version, values often called "nv" in the code) │   ├── opamRepositoryName.ml The repository type │   ├── opamSwitch.ml The switch type │   ├── opamVariable.ml OPAM variables with scope (global or module) │   │   # more advanced types │   ├── opamFilter.ml Formulas on variables, as used in opam files build scripts │   ├── opamFormula.ml Formulas on packages, opt. with sub-formulas on versions, and conversion functions │   │   # file format │   ├── opamLineLexer.mll A simple lexer to list of lines, which are lists of words │   ├── opamLexer.mll OPAM config file lexer │   ├── opamParser.mly OPAM config file generic type parser │   ├── opamFormat.ml OPAM config files syntax and conversion tools, printing │   └── opamFile.ml Handles all OPAM file formats as record types and submodules, conversion to and from syntax │ ├── repository Handling of remote sources │   │   [ opam-repository lib ] │   ├── opamRepositoryConfig.ml Configuration options for this lib (record, global reference, setter, initialisation) │   ├── opamRepositoryBackend.ml Signature for repository handlers and some helpers for the repository type │   ├── opamRepositoryPath.ml Defines the file hierarchy in repositories │   ├── opamDownload.ml Configuration init and handling of downloading commands │   ├── opamHTTP.ml Main HTTP backend │   ├── opamLocal.ml Rsync backend, for local or ssh sources │   ├── opamVCS.ml Layer for handling version control sources │   ├── opamDarcs.ml Darcs support (through OpamVCS) │   ├── opamGit.ml Git support (through OpamVCS) │   ├── opamHg.ml Mercurial support (through OpamVCS) │   └── opamRepository.ml Operations on repositories (update, fetch...) based on the above backends │ ├── solver Solver and Cudf interaction │   │   [ opam-solver lib ] │   ├── opamSolverConfig.ml Configuration options for this lib (record, global reference, setter, initialisation) │   ├── opamActionGraph.ml Handles graphs of actions (package changes), based on ocamlgraph │   ├── opamCudfSolver.ml Bindings to CUDF solvers │   ├── opamCudf.ml Solver interaction, conversion of answer to solution │   └── opamSolver.ml Entry point, conversion of universe to cudf, dependencies computation │ ├── state Handling of the ~/.opam hierarchy and actions on it │   │   [ opam-state lib ] │   ├── opamStateConfig.ml Configuration options for this lib (record, global reference, setter, initialisation) │   ├── opamPath.ml Defines the file hierarchy in ~/.opam │   ├── opamScript.ml (generated) Shell config scripts as OCaml strings │   ├── opamStateTypes.mli Defines the types holding global, repository and switch states │   ├── opamGlobalState.ml Loading and handling of the global state of an opam root │   ├── opamRepositoryState.ml loading and handling of the repository state of an opam root (i.e. what is in ~/.opam/repo) │   ├── opamSwitchState.ml Loading and querying a switch state │   ├── opamPackageVar.ml Resolution and handling of opam variables + filters │   ├── opamFileTools.ml Generic tools for handling package metadata │   ├── opamSwitchAction.ml Switch-related actions and changes │   ├── opamEnv.ml Process environment setup and handling, shell configuration │   ├── opamPinned.ml Specific query and handling of pinned packages │   ├── opamUpdate.ml Synchronisation and downloading of repositories and package sources │   ├── opamSolution.ml Interface with the solver, processing of full solutions through actions │   └── opamAction.ml Handles concrete actions on packages, like installations and removals │ ├── stubs C stubs. This library is built on Windows-only and automatically pulled into opam-core if needed │   ├── opamInject.c Code for process injection shared between opamWindows.c and opam-putenv.c │   ├── opamWindows.c C stubs themselves │   └── opamWin32Stubs.ml OCaml external declarations for the stubs │ ├── client Everything related to the OPAM state, installation and front-end │   │   [ opam-client lib ] │   ├── opamClientConfig.ml Configuration options for this lib (record, global reference, setter, initialisation), plus helper for global setup │   ├── opamConfigCommand.ml Functions for the "opam config" subcommand │   ├── opamPinCommand.ml Functions for the "opam pin" subcommand │   ├── opamRepositoryCommand.ml Functions for the "opam repository" subcommand │   ├── opamSwitchCommand.ml Functions for the "opam switch" subcommand │   ├── opamListCommand.ml Functions for the "opam list" subcommand │   ├── opamClient.ml High-level execution of user-facing functions like "upgrade", and wrappers around the *Command modules │   ├── opamGitVersion.mli (generated) Current git version of OPAM │   ├── opamArg.ml Command-line argument parsers and helpers │   │   [ opam exe ] │   └── opamMain.ml Main, including cmdliner command handling │ └── tools │   [ opam-admin tool ] ├── opam_mk_repo.ml Repo index and archives generation ├── opam_depexts_change.ml Operation on external dependencies in a repo ├── opam_findlib.ml Automatically add some findlib information to a repo ├── opam_rename.ml Package renaming ├── opam_stats.ml Repo stats & graphs generation ├── opam_repo_check.ml Check the repo for errors ├── opam_admin.ml Source of the opam-admin tool, main │   [ other stand-alone tools ] ├── opam_admin_top.ml Tiny library for admin-scripts, included in opam-admin.top ├── opam-putenv.c Tiny C tool used on Windows for cross-architecture process injection ├── opam_check.ml Tiny tool used in internal checks ("make tests") ├── opam_installer.ml Handles OPAM's ".install" files └── opamlfind.ml Experimental ocamlfind wrapper tool opam-2.0.5/doc/man.sed0000644000175000017500000000023213511367404013470 0ustar nicoonicoo/^Entering directory '/d /^File .*jbuild", line 1, characters 0-0:/{ :a N /Note: You can use.*to dune/!ba } /Warning: jbuild files are deprecated/d opam-2.0.5/doc/index.html0000644000175000017500000003477613511367404014241 0ustar nicoonicoo opam %{OPAMVERSION}% API and libraries documentation

opam %{OPAMVERSION}% API and libraries documentation

src/core opam-core library
Generic standard and system library
opamVersion.ml (generated) Current opam version
opamCoreConfig.ml Configuration options for this lib (record, global reference and setter)
opamVersionCompare.ml Version comparison function used throughout. From the Dose suite.
opamJson.ml Wrapper on Jsonm; only needed for some debug options
opamStd.ml Generic stdlib functions (String, List, Option, Sys submodules...)
opamConsole.ml Console output, ANSI color, logging and user querying
opamCompat.ml.4.01/4.02 Compatibility layer (Bytes, etc.) for different OCaml versions
System handling
opamProcess.ml Process and job handling, with logs, termination status, etc.
opamSystem.ml Bindings of lots of filesystem and system operations
opamHash.ml Type and computation of file checksums
opamFilename.ml Higher level file and directory name manipulation AND file operations, wrappers on OpamSystem using the filename type
opamDirTrack.ml Tracking of changes in a given filesystem subtree
opamParallel.ml Parallel execution of jobs following a directed graph
opamUrl.ml URL parsing and printing, with support for our different backends
Windows support
opamStubsTypes.ml Types in the stubs definitions (shared between both implementations)
opamStubs.ml C stubs for Windows. A “dummy” alternate is provided for Unix, which doesn’t require any C code
src/format opam-format library
Definition of opam datastructures and its file interface
opamFormatConfig.ml Configuration options for this lib (record, global reference and setter)
opamTypes.mli Definitions of many types used throughout
opamTypesBase.ml Helper functions on the base types. Often opened
opamPath.ml Defines the file hierarchy in ~/.opam
basic types, used as keys
opamPackage.ml The package type, and package name type (name+version, values often called "nv" in the code)
opamRepositoryName.ml The repository type
opamSwitch.ml The switch type
opamVariable.ml opam variables with scope (global or module)
more advanced types
opamFilter.ml Formulas on variables, as used in opam files build scripts
opamFormula.ml Formulas on packages, opt. with sub-formulas on versions, and conversion functions
file format
opamLineLexer.mll A simple lexer to list of lines, which are lists of words
opamPp.ml Bidirectional transformations on top of the parser and printer
opamFormat.ml opam config files syntax and conversion tools
opamFile.ml Handles all opam file formats as record types and submodules, conversion to and from syntax
src/repository opam-repository library
Handling of remote sources
opamRepositoryConfig.ml Configuration options for this lib (record, global reference, setter, initialisation)
opamRepositoryBackend.ml Signature for repository handlers and some helpers for the repository type
opamRepositoryPath.ml Defines the file hierarchy in repositories
opamDownload.ml Configuration init and handling of downloading commands
opamHTTP.ml Main HTTP backend
opamLocal.ml Rsync backend, for local or ssh sources
opamVCS.ml Layer for handling version control sources
opamDarcs.ml Darcs support (through OpamVCS)
opamGit.ml Git support (through OpamVCS)
opamHg.ml Mercurial support (through OpamVCS)
opamRepository.ml Operations on repositories (update, fetch...) based on the above backends
src/solver opam-solver library
Solver and Cudf interaction
opamSolverConfig.ml Configuration options for this lib (record, global reference, setter, initialisation)
opamActionGraph.ml Handles graphs of actions (package changes), based on ocamlgraph
opamCudfSolver.ml Bindings to implementation of CUDF solvers, either built-in or external
opamCudf.ml Solver interaction, conversion of answer to solution
opamSolver.ml Entry point, conversion of universe to cudf, dependencies computation
src/state opam-state library
Handling of the ~/.opam hierarchy, repository and switch states
opamStateConfig.ml Configuration options for this lib (record, global reference, setter, initialisation)
opamScript.ml (generated) Shell config scripts as OCaml strings
opamStateTypes.mli Defines the types holding global, repository and switch states
opamFormatUpgrade.ml Handles upgrade of an opam root from earlier opam versions
opamSysPoll.ml Detection of host system (arch, os, distribution)
opamGlobalState.ml Loading and handling of the global state of an opam root
opamRepositoryState.ml loading and handling of the repository state of an opam root (i.e. what is in ~/.opam/repo)
opamSwitchState.ml Loading and querying a switch state
opamPackageVar.ml Resolution and handling of opam variables + filters
opamFileTools.ml Generic tools for handling package metadata
opamSwitchAction.ml Switch-related actions and changes
opamEnv.ml Process environment setup and handling, shell configuration
opamPinned.ml Specific query and handling of pinned packages
opamUpdate.ml Synchronisation and downloading of repositories and package sources
src/stubs opam-stubs library
C stubs. This library is built on Windows-only and automatically pulled into opam-core if needed
opamInject.c Code for process injection shared between opamWindows.c and opam-putenv.c
opamWindows.c C stubs themselves
opamWin32Stubs.ml OCaml external declarations for the stubs
src/client opam-client library and exec
Actions on the opam root, switches, installations, and front-end
opam-client library
opamClientConfig.ml Configuration options for this lib (record, global reference, setter, initialisation), plus helper for global setup
opamAction.ml Handles concrete actions on packages, like installations and removals
opamSolution.ml Interface with the solver, processing of full solutions through actions
opamConfigCommand.ml Functions for the "opam config" subcommand
opamPinCommand.ml Functions for the "opam pin" subcommand
opamRepositoryCommand.ml Functions for the "opam repository" subcommand
opamSwitchCommand.ml Functions for the "opam switch" subcommand
opamListCommand.ml Functions for the "opam list" subcommand
opamInitDefaults.ml Defines the built-in "opamrc" to use by default on "opam init"
opamClient.ml High-level execution of the main user commands ("install", "upgrade", "remove"), and wrapper for Pin commands
opamAuxCommands.ml Some command helpers and extra opam management functions
opamAdminRepoUpgrade.ml Handles converting package repositories from the format of older opam versions to the current format
opamAdminCheck.ml Implements the repository checks of the 'opam admin check' command.
opamGitVersion.mli (generated) Current git version of opam
opamArg.ml Command-line argument parsers and helpers
opamAdminCommand.ml All sub-commands of the "opam admin" command
opamCommands.ml Opam CLI commands and their handlers as Cmdliner terms
Main opam CLI
opamMain.ml Main opam entry point
src/tools Extra tools and utilities
Auxiliary standalone tools
opam_admin_top.ml Tiny library for admin-scripts, included in opam-admin.top
opam-putenv.c Tiny C tool used on Windows for cross-architecture process injection
opam_check.ml Tiny tool used in internal checks ("make tests")
opam_installer.ml Handles opam's ".install" files
opam-2.0.5/doc/design/0000755000175000017500000000000013511367404013474 5ustar nicoonicooopam-2.0.5/doc/design/depopts-and-features0000644000175000017500000001765513511367404017467 0ustar nicoonicooOpam metadata evolution proposal for 1.2.x ========================================== This document contains the current summary proposal for evolving Opam's metadata, together with the rationale underpinning the proposed choices. In a nutshell ------------- The new metadata will restrict the allowed values of the depopts: field and add a new field features: as follows - the depopts: field will be restricted to a simple list of packages, with no version constraints, no boolean connectors - a new field features: will be introduced to express the different possible configurations of the source packages according to the availability of arbitrarily complex combinations of other packages (also known as "variability points" in the software product lines research community) It is important to roll-out these changes to get them accepted by package maintainers as soon as possible. Current status -------------- Complex formulas for "depopts" are not allowed anymore for 1.2 packages (for packages declared with an older `opam-version`, they are still accepted with the older, awkward semantics). The `features` field is not present yet as of 1.2.1. Rationale --------- The old implementation of depopts: tried to address three different needs 1) list the packages which are not mandatory for installation, but that trigger a recompilation in case their status is modified (added, removed, downgraded, upgraded). This is needed to determine if a recompilation (and reconfiguration) is necessary 2) capture multiple package/versions patterns that lead, in the configuration phase, to enable or disable various different features 3) express incompatibilities with certain versions of these packages This has led to several difficulties in practice; optional configuration features could not be easily and faithfully translated into package dependencies, which led to an incomplete ad-hoc implementation; potential ambiguities emerged in the metadata, like in the line depopts: async >= 109.15.00 | lwt >= 2.4.3 | (lwt >= 2.4.3 & ssl) where lwt >= 2.4.3 | (lwt >= 2.4.3 & ssl) looks like a typo, as A \/ (A /\ B) is logically equivalent to A, while the intention of the maintainer was to identify two possible configurations, one with lwt only, and one with both lwt and ssl. As a consequence, it has been decided to fully separate the three issues, capturing them in different fields, with a clear semantics. Core Proposal ------------- Notice that items below are numbered according to the needs they addressed, but presented in order of increased implementation complexity 1) the depopts: field now contains only a list of package names (no version constraints, no boolean combinations, just a list); Semantics: In case the status of any package appearing in this field is modified (added, removed, downgraded, upgraded), a recompilation of the package is scheduled. The depopts: field is not used at all by the package dependencies resolution phase, and must not be translated into CUDF. After the solver returns a solution, packages in this list that are present in the system are added with all their dependencies to the dependency cone, which is then visited to determine a compatible compilation order. 3) incompatibilities implicitly expressed in the depopts: lines by using version constraints must now be made explicit in the form of conflicts added to the list contained in the conflicts: field There is no change in the semantics of conflicts: and rewriting the few old versioned depopts can be performed manually or automatically. For example, depopts: async >= 109.15.00 | lwt >= 2.4.3 | (lwt >= 2.4.3 & ssl) conflicts: tyxml will become depopts: async, lwt, ssl conflicts: tyxml, async < 109.15.00, lwt < 2.4.3 2) a new field features: is added, that contains a list of "feature specifications", each feature specification being composed by: - a state-variable (or configuration variable) - a string describing the feature - an arbitrary boolean formula built out of atoms that are package names, possibly with version constraints features: [ ssl-support "Support for SSL" { lwt >= 2.4.3 & ssl } ; multi-backend "Enable both Async and Lwt" {lwt >= 2.4.3 & async > 109.15.00 } ; minimal "Only minimalistich HTTP support" {lwt & -async & -ssl} ] Semantics: a feature, and the corresponding state variable, is enabled iff the associated boolean formula is satisfied by the current package state; this is easy to compute, as it is a simple boolean evaluation of the formula in the assignment given by the package state. Features are invisible to the solver, and intended to be used in the configuration and build phase. Benefits: it is now easy to read the intended meaning of the maintainer in the metadata, and it is possible to output meaningful information to the user during the package installation/recompilation phase Impact: ------- These above changes require several modifications to the current code base: 1) requires implementing a simple new parser and checking the logic for computing recompilation; 2) requires implementing another parser, a simple propositional logic evaluator, some user output, and an interconnection with the state-variables 3) is a noop in the code, but requires some manual rewriting of the metadata in the archive (this might be automated, but might not be worth the effort) Hence we propose to limit the changes in the next release to what is described up to here. =======END OF PROPOSED CHANGES FOR 1.2.x ==================================================== In the longer term, one may consider the following Proposal extensions: -------------------- Having isolated features clearly, we can imagine to use them for extra functionality, for example: user hints besides telling the user that a feature is enabled or not, one could add logic to compute a suggestion for enabling a feature, if requested. This will necessarily be based on some heuristics, as there might be exponentially many ways to satisfy an arbitrary boolean condition. reduced recompilation needs now that state-variables are clearly identified in the features, it is easy to check that when there is no change in the values of these state-variables, and in the versions of the packages involved in the *enabled* feature set, then no recompilation is needed: the configuration logic will only use the state-variables, which did not change, and only change to packages actually used for an enabled state-variables may be involved in a recompilation An extra suggested extension is the possibility of mixing in the formulae in the features: field state-variables and packages, like in the following example features: [ ssl-support "Support for SSL" { os != "windows" & ssl >= 1.1 & (lwt < 4 | async) } ] This requires a significant amount of extra effort to: - distinguish syntactically a package named os from a state variable named os - implement comparison with possibly non-boolean values of a state variable (the os != "windows" above) - detect and reject cyclic dependencies among state variables, like in ssl-support "Support for SSL" { ssl-support & ssl >= 1.1 & (lwt < 4 | async) } or in ssl-support "Support for SSL" { - foo & ssl >= 1.1 & (lwt < 4 | async) } foo "Just for the example" { - ssl-support } Complexity versus usefulness need to be carefully assessed beforehand. opam-2.0.5/doc/design/depexts-plugins0000644000175000017500000001262113511367404016554 0ustar nicoonicooProposal for a plugin architecture for supporting checking and resolving of external dependencies (depexts) in OPAM > 1.2 ======================================================================== Rationale --------- The opam package metadata now contains a specific field for declaring dependencies on external packages handled through external package managers (typically, distribution and OS dependent, but may in general be any other package manager). There are two main functionalities that are needed: - checking whether external dependencies are satisified at a given moment; this is an operation that can be implemented in linear time (we are just checking whether a boolean formula is true or false); since external packages are managed outside opam, this check needs to be performed at the beginning of each opam run, to discover packages that are no longer functional, and report the issue to the user. With proper, OS specific integration, this operation can be made blazingly fast; a simple hack, calling an external command each time, may be functionally equivalent, but quite slow. - finding a way of satisfying external dependencies required by a set of opam packages; this is potentially much more expensive, it involves not only a dependency solving phase, but also the fetch and installation phase, and requires proper interfacing with the existing OS specific package manager. This should be done only when modifying or fixing an opam configuration and after asking user confirmation. Making things work smoothly and efficiently requires OS specific knowledge that is best found among experienced users of each OS, which may be different people, with different knowledge of Opam internals: a well designed plugin infrastructure can separate concerns and facilitate contributions. Proposal -------- It is proposed to create a plugin architecture for OS specific external dependencies, extending the following module signature for the modules implementing a plugin module type OSDependencyLayer = sig type depexts (* external dependencies, a CNF involvin OS-specific stuff *) type actions (* an abstract token corresponding to actions, and a textual representation of them to present to the user *) type explanations (* in case the depexts cannot be satisfied, explain why *) type result = Can of actions | Cannot of explanations type outcome (* result of the execution of the OS-specific actions *) val satisfied : depexts -> bool (* are the depexts already satisfied ? *) val cansatisfydepexts : depexts -> result val perform : actions -> outcome end Notice that there are two distinct sets of functions for the very different cases outlined above: - satisfied performs just a check to see whether depexts are already satisfied - cansatisfydepexts tries to solve the external dependencies, and returns a proposed action, or an explanation for the failure, while perform executes the actions (typically after user confirmation) The proposed module interface is intentionally incomplete, as it makes no assumption on the way in which plugins are identified, and registered, which is an orthogonal issue. Note on OCaml detection ----------------------- The OCaml compiler itself is an external dependency when using "system" switches. It's currently handled by a specific, dynamically generated compiler definition, with some ad-hoc code to treat it specifically, or check that it didn't change at startup time. With the current trend to move compiler handling to packages, the above won't work anymore, because "system" would now need to be a specific, dynamic package. While re-implementing the system switch hacks in this context would certainly be possible, having the depexts mechanism flexible enough to handle all this consistently would certainly be more consistent and easier to maintain. Here is a possibility: having an 'ocaml-system' package (that would "provide" ocaml) with depext on the system ocaml. * the package needs to be able to export some environment variables that are currently exported by the switch (`CAML_LD_LIBRARY_PATH`). * a change of this package should be detected at OPAM startup -- like for any depexts * "system" compilers currently don't have to be managed by the OS, they are just looked for in the PATH. Keeping this would probably require a specific (lower level) "depext" plugin, that wouldn't have the functionalities to install the depext. * this raises a new, but valid, concern: the above handles a binary state for depexts, while for this, we'd need to detect changes also. Creating one 'ocaml-system' package version for each possible compiler version may be an answer: on system compiler change, the installed 'ocaml-system' becomes invalid, and you'll need to replace it by the fitting version (recompiling all dependent packages as you go). * However, it sounds quite difficult to hold a middle ground between - "resolve with all OPAM packages installable, then check and handle their depexts", and - "check depexts, and then resolve with OPAM packages that can be installed with what's currently on the system;" (don't install them, except on conflict (how exactly?)) and the above won't play well with first option here, second option raising many more questions. Maybe this doesn't fit well with depexts, but it's worth considering opam-2.0.5/doc/design/provides.md0000644000175000017500000001144713511367404015660 0ustar nicoonicoo# Provides field proposal This is a proposal to add a `provides:` field to the OPAM package description format. The feature is already supported by the Cudf format, which should ease the most difficult parts of the implementation. The purpose of this field is to make depending on a choice of packages providing the same feature easier. The `opam` file format is changed as such: ``` := ... ?provides: [ + ] ``` If package `a` is providing `b {constraint}`, this is to be understood as > installation of `a` implies that any version of `b` satisfying `constraint` > should be considered installed for all purposes regarding dependency > resolution. In particular: - any package depending on `b` with a constraint that has a non-empty intersection with `constraint` can be installed ; - any package with such an optional dependency would need to be compiled after `a`, and rebuilt on changes to `a` ; - conversely, any package conflicting with `b` with a constraint compatible with `constraint` can't be installed together with `a`. It may be simpler to start by implementing `provides` only for definite versions. ## Added functionality The feature provided can already be encoded without an extra field: given a list of packages that `provide` a given name, a package by this name can be added with a dependency towards either of those. However, on a repository maintenance point of view, having to list all the alternatives adds much more burden. Besides, it's not possible, using pinning or an additional repository, to provide a replacement for a base-repo package without redefining it explicitly: that's sometimes very useful to extend the OCaml versions where some package is available, for example. ## Virtual and replacement packages `provides` entries share the namespace of usual packages, and may therefore create _virtual_ packages, i.e. packages that only exist as provided by other packages. In the other case around, packages may both have a concrete definition and appear as `provides`, in which case we would speak of _replacement_ packages. In both cases, great care should be taken in the user interface. For example: - what to do when the user requires the installation of a virtual package ? (In `apt-get`, this is an error.) - should we print an advertisement when installing a package that has possible replacements ? - when querying info on a package, possible alternatives should be shown. - should virtual packages be listed in the normal package listing ? - other commands referring to a given package (e.g. `pin`) may become ambiguous, so they should probably just ignore `provides`, and display a warning for virtual packages. The case of replacement packages is a bit more tricky, because it may easily get confusing if the dependencies aren't explicitly traced. The format of the package index will have to be extended to allow for virtual packages, which may not have a definite version. ## Use-cases * camlp4 should be made a virtual package, provided by different implementations for different compiler versions. The current handling using package versions causes expectations on the upgrade of those, spurious warnings of not up-to-date packages, and obfuscates real upgrades. * Allow aliases or renaming of packages (see #1879). * Allow to fork existing package and provide a replacement in the repository (for example cryptokit-sha512, see #314). * Built-in stuff in the compiler would be made simpler with `provides` lines instead of the concrete (but empty) `base-` packages. With compilers in packages, that would fit well in the compiler package's description. * Adds flexibility in changing the granularity of packages: packagers could more easily go back and forth between splitting in small units or packaging a bundle. ## Constraint intersection While OPAM usually solves version constraints based on the set of actual versions, this needs to be symbolic, i.e. non-empty intersection of the sets of _possible_ versions. For example, the intersection of `a {>= 3}` and `a {<= 3}` is non-empty even if there was no known `a.3` version before. This will need some care in the opam to Cudf version conversion, which is currently based on existing versions. ## Interactions with the `features` field While `provides` occupies the namespace of packages, and is used in dependency resolution, `features` occupies that of variables, and is intended for use only at build time (we should forbid its use in the `available` field, which is resolved before dependencies). However, both indicate things that are made available by the package, so there is a high risk of user confusion. I think both are important features that we want, and there is no way to merge them, but this is to be taken into account in the interface design and documentation ; `features` might be renamed (`traits` ?). opam-2.0.5/doc/pages/0000755000175000017500000000000013511367404013322 5ustar nicoonicooopam-2.0.5/doc/pages/External_solvers.md0000644000175000017500000001753213511367404017213 0ustar nicoonicoo# External Solvers Resolving package installations in the presence of dependencies and conflicts is known to be an [NP-complete problem](https://hal.archives-ouvertes.fr/file/index/docid/149566/filename/ase.pdf). Thankfully, a [big effort](http://www.mancoosi.org/) has already been put into solving it efficiently: The `opam` package manager is an instance of the approach described in the article "[A modular package manager architecture](http://dl.acm.org/citation.cfm?id=2401012)", which was one of the outcomes of the [Mancoosi](http://www.mancoosi.org) research project. This architecture relies on dependency solvers for package managers, that communicate with the package manager front-end via the [CUDF format](http://www.mancoosi.org/cudf/). ## Installation and compatibility As of 2.0.0, opam comes with a CUDF solver built-in by default, so unless you have specifically compiled without it, you shouldn't have to be worried about installing an external solver. However, these are still supported, and can be useful in some specific cases. An external solver can be chosen over the built-in one using the `--solver` command-line argument, the `$OPAMEXTERNALSOLVER` environment variable, or the `solver:` field in the `~/.opam/config` file. If no solver was built in or selected, opam will detect the availability of `aspcud`, `packup` or `mccs` commands on your system and use one automatically. The following CUDF solvers have been tested: - [aspcud](http://www.cs.uni-potsdam.de/wv/aspcud/) (recommended solution until opam 1.2.2) - [packup](http://sat.inesc-id.pt/~mikolas/sw/packup/) - [mccs](http://www.i3s.unice.fr/~cpjm/misc/mccs.html) (a modified version of which is now being used as the built-in solver) - [p2Cudf](https://wiki.eclipse.org/Equinox/p2/CUDFResolver), which can be downloaded [here](http://eclipse.org/equinox/p2/p2CUDF/org.eclipse.equinox.p2.cudf-1.14.jar) and used with the configuration string `java -jar -obj %{criteria}% %{input}% %{output}%`. These have been developed by a variety of research teams during the [MISC competitions](http://www.mancoosi.org/misc/) run yearly from 2010 to 2012. # Specifying user Preferences for the External Solvers A fundamental distinguishing feature of the `opam` package manager is the fact that it is designed to reuse state-of-the-art dependency solving technology that gives the users the possibility to express their preferences regarding the operations to be performed during an installation, instead of being bound to an hard-coded strategy. This section provides basic documentation on this feature, and its usage. ## What are user preferences for installations, and why are them important? When you request the installation of some packages, say p1...pn, `opam` has a lot to do: it needs to look at all the packages already installed on your machine, find all packages available from the repositories, consider your request, and then come up with a set of actions to be performed to satisfy your request. Unfortunately, there are a lot of assumptions hidden in your mind when you tell `opam` that you want p1...pn installed: should it choose the latest version of the p1...pn? That seems a sensible thing to do, but sometimes installing a recent version of a package p may lead to downgrading or removing another package q, which is something you might not want. What should `opam` do in this case? Remove q to get the latest p, or keep q and get the most recent p that is compatible with it? Well, the answer is: it depends! It depends on what _you_ really want, and different users may have different points of view. User preferences, supported by `CUDF`-compatible solvers, are the means you can use to make the assumptions in your mind explicit and known to the solver used by `opam`, so that the actions performed on your machine correspond to your personalised needs. ## How do I express my preferences? Preferences are expressed using a simple language built by prefixing a little set of combinators with the `-` (minus) or `+` (plus) operators. The most useful combinators are the following ones: * `new` : the number of new packages * `changed` : the number of packages modified * `removed` : the number of packages removed * `notuptodate` : the number of packages that are not at their latest version For example, the preference `-removed` tells the solver that among all possible ways of satisfying your request, it should choose one that minimises the number of packages removed. These combinators can be combined in a comma separated sequence, that is treated in lexicographic order by the solver. ### Default preferences for an upgrade For example, the preference `-removed,-notuptodate,-changed` tells the solver that after ensuring that removals are minimised, it should look for a solution that minimises also the number of packages which are not at their latest version, and then reduce the changes to a minimum. This is close to the default preference setting used by `opam` when you perform an update or an upgrade, and in practice it tries to bring _all_ your packages to the latest version available, as far as this does not implies removing too many packages. It can be set using the environment variable `OPAMUPGRADECRITERIA`, or the [`solver-upgrade-criteria:`](Manual.html#configfield-solver-upgrade-criteria) configuration field. ### Default preferences for an install When you request to install a (set of) package(s), in general you do not expect to see all your existing packages updated, and this is why in this case it is preferable to use a different value `-removed,-changed,-notuptodate` that tries to minimise changes to the system. It can be set using the environment variable `OPAMCRITERIA`, or the [`solver-criteria:`](Manual.html#configfield-solver-criteria) configuration field. ### Specifying preferences for opam `opam` allows one to specify criteria on the command line, using the `--criteria` option, that will apply only to the current command. For example, if you are a very conservative user, you might try issuing the following command: ``` opam install --criteria="-removed,-changed" ... ``` This can also be used for some tricks: if for example you want to repair your set of installed packages, you can use the `opam upgrade` command without specifying a preference for newer versions in the criteria (although you may prefer to run `opam upgrade --fixup` in this case): ``` opam upgrade --criteria="-changed" ``` ## Yes, there are different versions of the user preference language The different editions of the MISC competition led to improving the preferences language, by allowing the user progressively more flexibility. Recent solvers give access to a more sophisticated set of preferences, described in [the 2012 MISC competition rules](http://www.mancoosi.org/misc-2012/criteria/). For example, using `aspcud >=1.8.0`, you could use `-count(removed),-count(down),-sum(solution,installedsize),-notuptodate(solution),-count(changed)` to instruct a solver to minimise downgrades, and mininise the installed size, among other criteria. The default criteria used by opam use a custom CUDF property `version-lag` that gives a monotonic measure of the "age" of packages, by counting the number of newer revisions of the package. They can be seen using the `opam config report` command: ``` # install-criteria -removed,-count[version-lag,request],-count[version-lag,changed],-changed # upgrade-criteria -removed,-count[version-lag,solution],-new ``` Notice that these criteria are written for the built-in solver which, being derived from [`mccs`](https://github.com/AltGr/ocaml-mccs), uses a slightly different syntax for the criteria: the `-sum(subset,property)` criterion should be written `-count[property,subset]` instead. We also make use of the `request` subset here, which applies only to the packages that were part of the user request, and was introduced in aspcud 1.9.0 and is not part of the official mccs release. opam-2.0.5/doc/pages/Specifying_Solver_Preferences.md0000644000175000017500000002067413511367404021630 0ustar nicoonicoo# Specifying user Preferences for the External Solvers A fundamental distinguishing feature of the `opam` package manager is the fact that it is designed to reuse state-of-the-art dependency solving technology that gives the users the possibility to express their preferences regarding the operations to be performed during an installation, instead of being bound to an hard-coded strategy. This section provides basic documentation on this feature, and its usage. ## What are user preferences for installations, and why are them important? When you request the installation of some packages, say p1...pn, `opam` has a lot to do: it needs to look at all the packages already installed on your machine, find all packages available from the repositories, consider your request, and then come up with a set of actions to be performed to satisfy your request. Unfortunately, there are a lot of assumptions hidden in your mind when you tell `opam` that you want p1...pn installed: should it choose the latest version of the p1...pn? That seems a sensible thing to do, but sometimes installing a recent version of a package p may lead to downgrading or removing another package q, which is something you might not want. What should `opam` do in this case? Remove q to get the latest p, or keep q and get the most recent p that is compatible with it? Well, the answer is: it depends! It depends on what _you_ really want, and different users may have different points of view. User preferences, supported by `CUDF`-compatible solvers, are the means you can use to make the assumptions in your mind explicit and known to the solver used by `opam`, so that the actions performed on your machine correspond to your personalised needs. ## How do I express my preferences? Preferences are expressed using a simple language built by prefixing a little set of combinators with the `-` (minus) or `+` (plus) operators. The most useful combinators are the following ones: * `new` : the number of new packages * `changed` : the number of packages modified * `removed` : the number of packages removed * `notuptodate` : the number of packages that are not at their latest version For example, the preference `-removed` tells the solver that among all possible ways of satisfying your request, it should choose one that minimises the number of packages removed. These combinators can be combined in a comma separated sequence, that is treated in lexicographic order by the solver. ### Default preferences for an upgrade For example, the preference `-removed,-notuptodate,-changed` tells the solver that after ensuring that removals are minimised, it should look for a solution that minimises also the number of packages which are not at their latest version, and then reduce the changes to a minimum. This is the default preference setting used by `opam` when you perform an update or an upgrade, and in practice it tries to bring _all_ your packages to the latest version available, as far as this does not implies removing too many packages. It can be set using the environment variable `OPAMUPGRADECRITERIA` ### Default preferences for an install When you request to install a (set of) package(s), in general you do not expect to see all your existing packages updated, and this is why in this case `opam` uses a different default value `-removed,-changed,-notuptodate` that tries to minimise changes to the system. It can be set using the environment variable `OPAMCRITERIA` ### Specifying preferences for opam Recent versions of `opam` allow one to specify criteria on the command line, using the `--criteria` option, that will apply only to the current command. For example, if you are a very conservative user, you might try issuing the following command: ``` opam install --criteria="-removed,-changed" ... ``` This can also be used for some tricks: if for example you want to repair your set of installed packages, you can use the `opam upgrade` command without specifying a preference for newer versions in the criteria: ``` opam upgrade --criteria="-changed" ``` You can also use the `OPAMCRITERIA` and `OPAMUPGRADECRITERIA` environment variables to specify your preferences (for example, adding your preferred settings to a shell profile). If both variables are set, upgrades are controlled by `OPAMUPGRADECRITERIA`, while `OPAMCRITERIA` applies to all other commands. If only `OPAMCRITERIA` is set, it applies to all commands. If only `OPAMUPGRADECRITERIA` is set, it applies to upgrade commands only, while all other commands are controlled by the `opam` internal default preferences. ## Yes, there are different versions of the user preference language The `opam` package manager is an instance of the approach described in the article "[A modular package manager architecture](http://dl.acm.org/citation.cfm?id=2401012)", which was one of the outcomes of the [Mancoosi](http://www.mancoosi.org) research project. This architecture relies on external dependency solvers for package managers, that communicate with the package manager front-end via the [CUDF format](http://www.mancoosi.org/cudf/). We have now several CUDF-compatible solvers, developed by a variety of research teams during the [MISC competitions](http://www.mancoosi.org/misc/) run yearly from 2010 to 2012: * [aspcud](http://www.cs.uni-potsdam.de/wv/aspcud/) * [Mccs](http://www.i3s.unice.fr/~cpjm/misc/mccs.html) * [Packup](http://sat.inesc-id.pt/~mikolas/sw/packup/) * [P2Cudf](https://wiki.eclipse.org/Equinox/p2/CUDFResolver) Each of these competitions led to improving the preferences language, by allowing the user progressively more flexibility. As of today, the preferences language described in the previous section, which corresponds to the one used in the 2010 competition, should be supported by all external solvers, but if you happen to use as external solver one of the entrants of the 2012 competition, like recent versions of `aspcud`, then you have access to a more sophisticated set of preferences, described in [the 2012 MISC competition rules](http://www.mancoosi.org/misc-2012/criteria/). For example, you could use `-count(removed), -count(down),-sum(solution,installedsize),-notuptodate(solution),-count(changed)` to instruct a solver to minimise downgrades, and mininise the installed size, among other criteria. The `aspcud` solver supports this extended language starting from its version 1.8.0, which unfortunately is not the version shipped by default with Ubuntu precise or Debian Wheezy. ### News in aspcud 1.9.x Starting from version 1.9.0, `aspcud` adds support for three extra selectors, that are particularly useful to perform local upgrades. Here they are: * `installrequest` is the set of packages in the solution that satisfy the requirements mentioned in the install: part of a CUDF request * `upgraderequest` is the set of packages in the solution that satisfy the requirements mentioned in the upgrade: part of a CUDF request * `request` is the union of the above two Using this extended set of package selector, it is now finally possible to specify user preferences that describe optimisations to be applied only to the packages explicitly mentioned in the request. For example, `-notuptodate(request),-count(changed)` would find a solution that tries to bring all packages mentioned in the request to their latest version, while leaving all the rest as untouched as possible. And if we have added to each package a `priority` value, we could also play with preferences like `+sum(upgraderequest,priority),-count(changed)` to get the packages mentioned in the upgrade request to the version with the highest possible priority, while leaving all the rest as untouched as possible. ## Preferences only work with the external solvers For portability reasons, `opam` also embarks an ad-hoc solver module that is built by wrapping a set of heuristics around the code of the SAT-solver which is used in the [Dose Library](http://dose.gforge.inria.fr/public_html/) for detecting broken packages. This solver module has no support for user preferences, and is not able to manage correctly large package repositories: it is highly recommended that you install an external CUDF solver (`aspcud` is the one best supported today). ## Using external solvers in the Cloud Thanks to support from [Irill](http://www.irill.org/), it is now possible to use an external solver for `opam` on any platform, over the network. See the [CUDF solver farm](http://cudf-solvers.irill.org/) for instructions. The latest version of the solver is on the farm, so you can use the full preferences language with it. opam-2.0.5/doc/pages/About.md0000644000175000017500000001145413511367404014723 0ustar nicoonicoo# opam ## A little bit of History ### opam The [first specification draft of OPAM](https://github.com/ocaml/opam/blob/30598a59c98554057ce2beda80f0d31474b94150/specs/roadmap.pdf?raw=true) was written at the end of Jan 2012 by Thomas Gazagnaire from OCamlPro. The specification was reviewed by Fabrice Le Fessant (OCamlPro/INRIA), Yaron Minsky (Jane Street) -- who funded the project, and Anil Madhavapeddy (University of Cambridge) -- who needed a source-based package manager to manage libraries emerging from the Mirage OS project. At about the same time, Frederic Tuong, an intern from Inria, funded by the DORM research grant in collaboration with OCamlPro and IRILL, started to implement [the first version of OPAM](https://github.com/ocaml/opam/commits/master?page=112) (called `ocp-get` at the time) at the end of Feb 2012. He also started to create the [first OPAM packages](https://github.com/ocaml/opam-repository/commits/master?page=200) one month later. Frederic and Thomas worked closely together in the following months to [demonstrate OPAM](https://www.youtube.com/watch?v=ivLqeRZJTGs) at the [OCaml Workshop 2012](http://oud.ocaml.org/2012/) where (almost) everyone was already using it! Frederic started a PhD in Oct 2012 and left the OPAM team to focus on his studies. Roberto Di Cosmo and Pietro Abate, from IRILL, began helping Thomas at the end of 2012 to properly integrate their [Mancoosi](http://www.mancoosi.org/) tools (such as [CUDF](http://www.mancoosi.org/cudf/) and `dose`) so that OPAM could benefit from modern constraint solving tools and be able to automatically use the `aspcud` external solver if is available. At the end of 2012, Vincent Bernardoff and Guillem Rieu (from OCamlPro) worked for a few months on improving the documentation and ease of use of OPAM for newcomers. They created [opam2web](https://github.com/ocaml/opam2web), the tool used to generate https://opam.ocaml.org. The [first public beta of OPAM](http://www.ocamlpro.com/blog/2013/01/17/opam-beta.html) was released in Jan 2013 and few months later (in March 2013) [the first official release landed](http://www.ocamlpro.com/blog/2013/03/14/opam-1.0.0.html). A few days later, Louis Gesbert -- who joined OCamlPro in Dec 2012, pushed [his first commit](https://github.com/ocaml/opam/commit/c56cf5e1e244cee9f707da8b682996bbc5dd31ff) to the codebase. In Nov 2013, [OPAM 1.1.0](https://opam.ocaml.org/blog/opam-1-1-0-released/) was released and Louis became the technical lead. A months later, [opam 1.1.1](https://opam.ocaml.org/blog/opam-1-1-1-released/) with numerous bug fixes. ### opam-repository Meanwhile, in June 2012 Mirage started to use opam (as it was using a custom 3.12.1 compiler). Very quickly, starting off Frederic's work, Anil and Thomas shared the task of adding new packages and monitor the pull-requests on opam-repository. The initial policy was to accept as many packages as possible, which means that things were often broken. So they started to use background [bulks builds](https://github.com/avsm/opam-bulk-logs) to improve the overall repository quality. In July 2012, Jane-Street's Core libraries made [its apparition](https://github.com/ocaml/opam-repository/commit/bad688d0f49f6c750525b0047b336eb8606e419d) in the repository. To improve the quality of new packages, Travis CI was [integrated](https://github.com/ocaml/opam-repository/commit/2671cb1e968e084c13989762ea43fc1a5b4703d7) in Sept 2013 to the pull-request process. From Aug to Nov 2013, all the contributors of opam-repository were contacted to re-license their contribution to CC0, which enable the [move of the repository](https://github.com/ocaml/opam-repository/issues/955) to the `ocaml` organisation. The [opam weather service](http://ows.irill.org/), created by Iril and OCamlPro, was announced in Apr 2014 and expose quality metrics to the repository quality. *Notes*: Some significant bumps in opam-repository were adoption by projects: start of the bi-weekly pulls from Jane Street on Core (the biggest one), the Ocsigen and XAPI remotes, and Mirage releases. ## Getting Support Opam has been created and is maintained by [OCamlPro](http://www.ocamlpro.com/). Bug reports and feature requests for the opam tool should be reported on [opam's issue-tracker](https://github.com/ocaml/opam/issues). Packaging issues or requests for a new package can be reported on the [official repository's issue-tracker](https://github.com/ocaml/opam-repository/issues). General queries for both the tool and the packages could be addressed on the [OCaml-platform mailing-list](http://lists.ocaml.org/listinfo/platform) and insights and evolution of opam internals can discussed on the [opam-devel mailing-list](http://lists.ocaml.org/listinfo/opam-devel). Standard commercial terms and support on opam, as well as training and consulting services, are provided by [OCamlPro](http://www.ocamlpro.com/). opam-2.0.5/doc/pages/Upgrade_guide.md0000644000175000017500000002223513511367404016414 0ustar nicoonicoo# Quick upgrade guide from opam 1.2 to opam 2.0 This guide is not a complete list of changes, but it highlights changes that users of opam 1.2 should know about, as well as some important new features. ## Command-line ### What you need to be aware of Some commands have changed syntax: - [`opam switch`](man/opam-switch.html): `create` must be specified to create a new switch. You should then specify either `--empty` or a base compiler package, _e.g._ use `opam switch create 4.06 ocaml-base-compiler.4.06.0` to create a new switch named `4.06`. Just `opam switch create 4.06.0` also still works in most cases. - [`opam repository`](man/opam-repository.html) (or `opam remote`): repositories are still configured globally, but are now selected for each switch. So by default `opam repository add` will only affect the current switch. You can change the defaults with `--set-defaults`, and choose the repositories at switch creation time with `opam switch create --repositories REPOS` - [`opam list`](man/opam-list.html) and [`opam show`](man/opam-show.html) have been largely reworked to offer more options - options to build tests and documentation are now respectively `--with-test` and `--with-doc`. They only apply to packages listed on the command-line The `opam-admin` tool, for repository operations, is now built into opam, use the [`opam admin`](man/opam-admin.html) command instead. Opam now comes with [a solver built-in](https://github.com/AltGr/ocaml-mccs), which means that installing `aspcud` alongside opam is no longer required. Pinning to a version-controlled directory will now only use what is committed by default (opam 1.2 had a "mixed mode" where it would use the current versions of files, but only the version-controlled ones. This was good most of the time, but could become puzzling _e.g._ when opam didn't see an added source file). The option [`--working-dir`](man/opam-install.html#lbAH) can be used to temporarily make opam fetch uncommitted changes (see also [`--inplace-build`](man/opam-install.html#lbAG)). Upon pinning, opam 2.0 will also select the current branch by default if unspecified, so that later running `git checkout BRANCH` in the source tree doesn't affect the pinned package. ### New features - __new command aliases__: [`opam var`](man/opam-var.html), [`opam exec`](man/opam-exec.html), [`opam env`](man/opam-env.html) can be used in place of the corresponding [`opam config`](man/opam-config.html) subcommands - __new command__: [`opam clean`](man/opam-clean.html) to clear caches, logs, etc. - __local switches__: use _e.g._ [`opam switch create .`](man/opam-switch.html#lbAE) to create a switch in the current directory. The switch contents will be in a `_opam` directory, which can be safely removed once done. The switch path can then be used as a handle to refer to the switch. Additionally, the above command will install any packages which definitions are found in the selected directory into the local switch. - __automatic pinning__: use _e.g._ [`opam install .`](man/opam-install.html#lbAD) to pin and install any packages found in the current directory. `opam install . --deps-only` can also be used to prepare a switch for working with a source tree. This extension also concerns the `remove`, `upgrade`, `reinstall` and `show` commands, and specifying the path to a specific `opam` file is also supported. - __archive caching__: opam now uses a much better caching mechanism, both locally and on the opam-repository. In particular, upstream repositories being down should no longer prevent package installation (even for older or removed packages). Git repositories are also cached. - __better error mitigation__, messages and recovery. [`opam install --restore`](man/opam-install.html#lbAF) can be used to retry after a failed operation. - a plugin, _e.g._ [`opam-depext`](https://github.com/ocaml/opam-depext/tree/2.0), will now be available from all switches once installed in one. - [`opam install --destdir`](man/opam-install.html#lbAF) can be used to copy build artefacts of given packages to an external prefix - __sandboxing__: on Linux, all package commands will now be sandboxed by default. The [`bubblewrap`](https://github.com/projectatomic/bubblewrap) tool is now required to this end. ## File formats ### What you need to be aware of > #### Repositories and migration > > **Repositories for 1.2 and 2.0 have a different format**, but everything > should be transparent unless you publish packages: > > - [**The main repository**](https://github.com/ocaml/opam-repository/tree/master) > remains in format **1.2** for now. This means the the `master` branch, and > the contents of `https://opam.ocaml.org/packages`. > - [**There is a 2.0.0 branch**](https://github.com/ocaml/opam-repository/tree/master) > that is served at `opam.ocaml.org/2.0`. > > Everything from 1.2 is converted to 2.0 when needed (on the fly by opam, > [automatically](https://github.com/AltGr/camelus/tree/2.0) on the git > repository, or manually using > [`opam admin upgrade`](man/opam-admin-upgrade.html)). > > > When publishing packages, remember that: > > - packages in **1.2 format** must be published to `master`, and they will be > available to **everyone** > - packages in **2.0 format** must be published to the `2.0.0` branch — e.g. > using the new > [opam-publish.2.0](https://github.com/ocaml/opam-publish/tree/2.0). They > will **only** be available to opam 2.0 users. - compiler definition files: these no longer exist, as compilers have been replaced by normal package definitions (that should have [`flags: compiler`](Manual.html#opamflag-compiler)) - the base syntax of `opam` files didn't change, but: - compilers now being packages, _e.g._ the field `available: [ ocaml-version >= "4.00.1" ]` is now encoded as a dependency towards the `ocaml` package with `depends: [ "ocaml" {>= "4.00.1"} ]`. The `ocaml-version` variable is no longer defined. - extra dependencies needed for test and documentation must now be flagged with resp. [`with-test`](Manual.html#opamfield-depends) and [`with-doc`](Manual.html#opamfield-depends). Fields `build-test:` and `build-doc:` are deprecated in favour of filters on [`build:`](Manual.html#opamfield-build) instructions, and there is a new [`run-test:`](Manual.html#opamfield-run-test) field - the format of the [`depexts:`](Manual.html#opamfield-depexts) field is changed - the host system is now polled through the `arch`, `os`, `os-distribution` and `os-version` variables. `os` may now take the value `macos` instead of `darwin`. - [`depopts: [ "foo" >= "v0" ]`](Manual.html#opamfield-depopts) now means that the optional dependency is only active for the corresponding versions, there is no implicit conflict with `"foo" < "v0"` - URLs must now be non-ambiguous in files, _e.g._ you must use `git+https://github.com/owner/pkg.git` rather than `https://github.com/owner/pkg.git`. The latter will still be understood as `git` and rewritten to the former if used from the command-line. - Any specified [`patches:`](Manual.html#opamfield-patches) must now apply with `patch -p1` and use unified, rather than context, diffs. - `opam switch export/import` format has been changed (but files in the 1.2 format can still be read). - __the conversion from the 1.2 format is done internally and automatic, both for repositories and when pinning.__ Be careful, however, not to submit 2.0 format files if they are to be used by opam 1.2, or published to the main repository before it makes the transition. ### New features `opam` files have been extended in a lot of ways: - more expressive [dependencies](/blog/opam-extended-dependencies/) - new fields: - [`pin-depends:`](Manual.html#opamfield-depexts) - [`run-test:`](Manual.html#opamfield-run-test) - [`setenv:`](Manual.html#opamfield-setenv) - [`conflict-class`](Manual.html#opamfield-conflict-class) - [`extra-source:`](Manual.html#opamsection-extra-sources) - [`extra-files:`](Manual.html#opamfield-extra-files) - opam now tracks installed files, so the `remove:` field can now in general be omitted. Specify [`flags: light-uninstall`](Manual.html#opamflag-light-uninstall) if you do need `remove:` instructions, but these are not required to be run from the source tree of the package. - the `descr` file is now preferably replaced by [`synopsis:`](Manual.html#opamfield-synopsis) and [`description:`](Manual.html#opamfield-description) fields in the `opam` file (and strings can be put between `"""` to avoid escaping issues) - the `url` file can be replaced by a section of the form [`url { src: "URL" checksum: "CKSUM" }`](Manual.html#opamsection-url). With the above, this allows single-file package definitions - [checksums](Manual.html#Checksums) now accept SHA256 and SHA512 besides MD5. Use the strings `"md5=HEX"`, `"sha256=HEX"`, `"sha512=HEX"`. For more details on the new opam, see: - [the manual](Manual.html) - `opam COMMAND --help` - [the changelog](https://github.com/ocaml/opam/blob/master/CHANGES) - [the blog](/blog/opam-2-0-0-rc/) for announcements of some of the new features - [the tracker](https://github.com/ocaml/opam/issues) opam-2.0.5/doc/pages/index.menu0000644000175000017500000000054613511367404015324 0ustar nicoonicoo# Contains the documentation menu with the following syntax: # without extension -> A menu title # .md -> A markdown page # empty -> A menu divider #source: https://github.com/ocaml/opam/tree/master/doc/pages opam 2.0 documentation Install.md Upgrade_guide.md Usage.md FAQ.md Tricks.md Packaging.md External_solvers.md Manual.md opam-2.0.5/doc/pages/Usage.md0000644000175000017500000001451313511367404014714 0ustar nicoonicoo# Using opam This document starts with a quick introduction, then covers most commonly-used opam features. If you are a developer and want to get a project packaged or change an existing package, see the step-by-step [packaging guide](Packaging.html). The full documentation is available inline, using ``` opam --help opam --help ``` This document is intended as a quicker overview, use the above to dig into the details. ## Basics ``` # ** Get started ** opam init # Initialize ~/.opam # ** Lookup ** opam list -a # List all available packages opam search QUERY # List packages with QUERY in their name or description opam show PACKAGE # Display information about PACKAGE # ** Install ** opam install PACKAGE # Download, build and install the latest version of PACKAGE # and all its dependencies opam remove PACKAGE # Uninstall the given package # ** Upgrade ** opam update # Update the packages database opam upgrade # Bring everything to the latest version possible # ** More ** opam CMD --help # Command-specific manpage ``` You may prefer to [browse packages online](https://opam.ocaml.org/packages). If you find a package there but not on your computer, either it has been recently added and you should simply run `opam update`, or it's not available on your system or OCaml version — `opam install PACKAGE` will give you the reason. ## Details on commands ### opam init opam needs to initialize its internal state in a `~/.opam` directory to work. This command will also automatically pick a compiler to install, unless `--bare` has been specified. To make your shell aware of what has been installed in opam, some variables need to be set in your environment. You will be prompted to update your configuration, and given instructions on how to proceed manually if you decline. ### opam update This command synchronizes opam's database with the package repositories. The lists of available packages and their details are stored into `~/.opam/repo/`. Remember to run this regularly if you want to keep up-to-date, or if you are having trouble with a package. It will also update any packages that are bound to version-controlled sources. ### Looking up packages There are three commands for that: * `opam list` List installed packages, or packages matching various selection criteria. * `opam search` Search in package descriptions. * `opam show` Print details on a given package. ### opam install This command downloads, builds and installs packages along with all their dependencies. You can specify one or several packages, along with version constraints. E.g: ``` opam install lwt opam install ocp-indent ocp-index.1.0.2 opam install "ocamlfind>=1.4.0" ``` ### opam upgrade Will attempt to upgrade the installed packages to their newest versions. You should run it after `opam update`, and may use `opam pin` to prevent specific packages from being upgraded. ### opam switch This command enables the user to have several installations on disk, each with their own prefix, set of installed packages, compiler version, etc. Use cases include having to work or test with different OCaml versions, keeping separate development environments for specific projects, etc. Use `opam switch create [name] ` to _switch_ to a different compiler. Don't forget to run the advertised `eval $(opam env)` to update your PATH accordingly. Replace `[name]` with a directory name to have the switch created in that directory, and automatically selected when opam is run from there: this is typically done within projects that require a specific compiler or set of opam packages. Creating a new switch requires re-compiling OCaml, unless you use the `ocaml-system` package, that relies on the global OCaml installation. ### opam pin This command allows one to pin a package to a specific version, but has been extended to allow much more than that. The syntax is ``` opam pin add ``` Where `` may be a version, but also a local path, the URL of an archive, or even a git, mercurial or darcs URL. The package will be kept up-to-date with its origin on `opam update` and when explicitly mentioned in a command, so that you can simply run `opam upgrade ` to re-compile it from its upstream. If the upstream includes opam metadata, that will be used as well. ``` opam pin add camlpdf 1.7 # version pin opam pin add camlpdf ~/src/camlpdf # path opam pin add opam-lib https://github.com/ocaml/opam.git#1.2 # specific branch or commit opam pin add opam-lib --dev-repo # upstream repository ``` This actually a powerful mechanism to divert any package definition, and can even be used to locally create packages that don't have entries in the repositories. This can be used in conjunction with `opam source` to patch an existing package in a breeze: ``` opam source --dev-repo --pin cd ; hack hack hack; opam upgrade . ``` ### opam repo opam is configured by default to use the community's software repository at [opam.ocaml.org](https://opam.ocaml.org), but third-party repositories can easily be used in addition, or in replacement. ``` opam repo add
``` defines the alias `` to refer to the package repository found at `
`. Without further options, that repository will be set to lookup for package definitions over what was already defined **in the current switch only**. See options `--all` and `--set-default` to affect other and newly created switches, respectively. The `
` may point to an HTTP, local or version-controlled repository. To create a new switch bound to specific repositories, it's easier to use instead: ``` opam switch create --repos =
,default ``` Defining your own repository, either locally or online, is quite easy: you can start off by cloning [the official repository](https://github.com/ocaml/opam-repository) if you intend it as a replacement, or just create a new directory with a `packages` sub-directory, and a [`repo` file](Manual.html#repo) containing at least an `opam-version` field. See the [packaging guide](Packaging.html) if you need help on the package format. If your repository is going to be served over HTTP, you should generate an index using the `opam admin index` command. opam-2.0.5/doc/pages/Packaging.md0000644000175000017500000002075313511367404015537 0ustar nicoonicoo# Creating and publishing opam packages An opam package is defined by a `.opam`, or simply `opam` file, containing its metadata. This short guide will get you through writing this definition, testing it, and publishing to the [opam-repository](https://github.com/ocaml/opam-repository). ## Creating a package definition file For complete documentation of the format, see [the manual](Manual.html#Packagedefinitions). If your project does not yet have a package definition, get to the root of its source, and then either - run `opam pin .` to create and edit a template, and test your definition right away, - or create a `.opam` file and edit it by hand. The file follows a simple `field: ` format: ``` opam-version: "2.0" name: "project" version: "0.1" synopsis: "One-line description" description: """ Longer description """ maintainer: "Name " authors: "Name " license: "" homepage: "" bug-reports: "" dev-repo: "" depends: [ "ocaml" "ocamlfind" ] build: [ ["./configure" "--prefix=%{prefix}%"] [make] ] install: [make "install"] ``` The `depends:`, `build:` and `install:` are the most important fields here. If your project uses [`dune`](https://github.com/ocaml/dune), skip `install:` and use: ``` build: ["dune" "build" "-p" name] ``` See [below](#The-file-format-in-more-detail) for more on the format. ## Testing Make sure you have committed everything if using a version-control system (_e.g._ `git add *.opam && git commit`), and just run ``` opam install . ``` from the root of your project. This will attempt to install the newly-defined package so you can check it goes as expected. ## Publishing Publishing is done using Github's pull-request mechanism, which allows automated checks to be run, and discussion to happen with the maintainers before your contribution is merged. You will need a [Github](https://github.com/) account. Submitting is most easily done using the `opam-publish` plugin. Run `opam publish --help` for more options. ### If the project is hosted on Github First tag the project. Assuming this is version 0.1: ``` git tag -a 0.1 git push 0.1 ``` Alternatively, you can create a release using the web UI (https://github.com/USER/REPO/releases/new). Then just run `opam publish` from your source directory and follow the steps. ### If not Assuming your release is available as an archive at `https://foo.bar/project-0.1.tar.gz`, run: ``` opam publish https://foo.bar/project-0.1.tar.gz . ``` from your source directory. The final `.` argument indicates to search for package definitions in the current directory rather than in the archive. > `opam publish` can be re-run any number of times to update an existing > submission, or propose changes to an already released package. ### Without opam-publish First, you will need to add a section in the following format to the package definition, to specify where to retrieve the source of the package: ``` url { src: "https://address/of/project.1.0.tar.gz" checksum: "md5=3ffed1987a040024076c08f4a7af9b21" } ``` Then get to https://github.com/ocaml/opam-repository and select `Fork` on the top-right. Clone the resulting repository, add your package definition, and push back, as such: ``` git clone git@github.com:USER/opam-repository --branch 2.0.0 cd opam-repository cp OPAM_FILE packages/NAME/NAME.VERSION/opam git add packages git commit git push origin HEAD:add-pkg-NAME ``` Then, back to the web UI, Github should propose to file a pull-request for your newly pushed branch. If not, select the `new pull request` button on the left. Make sure to file your pull-request against the `2.0.0` base branch, since package definitions in 1.2 format are not yet accepted on `master`. ## The file format in more detail ### The basics The `opam-version` and `maintainer` fields are mandatory; you should remove the others rather than leave them empty. * `synopsis` should be a one-line description of what your package does, used in listings. It is recommended to also add a `description` field for a longer explanation (hint: you may delimit long strings with triple-quotation mark delimiters `"""` to avoid escaping issues). * You'll probably be the `maintainer` for now, so give a way to contact you in case your package needs maintenance. * Most interesting is the `build` field, that tells opam how to compile the project. Each element of the list is a single command in square brackets, containing arguments either as a string (`"./configure"`) or a variable name (`make`, defined by default to point at the chosen "make" command -- think `$(MAKE)` in Makefiles). `%{prefix}%` is another syntax to replace variables within strings. `opam config list` will give you a list of available variables. `build` instructions shouldn't need to write outside of the package's source directory. * `install` is similar to `build`, but tells opam how to install. The example above should indeed be `install: [ [make "install"] ]`, but the extra square brackets are optional when there is a single element. This field can be skipped if your package generates a [`.install`](Manual.html#lt-pkgname-gt-install) file, like is the case when using `dune`. * `depends` should be a list of existing opam package names that your package relies on to build and run. You'll be guaranteed those are there when you execute the `build` instructions, and won't be changed or removed while your package is installed. If contributing to the default repository at https://opam.ocaml.org, it is quite unlikely that you don't need at least `"ocaml"` there. > Note: when running local shell scripts during _e.g._ `build:`, it is > preferable to use `build: ["sh" "-exc" "./SCRIPT"]` than call the script > directly. A few other fields are available, but that should be enough to get started. Like `install`, most fields may contain lists in square brackets rather than a single element: `maintainer`, `author`, `homepage`, `bug-reports`, `license` and `depends`. You may add a `remove` field, but since opam 2.0, removal of installed files is done automatically, so that should only be needed if your `install` modified existing files. ### Advanced usage This is just a very short introduction, don't be afraid to consult [the reference](Manual.html#opam) for details and more: * [**Version constraints**](Manual.html#PackageFormulas): an optional version constraint can be added after any package name in `depends`: simply write `"package" {>= "3.2"}`. Warning, versions are strings too, don't forget the quotes. * [**Formulas**](Manual.html#PackageFormulas): depends are by default a conjunction (all of them are required), but you can use the logical "and" `&` and "or" `|` operators, and even group with parentheses. The same is true for version constraints: `("pkg1" & "pkg2") | "pkg3" {>= "3.2" & != "3.7"}`. * [**Build depends**](Manual.html#Filteredpackageformulas): you may add, among others, the key `build` in the version constraints, _e.g._ `"package" {build & >= "3.2"}`, to indicate that there is no run-time dependency to this package: it is required but won't trigger rebuilds of your package when changed. * [**OS constraints**](Manual.html#opamfield-available): The `available` field is a formula that determines your package's availability based on the operating system or other [global opam variables](Manual.html#Global-variables). For example: ``` available: [ os != "macos" ] ``` * [**Conflicts**](Manual.html#opamfield-conflicts): some packages just can't coexist. The `conflicts` field is a list of packages, with optional version constraints. See also [`conflict-class`](Manual.html#opamfield-conflict-class) for _families_ of incompatible packages. * [**Optional dependencies**](Manual.html#opamfield-depopts): they change the way your package builds, but are not mandatory. The `depopts` field is a package formula like `depends`. simple list of package names. If you require specific versions, add a `conflicts` field with the ones that won't work. * [**Variables**](Manual.html#Variables): you can get a list of predefined variables that you can use in your opam rules with `opam config list`. * [**Filters**](Manual.html#Filters): dependencies, commands and single command arguments may need to be omitted depending on the environment. This uses the same optional argument syntax as above, postfix curly braces, with boolean conditions: ``` ["./configure" "--with-foo" {ocaml-version > "3.12"} "--prefix=%{prefix}%"] [make "byte"] { !ocaml-native } [make "native"] { ocaml-native } ``` opam-2.0.5/doc/pages/Install.md0000644000175000017500000001307713511367404015262 0ustar nicoonicoo# How to install opam This page describes how to install and configure opam. For further help on how to use opam, either read [`opam --help`](man/opam.html) or move on to the [Usage](Usage.html) guide. ## Upgrading from a previous version Generally, you should just reproduce the same installation steps as for the original installation: upgrade from your system's package manager, or re-run the binary installer. Opam will automatically update its internal repository at `~/.opam` on first run if needed (if using our installer script, a backup can be made automatically). Then see the [Upgrade guide](Upgrade_guide.html) to check the changes. ## Binary distribution The quickest way to get the latest opam up and working is to run [this script](https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh): ``` sh <(curl -sL https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh) ``` This will simply check your architecture, download and install the proper pre-compiled binary, backup your opam data if from an older version, and run `opam init`. (If you have troule with `curl`, just [download the script](https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh) and run `sh install.sh`) We provide pre-compiled binaries for: - Linux i686, amd64, arm7, arm64 - OSX (intel 64 bits) (other platforms are available using the other methods below) If you don't like scripts, you can just pick your download [here](https://github.com/ocaml/opam/releases), put it in your PATH as `opam`, and set it as executable, e.g. ``` sudo cp /usr/local/bin/opam sudo chmod a+x /usr/local/bin/opam ``` ## Using your distribution's package system This is generally the recommended way, when available and up-to-date. Here is a list of supported distributions: #### Archlinux The [opam](https://www.archlinux.org/packages/community/x86_64/opam/) package is available in the official distribution. To install it simply run: ``` pacman -S opam ``` If you'd like to use the development version there is an [opam-git](https://aur.archlinux.org/packages/opam-git/) package available in the [AUR](https://wiki.archlinux.org/index.php/AUR). Assuming you have [yaourt](https://aur.archlinux.org/packages/yaourt) installed just run the following command: ``` yaourt -S opam-git ``` #### Debian Binary packages of opam are available for the [stable](http://packages.debian.org/jessie/opam), [testing](http://packages.debian.org/stretch/opam) and [unstable](http://packages.debian.org/sid/opam) distributions, from the official repositories. You should be set with: ``` apt-get install opam ``` #### [Exherbo](http://exherbo.org) The [`dev-ocaml/opam`](http://git.exherbo.org/summer/packages/dev-ocaml/opam/index.html) package can be installed with the command: ``` cave resolve -x dev-ocaml/opam ``` You might need to add the `::ocaml-unofficial` repository first: ``` cave resolve -x repository/ocaml-unofficial ``` #### [Fedora](http://fedoraproject.org), [CentOS](http://centos.org) and RHEL No native packages at the moment, you will need to use our pre-built binaries, or build from sources. #### Mageia The opam package for Mageia can be installed with the command: ``` urpmi opam ``` #### OpenBSD Opam builds via sources fine on OpenBSD 5.6 or earlier, and is available in the ports and packages tree on OpenBSD 5.7 or higher. ``` cd /usr/ports/sysutils/opam make install ``` #### FreeBSD Opam is available in the ports and packages tree on FreeBSD 11 or higher. ``` cd /usr/ports/devel/ocaml-opam make install ``` #### OSX Opam packages for [homebrew](http://mxcl.github.com/homebrew/) and [MacPorts](http://www.macports.org/) are available: ``` brew install opam # Homebrew port install opam # MacPort ``` See also [howto setup Emacs.app](https://github.com/ocaml/opam/wiki/Setup-Emacs.app-on-macosx-for-opam-usage) for Opam usage. #### Ubuntu Ubuntu has native packages for opam: ``` apt install opam ``` ## From Sources #### Getting the Sources Sources of the latest stable version of opam are available on Github: * [Opam releases on Github](https://github.com/ocaml/opam/releases) You can also download the full archives, including opam dependencies (these don't require any extra downloads, just the OCaml compiler -- 4.02.3 or later for the latest version): * [2.0.0~rc](https://github.com/ocaml/opam/releases/download/2.0.0-rc/opam-full-2.0.0-rc.tar.gz) MD5: 6e89905dbe9203dee3e883b70e210285 SHA384: 8a9ee03cdcd78a7d44e92c9b1c6e841605a49ecff4ebd977a632708ef6250f9f3ec488ecd1852f76d1b6cfc2d8ad9117 * [1.2.2](https://github.com/ocaml/opam/releases/download/1.2.2/opam-full-1.2.2.tar.gz) MD5: 7d348c2898795e9f325fb80eaaf5eae8 SHA384: 3a0a7868b5f510c1248959ed350eecacfe1abd886e373fd31066ce10871354010ef057934df026e5fad389ead6c2857d Follow the instructions in the included [`README.md`](https://github.com/ocaml/opam#readme) to get opam built and installed from there. > Note that opam1.2.2 doesn't build from source with OCaml 4.06.0. Use this command to compile `lib_ext` > ``` > OCAMLPARAM="safe-string=0,_" make lib-ext > ``` #### Using ocamlbrew [ocamlbrew](https://github.com/hcarty/ocamlbrew) is a script that can bootstrap an OCaml environment including opam, from source. This option does not require an existing OCaml installation, or a pre-compiled opam binary for your platform. To bootstrap a new OCaml environment including opam, make sure that you have the necessary pre-requisites installed to run ocamlbrew, and then run: ``` curl -kL https://raw.github.com/hcarty/ocamlbrew/master/ocamlbrew-install | env OCAMLBREW_FLAGS="-r" bash ``` opam-2.0.5/doc/pages/Manual.md0000644000175000017500000023056613511367404015075 0ustar nicoonicoo # The opam manual This manual gathers reference information on opam and its file formats. It is primarily of use for packagers, package maintainers and repository maintainers. * For simple usage of opam, see the [Usage](Usage.html) page, and the comprehensive built-in documentation [`opam [command] --help`](man/index.html). * For a gentler introduction to packaging, see the [Packaging guide](Packaging.html) * If you want to hack on opam or build related tools, the API documentation can be browsed [here](api/index.html) ## File hierarchies ### opam root opam holds its configuration, metadata, logs, temporary directories and caches within a directory that we will call _opam root_. By default, this is `~/.opam`, and we may refer to it by this name in this manual for the sake of simplicity, but this can be changed using the `OPAMROOT` environment variable or the `--root` command-line argument. An existing opam root is required for opam to operate normally, and one is created upon running `opam init`. The initial configuration can be defined through a configuration file at `~/.opamrc`, `/etc/opamrc` or at a location specified through the `--config` command-line option. If none is present, opam defaults to its built-in configuration that binds to the OCaml repository at `https://opam.ocaml.org`. Except in explicit cases, opam only alters files within its opam root. It is organised as follows: - [`~/.opam/config`](#config): the global opam configuration file - `~/.opam/repo/`: contains the mirrors of the configured package repositories - [`~/.opam/repo/repos-config`](#repos-config): lists the configured package repositories and their URLs - `~/.opam/repo/`: mirror of the given repository - `~/.opam/opam-init/`: contains opam configuration scripts for the outside world, e.g. shell environment initialisation - `~/.opam/download-cache/`: caches of downloaded files - `~/.opam/plugins/`: reserved for plugins - `~/.opam/`: prefixes of named [switches](#Switches) ### Repositories Repositories are collection of opam package definitions. They respect the following hierarchy: - [`/repo`](#repo): repository configuration file - [`/packages//./opam`](#opam): holds the metadata for the given package. `url` and `descr` may also be present, in which case they override what may already be present in the `opam` file - [`/packages//./files/`](#files): contains files that are copied over the root of the source tree of the given package before it gets used. - `/cache/`: cached package files, by checksum. Note that the cache location is configured in the [repo](#repofield-archive-mirrors) file, this name is only where `opam admin cache` puts it by default. - `/archives/`: this is no longer used by opam automatically, but is the canonical place where you should place your package archives if you want to serve them from the repository server directly. The URLs of the packages will have to be set accordingly. - `/index.tar.gz`: archive containing the whole repository contents (except the cache), needed when serving over HTTP. It can be generated using `opam admin index`. opam repositories can be accessed using local or remote (ssh) paths, HTTP URLs, or one of the supported version control systems (git, Mercurial, Darcs). A repository is set up using ``` opam repository add ``` and can subsequently be then selected for use in specific switches using `opam repository select `. Use `opam repository list --all` for an overview of configured repositories. Repository selection is always ordered, with the definition of a given version of a package being taken from the repository with the lowest index where it is found. Data from the configured repositories is updated from the upstreams manually using the `opam update` command. This only updates repositories in use by the currently selected switches, unless `--all` is specified. ### Switches opam is designed to hold any number of concurrent installation prefixes, called _switches_. Switches are isolated from each other and have their own set of installed packages, selection of repositories, and configuration options. All package-related commands operate on a single switch, and require one to be selected. The current switch can be selected in the following ways: - globally, using `opam switch `. opam will use that switch for all further commands, except when overridden in one of the following ways. - for local switches, which are external to the opam root, when in the directory where the switch resides or a descendant. - by setting the `OPAMSWITCH=` environment variable, to set it within a single shell session. This can be done by running `eval $(opam env --switch )` to set the shell environment at once, see below. - through the `--switch ` command-line flag, for a single command. Switches have their own prefix, normally `~/.opam/`, where packages get intalled ; to use what is installed in a switch, some environment variables need to be set, _e.g._ to make executables installed into `~/.opam//bin` visible, that directory needs to be added to `PATH`, but individual packages can define their own settings as well. Command `opam env` returns the environment updates corresponding to the current switch, in a format readable by your shell, and when needed opam will prompt you to run: ``` eval $(opam env) ``` A switch is created using `opam switch create (|--empty)`. - `` can be either a plain name, or a directory name (if containing `/` or starting with `.`). In the latter case the switch is _local_ and instead of being held at `~/.opam/`, it will be created in the given directory, as a `_opam` subdirectory. Local switches are automatically selected depending on the current directory, see above. - If a `` is selected, opam will install the corresponding packages and their dependencies in the new switch. These packages will be marked as _base_, protected against removal and unaffected by upgrade commands. `` can be selected among packages which have the `compiler` flag set, or their versions. Use `opam switch list-available` to list them. #### Structure If we define `` as: - `~/.opam/` for plain switches - `/_opam` for local switches, when `` is a path Switches are laid out thusly: - `/`: prefix of the switch, holding the installation hierarchy in the UNIX `/usr` standard (with subdirectories `bin`, `lib`, `share`, `man`, `doc`, `etc`...) - `/.opam-switch/`: holds all opam data regarding this switch - [`/.opam-switch/switch-config`: switch-specific configuration](#switch-config) - [`/.opam-switch/switch-state`: stores the sets of installed, base, pinned packages](#switch-state) - `/.opam-switch/environment`: contains the environment variable settings for this switch - `/.opam-switch/reinstall`: list of packages marked for reinstallation (development packages where changes have been detected) - [`/.opam-switch/config/.config`](#lt-pkgname-gt-config): installed package's, opam specific configuration - [`/.opam-switch/install/.install`](#lt-pkgname-gt-install): `.install` files used to install the given package - `/.opam-switch/install/.changes`: file system changes done by the installation of the given package, as tracked by opam - `/.opam-switch/packages/./`: metadata of the given package as it has been used for its installation - `/.opam-switch/sources/./` or `/`: unpacked sources of packages. The version is omitted from the directory name for pinned packages, which are typically synchronised to a version-control system rather than unpacked from an archive. - `/.opam-switch/overlay//`: custom definition for the given pinned packages - `/.opam-switch/build/./`: temporary directories where the packages are compiled - `/.opam-switch/remove/./`: temporary directories used for calling the packages' `remove` commands, when those need the source. - `/.opam-switch/backup`: snapshots of previous states of the switch, and other backup files. #### Pinning Pinning is an operation by which a package definition can be created or altered locally in a switch. In its most simple form, `opam pin `, `` is bound to the specified version and won't be changed on `opam upgrade` (assuming it is an existing package). `opam pin edit ` provides a way to directly pin and edit the metadata of the given package, locally to the current switch, for example to tweak a dependency. `opam pin [package] ` can further be used to divert the source of a package, or even create a new package ; this is very useful to point to a local path containing a development or patched version of the package source. When pinning a package, the source is searched for metadata in an `opam` or `.opam` file, either at the root of the source tree or in an `opam` directory. You can also replace that file by a directory containing an `opam` file and optionally other metadata, like a `files/` subdirectory. As the `package` argument is optional, `opam` guesses package name from the `` or the `opam` file found. Note that for local VCS pinning, when given without package name, `opam` retrieves the locally found `opam` file, even if not versioned. If this file is versioned, `opam` relies on the versioned version. Whenever an install, reinstall or upgrade command-line refers to a pinned package, opam first fetches its latest source. `opam update [--development]` is otherwise the standard way to update the sources of all the packages pinned in the current switch. `opam install ` is an automatic way to handle pinning packages whose definitions are found in ``, synchronise and install them. The `upgrade`, `reinstall` and `remove` commands can likewise be used with a directory argument to refer to pinned packages. ## Common file format ### Conventions Syntax is given in a BNF-like notation. Non-terminals are written ``, terminals are either plain text or written in double-quotes (`"terminal"`), curly brackets denote zero or more repetitions when suffixed with `*`, or one or more when suffixed with `+`, and square brackets denote zero or one occurence. Parentheses are for grouping. `(")` and `(""")` respectively mean one and three quotation mark characters. As a special case, and for readability, we add simplified notations for _lists_ and _options_: - `[ ... ]` means `"[" { }* "]" | `. It corresponds to a case of the `` non-terminal and is a list of `` repeated any number of times. The square brackets can be omitted when `` occurs just once. - ` { ... }` means ` "{" { }* "}"`, and is a shortcut for the `