diff --git a/Makefile b/Makefile index 96278927..ef396a40 100644 --- a/Makefile +++ b/Makefile @@ -18,7 +18,7 @@ GENSTATIC ?= ./tools/chibi-genstatic CHIBI ?= LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" DYLD_LIBRARY_PATH=".:$(DYLD_LIBRARY_PATH)" CHIBI_MODULE_PATH=lib ./chibi-scheme$(EXE) CHIBI_DEPENDENCIES = ./chibi-scheme$(EXE) -SNOW_CHIBI ?= $(CHIBI) tools/snow-chibi +SNOW_CHIBI ?= tools/snow-chibi ######################################################################## @@ -46,7 +46,7 @@ MODULE_DOCS := app ast config disasm equiv filesystem generic heap-stats io \ system test time trace type-inference uri weak monad/environment \ show show/base crypto/sha2 -IMAGE_FILES = chibi.img snow.img +IMAGE_FILES = lib/chibi.img lib/snow.img HTML_LIBS = $(MODULE_DOCS:%=doc/lib/chibi/%.html) @@ -163,10 +163,10 @@ chibi-scheme.pc: chibi-scheme.pc.in lib/chibi/ast$(SO): lib/chibi/ast.c $(INCLUDES) libchibi-scheme$(SO) -$(CC) $(CLIBFLAGS) $(CLINKFLAGS) $(XCPPFLAGS) $(XCFLAGS) $(LDFLAGS) -o $@ $< $(GCLDFLAGS) -L. -lchibi-scheme -chibi.img: $(CHIBI_DEPENDENCIES) all-libs +lib/chibi.img: $(CHIBI_DEPENDENCIES) all-libs $(CHIBI) -d $@ -snow.img: $(CHIBI_DEPENDENCIES) all-libs +lib/snow.img: $(CHIBI_DEPENDENCIES) all-libs $(CHIBI) -mchibi.snow.commands -mchibi.snow.interface -mchibi.snow.package -mchibi.snow.utils -d $@ doc: doc/chibi.html doc-libs @@ -277,6 +277,7 @@ install: all $(INSTALL) -m0755 tools/chibi-ffi $(DESTDIR)$(BINDIR)/ $(INSTALL) -m0755 tools/chibi-doc $(DESTDIR)$(BINDIR)/ $(INSTALL) -m0755 tools/snow-chibi $(DESTDIR)$(BINDIR)/ + $(INSTALL) -m0755 tools/snow-chibi.scm $(DESTDIR)$(BINDIR)/ $(MKDIR) $(DESTDIR)$(MODDIR)/chibi/char-set $(DESTDIR)$(MODDIR)/chibi/crypto $(DESTDIR)$(MODDIR)/chibi/io $(DESTDIR)$(MODDIR)/chibi/iset $(DESTDIR)$(MODDIR)/chibi/loop $(DESTDIR)$(MODDIR)/chibi/match $(DESTDIR)$(MODDIR)/chibi/math $(DESTDIR)$(MODDIR)/chibi/monad $(DESTDIR)$(MODDIR)/chibi/net $(DESTDIR)$(MODDIR)/chibi/optimize $(DESTDIR)$(MODDIR)/chibi/parse $(DESTDIR)$(MODDIR)/chibi/regexp $(DESTDIR)$(MODDIR)/chibi/show $(DESTDIR)$(MODDIR)/chibi/snow $(DESTDIR)$(MODDIR)/chibi/term $(MKDIR) $(DESTDIR)$(MODDIR)/scheme/char $(MKDIR) $(DESTDIR)$(MODDIR)/scheme/time @@ -352,6 +353,7 @@ uninstall: -$(RM) $(DESTDIR)$(BINDIR)/chibi-ffi -$(RM) $(DESTDIR)$(BINDIR)/chibi-doc -$(RM) $(DESTDIR)$(BINDIR)/snow-chibi + -$(RM) $(DESTDIR)$(BINDIR)/snow-chibi.scm -$(RM) $(DESTDIR)$(SOLIBDIR)/libchibi-scheme$(SO) -$(RM) $(DESTDIR)$(SOLIBDIR)/libchibi-scheme$(SO_VERSIONED_SUFFIX) -$(RM) $(DESTDIR)$(SOLIBDIR)/libchibi-scheme$(SO_MAJOR_VERSIONED_SUFFIX) diff --git a/tests/snow/snow-tests.scm b/tests/snow/snow-tests.scm index 8989355d..1d4d463b 100644 --- a/tests/snow/snow-tests.scm +++ b/tests/snow/snow-tests.scm @@ -40,13 +40,13 @@ ;; run snow-chibi command as a separate process with test defaults (define chibi-path "./chibi-scheme") (define (snow-command . args) - `(,chibi-path -A ,install-libdir "tools/snow-chibi" - --always-no - --implementations "chibi" - --chibi-path ,(string-append chibi-path " -A" install-libdir) - --install-prefix ,install-prefix - --local-user-repository "tests/snow/repo-cache" - ,@args)) + `("./tools/snow-chibi" + --always-no + --implementations "chibi" + --chibi-path ,(string-append chibi-path " -A" install-libdir) + --install-prefix ,install-prefix + --local-user-repository "tests/snow/repo-cache" + ,@args)) (define-syntax snow (syntax-rules () diff --git a/tools/snow-chibi b/tools/snow-chibi index 373d100d..87eaddf7 100755 --- a/tools/snow-chibi +++ b/tools/snow-chibi @@ -1,220 +1,13 @@ -#!/usr/bin/env chibi-scheme +#!/bin/sh -;; This code was written by Alex Shinn in 2013 and placed in the -;; Public Domain. All warranties are disclaimed. +CHIBI=${CHIBI:-chibi-scheme} +if [ -x ./chibi-scheme ] && ! type $CHIBI 2>/dev/null; then + # convenience for running from dev, notable "make test-snow" + CHIBI="./chibi-scheme" + export LD_LIBRARY_PATH=".:${LD_LIBRARY_PATH}" + export DYLD_LIBRARY_PATH=".:${DYLD_LIBRARY_PATH}" +fi +SCRIPT_DIR=$(dirname $0) +SNOW_SCRIPT=${SNOW_SCRIPT:-$SCRIPT_DIR/snow-chibi.scm} -(import (scheme base) - (scheme process-context) - (chibi snow commands) - (chibi snow interface) - (chibi app) - (chibi config) - (chibi pathname) - (chibi process)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (define repo-spec -;; '((repository -;; (conf -;; (sibling -;; (conf -;; (name string) -;; (url string))) -;; (package -;; (conf -;; (name (list (or symbol integer))) -;; (url string) -;; (size integer) -;; (checksums (alist symbol string)) -;; (signature (alist symbol string)) -;; (library -;; (conf -;; (name (list (or symbol integer))) -;; (path string) -;; (depends -;; (list (list (or symbol integer string -;; (list (member < > <= >=) string))))) -;; (provides (list (list (or symbol string)))) -;; (platforms (list (or symbol (list symbol)))) -;; (features (list symbol)) -;; (authors (list string)) -;; (maintainers (list string)) -;; (description string) -;; (created string) -;; (updated string) -;; (version string) -;; (licenses -;; (list -;; (or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain) -;; (list 'license -;; (conf (name string) -;; (url string) -;; (checksums (alist symbol string))))))))))))))) - -(define conf-spec - ;; name type aliases doc - '((verbose? boolean (#\v "verbose") "print additional informative messages") - (always-yes? boolean (#\y "always-yes") "answer all questions with yes") - (always-no? boolean (#\n "always-no") "answer all questions with no") - (require-signature? boolean ("require-sig" "require-signature") - "require signature on installation") - (ignore-signature? boolean ("ignore-sig" "ignore-signature") - "don't verify package signatures") - (ignore-digest? boolean ("ignore-digest") "don't verify package checksums") - (skip-digest? boolean ("skip-digest") "don't provide digests without rsa") - (skip-version-checks? boolean ("skip-version-checks") - "don't verify implementation versions") - (sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present") - (host string "base uri of snow repository") - (repository-uri (list string) ("repo") "uris or paths of snow repositories") - (local-root-repository dirname "repository cache dir for root") - (local-user-repository dirname "repository cache dir for non-root users") - (update-strategy symbol - "when to refresh repo: always, never, cache or confirm") - (install-prefix string "prefix directory for installation") - (install-source-dir dirname "directory to install library source in") - (install-library-dir dirname "directory to install shared libraries in") - (install-binary-dir dirname "directory to install programs in") - (install-data-dir dirname "directory to install data files in") - (library-extension string "the extension to use for library files") - (library-separator string "the separator to use for library components") - (library-path (list string) "the path to search for local libraries") - (installer symbol "name of installer to use") - (builder symbol "name of builder to use") - (program-builder symbol "name of program builder to use") - (implementations (list symbol) ("impls") "impls to install for, or 'all'") - (program-implementation symbol "impl to install programs for") - (chibi-path filename "path to chibi-scheme executable") - (cc string "path to c compiler") - (cflags string "flags for c compiler") - (use-curl? boolean ("use-curl") "use curl for file uploads") - (sexp? boolean ("sexp") "output information in sexp format") - )) - -(define (conf-default-path name) - (or (get-environment-variable "SNOW_CHIBI_CONFIG") - (make-path (or (get-environment-variable "HOME") ".") - (string-append "." name) - "config.scm"))) - -(define search-spec '()) -(define show-spec '()) -(define install-spec - '((skip-tests? boolean ("skip-tests") "don't run tests even if present") - (show-tests? boolean ("show-tests") "show test output even on success") - (install-tests? boolean ("install-tests") "install test-only libraries") - (auto-upgrade-dependencies? - boolean ("auto-upgrade-dependencies") - "upgrade install dependencies when newer versions are available") - (use-sudo? symbol ("use-sudo") "always, never, or as-needed (default)"))) -(define upgrade-spec - install-spec) -(define remove-spec '()) -(define status-spec '()) -(define gen-key-spec - '((bits integer) - (validity-period string) - (name string) - (library-prefix (list symbol)) - (email string) - (gen-rsa-key? boolean ("gen-rsa-key")) - (gen-key-in-process? boolean ("gen-key-in-process")))) -(define reg-key-spec - '((uri string) - (email string))) -(define sign-spec - '((output filename #\o) - (digest symbol #\d) - (email string))) -(define verify-spec - '()) -(define package-spec - '((name sexp) - (programs (list existing-filename)) - (data-files (list sexp)) - (authors (list string)) - (maintainers (list string)) - (recursive? boolean (#\r "recursive") "...") - (version string) - (version-file existing-filename) - (license symbol) - (doc existing-filename) - (doc-from-scribble boolean) - (description string) - (test existing-filename) - (test-library sexp) - (sig-file existing-filename) - (output filename) - (output-dir dirname) - )) -(define upload-spec - `((uri string) - ,@package-spec)) -(define index-spec - '()) -(define update-spec - '()) -(define implementations-spec - '()) - -(define app-spec - `(snow - "Snow package management" - (@ ,conf-spec) - (begin: ,(lambda (cfg) (restore-history cfg))) - (end: ,(lambda (cfg) (save-history cfg))) - (or - (search - "search for packages" - (@ ,search-spec) (,command/search terms ...)) - (show - "show package descriptions" - (@ ,show-spec) (,command/show names ...)) - (install - "install packages" - (@ ,install-spec) (,command/install names ...)) - (upgrade - "upgrade installed packages" - (@ ,upgrade-spec) (,command/upgrade names ...)) - (remove - "remove packages" - (@ ,remove-spec) (,command/remove names ...)) - (status - "print package status" - (@ ,status-spec) (,command/status names ...)) - (package - "create a package" - (@ ,package-spec) (,command/package files ...)) - (gen-key - "create an RSA key pair" - (@ ,gen-key-spec) (,command/gen-key)) - (reg-key - "register an RSA key pair" - (@ ,reg-key-spec) (,command/reg-key)) - (sign - "sign a package" - (@ ,sign-spec) (,command/sign file)) - (verify - "verify a signature" - (@ ,verify-spec) (,command/verify file)) - (upload - "upload a package to a remote repository" - (@ ,upload-spec) (,command/upload files ...)) - (index - "add a package to a local repository file" - (@ ,index-spec) (,command/index files ...)) - (update - "force an update of available package status" - (@ ,update-spec) (,command/update)) - (implementations - "print currently available scheme implementations" - (@ ,implementations-spec) (,command/implementations)) - (help - "print help" - (,app-help-command args ...)) - ))) - -(run-application app-spec - (command-line) - (conf-load (conf-default-path "snow"))) +exec "${CHIBI}" -isnow.img "${SNOW_SCRIPT}" "$@" diff --git a/tools/snow-chibi.scm b/tools/snow-chibi.scm new file mode 100755 index 00000000..373d100d --- /dev/null +++ b/tools/snow-chibi.scm @@ -0,0 +1,220 @@ +#!/usr/bin/env chibi-scheme + +;; This code was written by Alex Shinn in 2013 and placed in the +;; Public Domain. All warranties are disclaimed. + +(import (scheme base) + (scheme process-context) + (chibi snow commands) + (chibi snow interface) + (chibi app) + (chibi config) + (chibi pathname) + (chibi process)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (define repo-spec +;; '((repository +;; (conf +;; (sibling +;; (conf +;; (name string) +;; (url string))) +;; (package +;; (conf +;; (name (list (or symbol integer))) +;; (url string) +;; (size integer) +;; (checksums (alist symbol string)) +;; (signature (alist symbol string)) +;; (library +;; (conf +;; (name (list (or symbol integer))) +;; (path string) +;; (depends +;; (list (list (or symbol integer string +;; (list (member < > <= >=) string))))) +;; (provides (list (list (or symbol string)))) +;; (platforms (list (or symbol (list symbol)))) +;; (features (list symbol)) +;; (authors (list string)) +;; (maintainers (list string)) +;; (description string) +;; (created string) +;; (updated string) +;; (version string) +;; (licenses +;; (list +;; (or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain) +;; (list 'license +;; (conf (name string) +;; (url string) +;; (checksums (alist symbol string))))))))))))))) + +(define conf-spec + ;; name type aliases doc + '((verbose? boolean (#\v "verbose") "print additional informative messages") + (always-yes? boolean (#\y "always-yes") "answer all questions with yes") + (always-no? boolean (#\n "always-no") "answer all questions with no") + (require-signature? boolean ("require-sig" "require-signature") + "require signature on installation") + (ignore-signature? boolean ("ignore-sig" "ignore-signature") + "don't verify package signatures") + (ignore-digest? boolean ("ignore-digest") "don't verify package checksums") + (skip-digest? boolean ("skip-digest") "don't provide digests without rsa") + (skip-version-checks? boolean ("skip-version-checks") + "don't verify implementation versions") + (sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present") + (host string "base uri of snow repository") + (repository-uri (list string) ("repo") "uris or paths of snow repositories") + (local-root-repository dirname "repository cache dir for root") + (local-user-repository dirname "repository cache dir for non-root users") + (update-strategy symbol + "when to refresh repo: always, never, cache or confirm") + (install-prefix string "prefix directory for installation") + (install-source-dir dirname "directory to install library source in") + (install-library-dir dirname "directory to install shared libraries in") + (install-binary-dir dirname "directory to install programs in") + (install-data-dir dirname "directory to install data files in") + (library-extension string "the extension to use for library files") + (library-separator string "the separator to use for library components") + (library-path (list string) "the path to search for local libraries") + (installer symbol "name of installer to use") + (builder symbol "name of builder to use") + (program-builder symbol "name of program builder to use") + (implementations (list symbol) ("impls") "impls to install for, or 'all'") + (program-implementation symbol "impl to install programs for") + (chibi-path filename "path to chibi-scheme executable") + (cc string "path to c compiler") + (cflags string "flags for c compiler") + (use-curl? boolean ("use-curl") "use curl for file uploads") + (sexp? boolean ("sexp") "output information in sexp format") + )) + +(define (conf-default-path name) + (or (get-environment-variable "SNOW_CHIBI_CONFIG") + (make-path (or (get-environment-variable "HOME") ".") + (string-append "." name) + "config.scm"))) + +(define search-spec '()) +(define show-spec '()) +(define install-spec + '((skip-tests? boolean ("skip-tests") "don't run tests even if present") + (show-tests? boolean ("show-tests") "show test output even on success") + (install-tests? boolean ("install-tests") "install test-only libraries") + (auto-upgrade-dependencies? + boolean ("auto-upgrade-dependencies") + "upgrade install dependencies when newer versions are available") + (use-sudo? symbol ("use-sudo") "always, never, or as-needed (default)"))) +(define upgrade-spec + install-spec) +(define remove-spec '()) +(define status-spec '()) +(define gen-key-spec + '((bits integer) + (validity-period string) + (name string) + (library-prefix (list symbol)) + (email string) + (gen-rsa-key? boolean ("gen-rsa-key")) + (gen-key-in-process? boolean ("gen-key-in-process")))) +(define reg-key-spec + '((uri string) + (email string))) +(define sign-spec + '((output filename #\o) + (digest symbol #\d) + (email string))) +(define verify-spec + '()) +(define package-spec + '((name sexp) + (programs (list existing-filename)) + (data-files (list sexp)) + (authors (list string)) + (maintainers (list string)) + (recursive? boolean (#\r "recursive") "...") + (version string) + (version-file existing-filename) + (license symbol) + (doc existing-filename) + (doc-from-scribble boolean) + (description string) + (test existing-filename) + (test-library sexp) + (sig-file existing-filename) + (output filename) + (output-dir dirname) + )) +(define upload-spec + `((uri string) + ,@package-spec)) +(define index-spec + '()) +(define update-spec + '()) +(define implementations-spec + '()) + +(define app-spec + `(snow + "Snow package management" + (@ ,conf-spec) + (begin: ,(lambda (cfg) (restore-history cfg))) + (end: ,(lambda (cfg) (save-history cfg))) + (or + (search + "search for packages" + (@ ,search-spec) (,command/search terms ...)) + (show + "show package descriptions" + (@ ,show-spec) (,command/show names ...)) + (install + "install packages" + (@ ,install-spec) (,command/install names ...)) + (upgrade + "upgrade installed packages" + (@ ,upgrade-spec) (,command/upgrade names ...)) + (remove + "remove packages" + (@ ,remove-spec) (,command/remove names ...)) + (status + "print package status" + (@ ,status-spec) (,command/status names ...)) + (package + "create a package" + (@ ,package-spec) (,command/package files ...)) + (gen-key + "create an RSA key pair" + (@ ,gen-key-spec) (,command/gen-key)) + (reg-key + "register an RSA key pair" + (@ ,reg-key-spec) (,command/reg-key)) + (sign + "sign a package" + (@ ,sign-spec) (,command/sign file)) + (verify + "verify a signature" + (@ ,verify-spec) (,command/verify file)) + (upload + "upload a package to a remote repository" + (@ ,upload-spec) (,command/upload files ...)) + (index + "add a package to a local repository file" + (@ ,index-spec) (,command/index files ...)) + (update + "force an update of available package status" + (@ ,update-spec) (,command/update)) + (implementations + "print currently available scheme implementations" + (@ ,implementations-spec) (,command/implementations)) + (help + "print help" + (,app-help-command args ...)) + ))) + +(run-application app-spec + (command-line) + (conf-load (conf-default-path "snow")))