diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm
new file mode 100644
index 00000000..3c90d9f6
--- /dev/null
+++ b/lib/chibi/snow/commands.scm
@@ -0,0 +1,1399 @@
+;; commands.scm -- snow commands
+;;
+;; This code was written by Alex Shinn in 2014 and placed in the
+;; Public Domain.  All warranties are disclaimed.
+
+(define (find-in-path file . o)
+  (any (lambda (dir)
+         (let ((path (make-path dir file)))
+           (and (file-exists? path) path)))
+       (if (pair? o)
+           (car o)
+           (string-split (get-environment-variable "PATH") #\:))))
+
+(define (find-sexp-in-path file dirs . o)
+  (let ((pred (if (pair? o) (car o) (lambda (x) #t))))
+    (any (lambda (dir)
+           (let ((path (make-path dir file)))
+             (and (file-exists? path)
+                  (guard (exn (else #f))
+                    (let ((x (call-with-input-file path read)))
+                      (and (pred x) x))))))
+         dirs)))
+
+(define (available-implementations cfg)
+  (define (find prog name) (if (find-in-path prog) (list name) '()))
+  (append (cond-expand
+           (chibi (list 'chibi))
+           (else (find "chibi-scheme" 'chibi)))
+          (find "foment" 'foment)
+          (find "gosh" 'gauche)
+          (find "guile" 'guile)
+          (find "larceny" 'larceny)
+          (find "sagittarius" 'sagittarius)))
+
+(define (conf-selected-implementations cfg)
+  (let ((requested (conf-get-list cfg 'implementations '(chibi)))
+        (available (available-implementations cfg)))
+    (if (memq 'all requested)
+        available
+        (lset-intersection eq? requested available))))
+
+(define (conf-for-implementation cfg impl)
+  (conf-specialize cfg 'implementation impl))
+
+(define (call-with-output-string proc)
+  (let ((out (open-output-string)))
+    (proc out)
+    (get-output-string out)))
+
+(define (write-to-string x)
+  (call-with-output-string (lambda (out) (write x out))))
+
+(define (file->sexp-list file)
+  (call-with-input-file file
+    (lambda (in)
+      (let lp ((res '()))
+        (let ((x (read in)))
+          (if (eof-object? x)
+              (reverse res)
+              (lp (cons x res))))))))
+
+(define (version-split str)
+  (if str
+      (map (lambda (x) (or (string->number x) x))
+        (string-split str #\.))
+      '()))
+
+(define (version-compare a b)
+  (define (less? x y)
+    (cond ((number? x) (if (number? y) (< x y) 1))
+          ((number? y) -1)
+          (else (string<? x y))))
+  (let lp ((as (version-split a))
+           (bs (version-split b)))
+    (cond
+     ((null? as) (if (null? bs) -1 0))
+     ((null? bs) 1)
+     ((less? (car as) (car bs)) -1)
+     ((less? (car bs) (car as)) 1)
+     (else (lp (cdr as) (cdr bs))))))
+
+(define (version>? a b) (> (version-compare a b) 0))
+(define (version>=? a b) (>= (version-compare a b) 0))
+
+;; Hack to evaluate an expression in a separate process with a larger
+;; default heap.  The expression and result must be serializable with
+;; write, and imports should be an argument list for environment.
+;; Currently only used when generating keys and signing.
+(define (fast-eval expr imports . o)
+  (let* ((heap-size (if (pair? o) (car o) 500))
+         (cmd
+          `("chibi-scheme"
+            ,(string-append "-h" (number->string heap-size) "M")
+            ,@(map
+               (lambda (i)
+                 (string-append "-m" (string-join (map write-to-string i) ".")))
+               imports)
+            "-p" ,(write-to-string expr))))
+    (let ((res (process->sexp cmd)))
+      (if (eof-object? res)  ; process error
+          (eval expr (apply environment imports))
+          res))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Package - generate a package from one or more libraries.
+
+(define (tar-file? file)
+  (or (equal? (path-extension file) "tgz")
+      (and (member (path-extension file) '("gz" "bz2"))
+           (equal? (path-extension (path-strip-extension file)) "tar"))))
+
+(define (package-file-meta file)
+  (and
+   (tar-file? file)
+   (let* ((unzipped-file
+           (if (member (path-extension file) '("tgz" "gz"))
+               (gunzip (let* ((in (open-binary-input-file file))
+                              (res (port->bytevector in)))
+                         (close-input-port in)
+                         res))
+               file))
+          (package-file
+           (find
+            (lambda (x)
+              (and (equal? "package.scm" (path-strip-directory x))
+                   (equal? "." (path-directory (path-directory x)))))
+            (tar-files unzipped-file))))
+     (and package-file
+          (guard (exn (else #f))
+            (let* ((str (utf8->string
+                         (tar-extract-file unzipped-file package-file)))
+                   (package (read (open-input-string str))))
+              (and (pair? package)
+                   (eq? 'package (car package))
+                   package)))))))
+
+(define (package-file? file)
+  (and (package-file-meta file) #t))
+
+(define (x->string x)
+  (cond ((string? x) x)
+        ((symbol? x) (symbol->string x))
+        ((number? x) (number->string x))
+        (else (error "not a valid path component" x))))
+
+(define (library-path-base file name)
+  (let lp ((ls (cdr (reverse name))) (dir (path-directory file)))
+    (cond
+     ((null? ls) dir)
+     ((equal? (x->string (car ls)) (path-strip-directory dir))
+      (lp (cdr ls) (path-directory dir)))
+     (else dir))))
+
+(define (path-relative file dir)
+  (let ((file (path-normalize file))
+        (dir (string-trim-right (path-normalize dir) #\/)))
+    (string-trim-left
+     (if (string-prefix? dir file)
+         (substring file (string-length dir))
+         file)
+     #\/)))
+
+;; remove import qualifiers
+(define (import-name import)
+  (cond
+   ((and (pair? import)
+         (memq (car import) '(only except prefix drop-prefix rename))
+         (pair? (cadr import)))
+    (import-name (cadr import)))
+   (else import)))
+
+(define (extract-library cfg file)
+  (let ((lib (read-from-file file)))
+    (match lib
+      (('define-library (name ...)
+         declarations ...)
+       (let* ((dir (library-path-base file name))
+              (lib-file (path-relative file dir))
+              (lib-dir (path-directory lib-file)))
+         (define (resolve file)
+           (let ((dest-path (make-path lib-dir file)))
+             (list 'rename (make-path dir dest-path) dest-path)))
+         (let lp ((ls declarations)
+                  (info `(,@(cond
+                             ((conf-get cfg '(command package author))
+                              => (lambda (x) (list (list 'author x))))
+                             (else '()))
+                          (path ,lib-file)
+                          (name ,name)
+                          library))
+                  (files `((rename ,file ,lib-file))))
+           (cond
+            ((null? ls)
+             (cons (reverse info) files))
+            (else
+             (match (car ls)
+               (((or 'include 'include-ci) includes ...)
+                (lp (cdr ls)
+                    info
+                    (append (map resolve includes) files)))
+               (('include-library-declarations includes ...)
+                (lp (append (append-map file->sexp-list includes) (cdr ls))
+                    info
+                    (append (map resolve includes) files)))
+               (('import libs ...)
+                (lp (cdr ls)
+                    (cons (cons 'depends (map import-name libs)) info)
+                    files))
+               (('cond-expand clauses ...)
+                ;;(lp (append (append-map cdr clauses) (cdr ls)) info files)
+                (let ((libs+files (map (lambda (c) (lp c '() '())) clauses)))
+                  (lp (cdr ls)
+                      (cons (cons 'cond-expand
+                                  (map cons
+                                       (map car clauses)
+                                       (map car libs+files)))
+                            info)
+                      (append files (append-map cdr libs+files)))))
+               (else
+                (lp (cdr ls) info files))))))))
+      (else
+       (die 2 "not a valid library declaration " lib " in file " file)))))
+
+(define (extract-program-imports file)
+  (let lp ((ls (guard (exn (else '())) (file->sexp-list file)))
+           (deps '()))
+    (cond
+     ((and (pair? ls) (pair? (car ls)) (eq? 'import (caar ls)))
+      (lp (cdr ls) (append (reverse (map import-name (cdar ls))) deps)))
+     (else
+      (reverse deps)))))
+
+(define (make-package-name cfg libs . o)
+  (let ((name (any (lambda (x) (or (library-name x) (program-name x))) libs))
+        (version (and (pair? o) (car o))))
+    (cond
+     ((not (and (pair? name) (list? name)))
+      (die 2 "Invalid library name: " name))
+     ((not name)
+      (die 2 "Couldn't determine package name from libs: " libs))
+     (else
+      (let lp ((ls (if version
+                       (append name (list version))
+                       name))
+               (res '()))
+        (if (null? ls)
+            (string-join (reverse (cons ".tgz" res)))
+            (lp (cdr ls)
+                (cons (x->string (car ls))
+                      (if (null? res) res (cons "-" res))))))))))
+
+(define (check-overwrite cfg file type-pred type-name)
+  (let ((mode (conf-get cfg '(command package overwrite) 'same-type)))
+    (cond
+     ((eq? mode 'always))
+     ((file-exists? file)
+      (case mode
+        ((never)
+         (die 2 "Destination " file " already exists, not overwriting"))
+        ((same-type)
+         (if (not (type-pred file))
+             (die 2 "Destination " file " doesn't look like a " type-name
+                  ", not overwriting")))
+        ((confirm)
+         (if (not (yes-or-no? cfg "Overwrite existing " file "?"))
+             (die 2 "Not overwriting " file))))))))
+
+;; Simplistic pretty printing for package/repository/config declarations.
+(define (write-simple-pretty pkg out)
+  (let wr ((ls pkg) (indent 0) (tails 0))
+    (cond
+     ((and (pair? ls)
+           (pair? (cdr ls))
+           (pair? (cadr ls)))
+      (display (make-string indent #\space) out)
+      (write-char #\( out)
+      (write (car ls) out)
+      (newline out)
+      (for-each (lambda (x) (wr x (+ indent 2) 0)) (drop-right (cdr ls) 1))
+      (wr (last ls) (+ indent 2) (+ tails 1)))
+     (else
+      (display (make-string indent #\space) out)
+      (write ls out)
+      (display (make-string tails #\)) out)
+      (newline out)))))
+
+;; We want to automatically bundle (foo bar *) when packaging (foo bar)
+;; if it's already in the same directory.
+(define (submodule->path base file lib dep)
+  (and base
+       (> (length dep) (length base))
+       (equal? base (take dep (length base)))
+       ;; TODO: find-library(-relative)
+       (let* ((dir (library-path-base file lib))
+              (dep-file (make-path dir (string-append
+                                        (library-name->path dep)
+                                        ".sld"))))
+         (and (file-exists? dep-file) dep-file))))
+
+(define (package-docs cfg spec libs)
+  (cond
+   ((conf-get cfg '(command package doc)) => list)
+   ((conf-get cfg '(command package doc-from-scribble))
+    (map
+     (lambda (lib)
+       (let* ((lib+files (extract-library cfg lib))
+              (lib-name (library-name (car lib+files))))
+         `(inline
+           ,(string-append (library-name->path lib-name) ".html")
+           ,(call-with-output-string
+              (lambda (out)
+                (print-module-docs lib-name out sxml-display-as-html))))))
+     libs))
+   (else '())))
+
+(define package-description
+  (let ((sent-re (regexp '(: "<p>" (* "\n") (* space) ($ (* (~ ("."))) "."))))
+        (space-re (regexp '(or (: (* space) "\n" (* space)) (>= 2 space))))
+        (tag-re (regexp '(: "<" (? "/") (* (~ ("<>"))) ">"))))
+    (lambda (cfg spec libs docs)
+      (cond
+       ((conf-get cfg '(command package description)))
+       ((conf-get cfg '(command upload description)))
+       ;; Crazy hack, make this more robust, probably opt-in.
+       ((and (pair? docs) (pair? (car docs)) (eq? 'inline (caar docs))
+             (regexp-search sent-re (third (car docs))))
+        => (lambda (m)
+             (let ((s (regexp-match-submatch m 1)))
+               (and s
+                    (string-trim
+                     (regexp-replace-all
+                      space-re
+                      (regexp-replace-all tag-re s "")
+                      " "))))))
+       (else #f)))))
+
+(define (package-test cfg)
+  (conf-get cfg '(command package test)))
+
+(define (package-license cfg)
+  (conf-get cfg '(command package license)))
+
+(define (package-output-version cfg)
+  (cond ((conf-get cfg '(command package version)))
+        ((conf-get cfg '(command upload version)))
+        ((conf-get cfg '(command package version-file))
+         => (lambda (file) (call-with-input-file file read-line)))
+        ((conf-get cfg '(command upload version-file))
+         => (lambda (file) (call-with-input-file file read-line)))
+        (else #f)))
+
+(define (package-output-path cfg package-spec)
+  (or (conf-get cfg 'output)
+      (make-package-name
+       cfg
+       (filter (lambda (x) (and (pair? x) (memq (car x) '(library program))))
+               package-spec)
+       (package-output-version cfg))))
+
+(define (package-spec+files cfg spec libs)
+  (let* ((recursive? (conf-get cfg '(command package recursive?)))
+         (programs (conf-get-list cfg '(command package programs)))
+         (docs (package-docs cfg spec libs))
+         (desc (package-description cfg spec libs docs))
+         (test (package-test cfg))
+         (authors (conf-get-list cfg '(command package authors)))
+         (maintainers (conf-get-list cfg '(command package maintainers)))
+         (version (package-output-version cfg))
+         (license (package-license cfg)))
+    (let lp ((ls (map (lambda (x) (cons x #f)) libs))
+             (progs programs)
+             (res
+              `(,@(if license `((license ,license)) '())
+                ,@(if (pair? docs)
+                      `((manual ,@(map
+                                   (lambda (x)
+                                     (path-strip-leading-parents
+                                      (if (pair? x) (cadr x) x)))
+                                   docs)))
+                      '())
+                ,@(if desc `((description ,desc)) '())
+                ,@(if test `((test ,(path-strip-leading-parents test))) '())
+                ,@(if version `((version ,version)) '())
+                ,@(if (pair? authors) `((authors ,@authors)) '())
+                ,@(if (pair? maintainers) `((maintainers ,@maintainers)) '())))
+             (files
+              `(,@(if test (list test) '())
+                ,@docs)))
+      (cond
+       ((pair? ls)
+        (let* ((lib+files (extract-library cfg (caar ls)))
+               (lib (car lib+files))
+               (name (library-name lib))
+               (base (or (cdar ls) name))
+               (subdeps (if recursive?
+                            (filter-map
+                             (lambda (x)
+                               (submodule->path base (caar ls) name x))
+                             (cond ((assq 'depends (cdr lib)) => cdr)
+                                   (else '())))
+                            '())))
+          (lp (append (map (lambda (x) (cons x base)) subdeps) (cdr ls))
+              progs
+              (cons lib res)
+              (append (reverse (cdr lib+files)) files))))
+       ((pair? progs)
+        (lp ls
+            (cdr progs)
+            (cons `(program
+                    (path ,(path-strip-leading-parents (car progs)))
+                    (depends ,@(extract-program-imports (car progs))))
+                  res)
+            (cons (car progs) files)))
+       ((null? res)
+        (die 2 "No packages generated"))
+       (else
+        (cons (cons 'package (reverse res)) (reverse files)))))))
+
+(define (create-package spec files path)
+  (gzip
+   (tar-create #f `(,@files
+                    (inline "package.scm"
+                            ,(call-with-output-string
+                               (lambda (out) (write-simple-pretty spec out)))))
+               (let ((dir (path-strip-extension (path-strip-directory path))))
+                 (lambda (f) (make-path dir f)))
+               #t)))
+
+(define (command/package cfg spec . libs)
+  (let* ((spec+files (package-spec+files cfg spec libs))
+         (output (package-output-path cfg (car spec+files)))
+         (tarball (create-package (car spec+files) (cdr spec+files) output)))
+    (check-overwrite cfg output package-file? "package")
+    (let ((out (open-binary-output-file output)))
+      (write-bytevector tarball out)
+      (close-output-port out))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Gen-key - generate a new RSA key pair.
+
+(define (conf-get-snow-dir cfg)
+  (or (conf-get cfg 'snow-dir)
+      (string-append (get-environment-variable "HOME") "/.snow")))
+
+(define (rsa-key->sexp key name email . o)
+  (let ((password (and (pair? o) (not (equal? "" (car o))) (car o))))
+    `((name ,name)
+      (email ,email)
+      (bits ,(rsa-key-bits key))
+      ,@(cond (password `((password ,password))) (else '()))
+      ,@(cond
+         ((rsa-key-e key)
+          => (lambda (e)
+               `((public-key
+                  (modulus ,(integer->hex-string (rsa-key-n key)))
+                  (exponent ,e)))))
+         (else '()))
+      ,@(cond
+         ((rsa-key-d key)
+          => (lambda (d)
+               `((private-key
+                  (modulus ,(integer->hex-string (rsa-key-n key)))
+                  (exponent ,d)))))
+         (else '())))))
+
+(define (conf-gen-key cfg bits)
+  (show #t "Generating a new key, this may take quite a while...\n")
+  (if (conf-get cfg 'gen-key-in-process?)
+      (rsa-key-gen bits)
+      (let* ((lo (max 3 (expt 2 (- bits 1))))
+             (hi (expt 2 bits))
+             (p (fast-eval `(random-prime ,lo ,hi)
+                           '((chibi math prime))))
+             (q (fast-eval `(random-prime-distinct-from ,lo ,hi ,p)
+                           '((chibi math prime)))))
+        (rsa-key-gen-from-primes bits p q))))
+
+(define (command/gen-key cfg spec)
+  (show #t
+        "Generate a new RSA key for signing packages.\n"
+        "We need a descriptive name, and an email address to "
+        "uniquely identify the key.\n")
+  (let* ((name (input cfg '(gen-key name) "Name: "))
+         (email (input cfg '(gen-key email) "Email: "))
+         (passwd (input-password cfg '(gen-key password)
+                                 "Password for upload: "
+                                 "Password (confirmation): "))
+         (bits (input-number cfg '(gen-key bits)
+                             "RSA key size in bits: " 512 64 20148))
+         (key (conf-gen-key cfg bits))
+         (snow-dir (conf-get-snow-dir cfg))
+         (key-file (or (conf-get cfg 'key-file)
+                       (string-append snow-dir "/priv-key.scm")))
+         (old-keys (guard (exn (else '()))
+                     (call-with-input-file key-file read)))
+         (new-keys
+          (cons (rsa-key->sexp key name email passwd)
+                ;; TODO: confirm overwrite, preserve old keys
+                (remove (rsa-identity=? email) old-keys))))
+    (if (not (file-directory? snow-dir))
+        (create-directory snow-dir))
+    (let* ((fd (open key-file (bitwise-ior open/write open/create) #o600))
+           (out (open-output-file-descriptor fd)))
+      (show out "("
+            (joined (lambda (x)
+                      (if (pair? x)
+                          (each "(" (joined written x "\n  ") ")")
+                          (written x)))
+                    new-keys
+                    "\n ")
+            ")" nl)
+      (close-output-port out)
+      (show #t "Saved key to " key-file ".\n"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Reg-key - register an RSA key pair with a repository.
+
+(define (remote-uri cfg name path)
+  (or (conf-get cfg name)
+      (make-path (or (conf-get cfg 'host) "http://snow-fort.org")
+                 path)))
+
+(define (remote-command cfg name path params)
+  (let ((uri (remote-uri cfg name path)))
+    (sxml-display-as-text (read (http-post uri (cons '(fmt . "sexp") params))))
+    (newline)))
+
+(define (command/reg-key cfg spec)
+  (let* ((keys (call-with-input-file
+                   (or (conf-get cfg 'key-file)
+                       (string-append (conf-get-snow-dir cfg) "/priv-key.scm"))
+                 read))
+         (email (or (conf-get cfg 'email)
+                    (assoc-get (car keys) 'email)))
+         (rsa-key-sexp (or (find (rsa-identity=? email) keys)
+                           (and (not email) (car keys))))
+         (name (assoc-get rsa-key-sexp 'name))
+         ;; Register the sha-256 sum of email and password - we'll
+         ;; never send the password itself over the network.
+         ;; TODO: encrypt this
+         (password
+          (cond ((assoc-get rsa-key-sexp 'password)
+                 => (lambda (pw) (sha-256 (string-append email pw))))
+                (else #f)))
+         (rsa-pub-key (extract-rsa-public-key rsa-key-sexp))
+         (rsa-pub-key-str
+          (write-to-string (rsa-key->sexp rsa-pub-key name email password))))
+    (remote-command cfg
+                    '(command reg-key uri)
+                    "/pkg/reg"
+                    `((u (file . "pub-key.scm")
+                         (value . ,rsa-pub-key-str))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Sign - sign a package.
+
+(define (generate-signature cfg package)
+  (let* ((digest-name (conf-get cfg 'digest 'sha-256))
+         (digest-func (lookup-digest digest-name))
+         (raw-data (if (string? package)
+                       (call-with-input-file package port->bytevector)
+                       package))
+         (snowball (maybe-gunzip raw-data))
+         (digest (digest-func snowball))
+         (keys (call-with-input-file
+                   (or (conf-get cfg 'key-file)
+                       (string-append (conf-get-snow-dir cfg) "/priv-key.scm"))
+                 read))
+         (email (or (conf-get cfg 'email)
+                    (assoc-get (car keys) 'email)))
+         (rsa-key-sexp (find (rsa-identity=? email) keys))
+         (rsa-key (extract-rsa-private-key rsa-key-sexp)))
+    (append
+     `(signature
+       (email ,email))
+     (if (conf-get cfg 'sign-uploads?)
+         (let* ((sig (fast-eval
+                      `(rsa-sign (make-rsa-key ,(rsa-key-bits rsa-key)
+                                               ,(rsa-key-n rsa-key)
+                                               #f
+                                               ,(rsa-key-d rsa-key))
+                                 ;;,(hex-string->integer digest)
+                                 ,(hex-string->bytevector digest))
+                      '((chibi crypto rsa))))
+                (hex-sig (if (bytevector? sig)
+                             (bytevector->hex-string sig)
+                             (integer->hex-string sig))))
+           `((digest ,digest-name)
+             (,digest-name ,digest)
+             (rsa ,hex-sig)))
+         '()))))
+
+(define (command/sign cfg spec package)
+  (let* ((dst (or (conf-get cfg 'output)
+                  (path-replace-extension package "sig")))
+         (sig (generate-signature cfg package)))
+    (call-with-output-file dst
+      (lambda (out) (write sig out)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Verify - verify a signature.
+
+(define (command/verify cfg spec sig)
+  (let* ((sig-spec (cdr (call-with-input-file sig read)))
+         (keys (call-with-input-file
+                   (or (conf-get cfg 'key-file)
+                       (string-append (conf-get-snow-dir cfg) "/priv-key.scm"))
+                 read))
+         (email (assoc-get sig-spec 'email))
+         (digest-name (assoc-get sig-spec 'digest #f 'sha-256))
+         (digest (assoc-get sig-spec digest-name))
+         (sig (assoc-get sig-spec 'rsa))
+         (rsa-key-sexp (or (and (string? email)
+                                (find (rsa-identity=? email) keys))
+                           (car keys)))
+         (rsa-key (extract-rsa-public-key rsa-key-sexp))
+         (cipher (rsa-verify rsa-key (hex-string->bytevector sig)))
+         (digest-bv (hex-string->bytevector digest)))
+    (if (equal? cipher digest-bv)
+        (show #t "signature valid " nl)
+        (show #t "signature invalid " cipher " != " digest-bv nl))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Upload - upload a package.
+
+(define (get-password cfg package)
+  (and (not (conf-get cfg 'upload-without-password?))
+       (let* ((keys (call-with-input-file
+                        (or (conf-get cfg 'key-file)
+                            (string-append (conf-get-snow-dir cfg)
+                                           "/priv-key.scm"))
+                      read))
+              (email (or (conf-get cfg 'email)
+                         (assoc-get (car keys) 'email)))
+              (rsa-key-sexp (find (rsa-identity=? email) keys))
+              (raw-password (assoc-get rsa-key-sexp 'password)))
+         (and raw-password
+              (sha-256 (string-append email raw-password))))))
+
+(define (upload-package cfg spec package . o)
+  (let ((password `(pw (value ,(get-password cfg))))
+        (pkg (if (string? package)
+                 `(u (file . ,package))
+                 `(u (file . ,(if (pair? o) (car o) "package.tgz"))
+                     (value . ,package))))
+        (sig
+         (cond
+          ((conf-get cfg 'sig-file)
+           => (lambda (sig-file) `(sig (file . ,sig-file))))
+          (else
+           (let ((sig (generate-signature cfg package)))
+             `(sig (file . "package.sig")
+                   (value . ,(write-to-string sig))))))))
+    (remote-command cfg '(command package uri) "/pkg/put"
+                    (list password pkg sig))))
+
+(define (command/upload cfg spec . o)
+  (define (non-homogeneous)
+    (die 1 "upload arguments must all be packages or all be libraries, "
+         "but got " o))
+  (cond
+   ((null? o)
+    (die 1 "upload requires at least one input argument"))
+   ((package-file? (car o))
+    (if (not (every package-file? (cdr o)))
+        (non-homogeneous))
+    (for-each
+     (lambda (package) (upload-package cfg spec package))
+     o))
+   (else
+    (if (any package-file? (cdr o))
+        (non-homogeneous))
+    (let* ((spec+files (package-spec+files cfg spec o))
+           (package-file (package-output-path cfg (car spec+files)))
+           (package (create-package (car spec+files)
+                                    (cdr spec+files)
+                                    package-file)))
+      (upload-package cfg spec package package-file)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Remove - removes the listed libraries.
+;;
+;; Provides a summary of the libraries to remove along with any
+;; dependencies they have which were not explicitly installed.
+
+(define (warn-delete-file file)
+  (guard (exn (else (warn "couldn't delete file: " file)))
+    (delete-file file)))
+
+(define (delete-library-files impl cfg pkg lib-name)
+  (for-each warn-delete-file (package-installed-files pkg))
+  (warn-delete-file (make-path (get-install-source-dir impl cfg)
+                               (get-package-meta-file cfg pkg)))
+  (let ((dir (make-path (get-install-source-dir impl cfg)
+                        (package->path pkg))))
+    (if (and (file-directory? dir)
+             (= 2 (length (directory-files dir))))
+        (delete-directory dir))))
+
+(define (command/remove cfg spec . args)
+  (let* ((impls (conf-selected-implementations cfg))
+         (impl-cfgs (map (lambda (impl)
+                           (conf-for-implementation cfg impl))
+                         impls))
+         (lib-names (map parse-library-name args)))
+    (for-each
+     (lambda (impl impl-cfg)
+       (for-each (lambda (pkg lib-name)
+                   (delete-library-files impl impl-cfg (cdr pkg) lib-name))
+                 (lookup-installed-libraries impl impl-cfg lib-names)
+                 lib-names))
+     impls
+     impl-cfgs)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Search - search for libraries matching keywords.
+;;
+;; Prints a list of libraries whose meta-info contain any of the given
+;; keywords.  Returns in sorted order for how well the package matches.
+
+(define (summarize-libraries cfg lib-names+pkgs)
+  (for-each describe-library
+            (map car lib-names+pkgs)
+            (map cdr lib-names+pkgs)))
+
+;; faster than (length (regexp-extract re str))
+(define (regexp-count re str)
+  (regexp-fold re (lambda (from md str acc) (+ acc 1)) 0 str))
+
+(define (count-in-sexp x keywords)
+  (regexp-count `(word (w/nocase (or ,@keywords)))
+                (write-to-string x)))
+
+(define (extract-matching-libraries cfg repo keywords)
+  (define (library-score lib)
+    (+ (* 10 (count-in-sexp (library-name lib) keywords))
+       (count-in-sexp lib keywords)
+       (let ((use-for (assoc-get lib 'use-for)))
+         (case (if (pair? use-for) (car use-for) use-for)
+           ((test) 0)
+           ((build) 10)
+           (else 100)))))
+  (append-map
+   (lambda (x)
+     (cond
+      ((not (package? x)) '())
+      (else
+       (let ((pkg-score (count-in-sexp x keywords))
+             (libs (package-libraries x)))
+         (if (or (zero? pkg-score) (null? libs))
+             '()
+             (let lp ((libs (cdr libs))
+                      (best-score (library-score (car libs)))
+                      (best-lib (car libs)))
+               (cond
+                ((null? libs)
+                 (list (cons (+ best-score pkg-score)
+                             (cons (library-name best-lib) x))))
+                (else
+                 (let ((score (library-score (car libs))))
+                   (if (> score best-score)
+                       (lp (cdr libs) score (car libs))
+                       (lp (cdr libs) best-score best-lib)))))))))))
+   repo))
+
+(define (extract-sorted-packages cfg repo keywords)
+  (let ((ls (extract-matching-libraries cfg repo keywords)))
+    (map cdr (sort ls > car))))
+
+(define (command/search cfg spec . keywords)
+  (let* ((repo (maybe-update-repository cfg))
+         (lib-names+pkgs (extract-sorted-packages cfg repo keywords)))
+    (if (pair? lib-names+pkgs)
+        (summarize-libraries cfg lib-names+pkgs)
+        (display "No libraries matched your query.\n"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Show - show detailed information for the given libraries
+;;
+;; The typical pattern is to use search to find the names of libraries
+;; of interest, and show to see detailed information to decide whether
+;; or not to install them.
+
+(define (describe-library library-name pkg)
+  (display library-name)
+  (display "\t")
+  (display (package-version pkg))
+  (newline))
+
+(define (command/show cfg spec . args)
+  (maybe-update-repository cfg)
+  (let* ((impls (conf-selected-implementations cfg))
+         (impl-cfgs (map (lambda (impl)
+                           (conf-for-implementation cfg impl))
+                         impls))
+         (lib-names (map parse-library-name args)))
+    (for-each
+     (lambda (impl impl-cfg)
+       (for-each describe-library
+                 (lookup-installed-libraries impl impl-cfg lib-names)
+                 lib-names))
+     impls
+     impl-cfgs)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Update - update the repository.
+
+(define (valid-repository? repo)
+  (and (pair? repo) (list? repo) (eq? 'repository (car repo))))
+
+(define (repository-dir cfg)
+  (cond
+   ((zero? (current-user-id))
+    (or (conf-get cfg 'local-root-repository)
+        "/usr/local/share/snow/repo"))
+   (else
+    (or (conf-get cfg 'local-user-repository)
+        (make-path (conf-get-snow-dir cfg) "repo")))))
+
+(define (update-repository cfg)
+  (let* ((local-dir (repository-dir cfg))
+         (local-path (make-path local-dir "repo.scm"))
+         (local-tmp (string-append local-path ".tmp."
+                                   (number->string (current-second))))
+         (repo-uri (remote-uri cfg 'repository-uri "/s/repo.scm"))
+         (repo-str (call-with-input-url repo-uri port->string))
+         (repo (guard (exn (else #f))
+                 (let ((repo (read (open-input-string repo-str))))
+                   `(,(car repo) (url ,repo-uri) ,@(cdr repo))))))
+    (cond
+     ((not (valid-repository? repo))
+      (die 2 "not a valid repository: " repo-uri))
+     ((not (create-directory* local-dir))
+      (die 2 "can't create directory: " local-dir ))
+     (else
+      (guard (exn (else (die 2 "couldn't write repository")))
+        (call-with-output-file local-tmp
+          (lambda (out) (write repo out)))
+        (if (file-exists? local-path)
+            (rename-file local-path (string-append local-path ".bak")))
+        (rename-file local-tmp local-path)
+        repo)))))
+
+(define (repository-stale? cfg)
+  (let ((path (make-path (repository-dir cfg) "repo.scm")))
+    (guard (exn (else #t))
+      (> (current-second)
+         (+ (file-modification-time path)
+            ;; by default update once every 3 hours
+            (conf-get cfg 'update-refresh (* 3 60 60)))))))
+
+(define (should-update-repository? cfg)
+  (case (conf-get cfg 'update-strategy 'cache)
+    ((always) #t)
+    ((never) #f)
+    ((cache)
+     (repository-stale? cfg))
+    ((confirm)
+     (and (repository-stale? cfg)
+          (yes-or-no? cfg "Update repository info?")))
+    (else
+     (warn "unknown update-stategy: " (conf-get cfg 'update-strategy))
+     #f)))
+
+(define (maybe-update-repository cfg)
+  (or (guard (exn (else #f))
+        (and (should-update-repository? cfg)
+             (update-repository cfg)))
+      (guard (exn (else '(repository)))
+        (call-with-input-file (make-path (repository-dir cfg) "repo.scm")
+          read))))
+
+(define (command/update cfg spec)
+  (update-repository cfg))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Install - install one or more libraries.
+;;
+;; Installs the listed libraries along with their transitive closure
+;; of dependencies.  For each library to install we confirm the
+;; current status (skipping if already installed), the signature and
+;; trust (optionally updating the trust level), and the default tests.
+;; If multiple implementations are targeted, we install separately but
+;; use the same confirmations for each.
+
+(define (get-install-dirs impl cfg)
+  (define (guile-eval expr)
+    (guard (exn (else #f))
+      (process->sexp `(guile -c ,(write-to-string `(write ,expr))))))
+  (case impl
+    ((chibi)
+     (let* ((dirs (reverse (fast-eval '(current-module-path) '((chibi)))))
+            (share-dir (find (lambda (d) (string-contains d "/share/")) dirs)))
+       (if share-dir
+           (cons share-dir (delete share-dir dirs))
+           dirs)))
+    ((gauche)
+     (list
+      (let ((dir (process->string '(gauche-config "--sitelibdir"))))
+        (and (string? dir) (> 0 (string-length dir))
+             (eqv? #\/ (string-ref dir 0))
+             dir))))
+    ((guile)
+     (let ((path
+            (guile-eval
+             '(string-append (cdr (assq 'pkgdatadir %guile-build-info))
+                             (string (integer->char 47))
+                             (effective-version)))))
+       (list
+        (if (string? path)
+            path
+            "/usr/local/share/guile/"))))
+    ((larceny)
+     (list
+      (make-path
+       (process->string
+        '(larceny -quiet -nobanner -- -e
+                  "(begin (display (getenv \"LARCENY_ROOT\")) (exit))"))
+       "lib/Snow")))
+    (else
+     (list (make-path "/usr/local/share/snow" impl)))))
+
+(define (scheme-program-command impl cfg file . o)
+  (let ((lib-path (and (pair? o) (car o))))
+    (case impl
+      ((chibi)
+       (let ((chibi (conf-get cfg 'chibi-path 'chibi-scheme)))
+         (if lib-path
+             `(,chibi -A ,lib-path ,file)
+             `(,chibi ,file))))
+      ((gauche)
+       (if lib-path
+           `(gosh -A ,lib-path ,file)
+           `(gosh ,file)))
+      ((guile)
+       (if lib-path
+           `(guile -L ,lib-path ,file)
+           `(guile ,file)))
+      ((larceny)
+       (if lib-path
+           `(larceny -r7rs -path ,lib-path -program ,file)
+           `(larceny -r7rs -program ,file)))
+      (else
+       #f))))
+
+(define (get-install-search-dirs impl cfg)
+  (let ((install-dir (get-install-source-dir impl cfg))
+        (other-dirs (get-install-dirs impl cfg)))
+    (cons install-dir (delete install-dir other-dirs))))
+
+(define (find-library-meta impl cfg name)
+  (let ((dirs (get-install-search-dirs impl cfg)))
+    (let lp ((subname name))
+      (or (find-sexp-in-path
+           (package-name->meta-file cfg subname)
+           dirs
+           (lambda (x)
+             (and (package? x)
+                  (any (lambda (y) (equal? name (library-name y)))
+                       (package-libraries x)))))
+          (and (pair? (cdr subname))
+               (lp (drop-right subname 1)))))))
+
+;; test the package locally built in dir
+(define (test-package impl cfg pkg dir)
+  (let* ((test-file (assoc-get pkg 'test))
+         (command (scheme-program-command impl cfg test-file dir)))
+    (cond
+     ((and test-file command (not (conf-get cfg 'skip-tests?)))
+      (or (match (process->output+error+status command)
+            ((output error status)
+             (cond
+              ((or (not (zero? status))
+                   (string-contains output "FAIL")
+                   (string-contains error "FAIL")
+                   (string-contains output "ERROR")
+                   (string-contains error "ERROR"))
+               (call-with-output-file (make-path dir "test-out.txt")
+                 (lambda (out) (display output out)))
+               (call-with-output-file (make-path dir "test-err.txt")
+                 (lambda (err) (display error err)))
+               #f)
+              (else
+               (info "All tests passed.")
+               (cond ((conf-get cfg 'show-tests?)
+                      (display "output:\n")
+                      (display output)
+                      (display error)))
+               #t)))
+            (else #f))
+          (yes-or-no? cfg "Tests failed: " test-file
+                      " (details in " dir "/test-{out,err}.txt)\n"
+                      "Proceed anyway?")))
+     (else
+      #t))))
+
+(define (lookup-installed-libraries impl cfg names)
+  (map (lambda (name)
+         (cons name
+               (or (find-library-meta impl cfg name)
+                   `(not-installed ,name))))
+       names))
+
+(define (installed-libraries impl cfg)
+  (delete-duplicates
+   (directory-fold-tree
+    (get-install-source-dir impl cfg)
+    #f #f
+    (lambda (file acc)
+      (cond
+       ((and (equal? "meta" (path-extension file))
+             (guard (exn (else #f))
+               (let ((pkg (call-with-input-file file read)))
+                 (and (package? pkg) pkg))))
+        => (lambda (pkg)
+             (append
+              (map
+               (lambda (lib) (cons (library-name lib) pkg))
+               (package-libraries pkg))
+              acc)))
+       (else acc)))
+    '())
+   (lambda (a b) (equal? (car a) (car b)))))
+
+(define (get-install-source-dir impl cfg)
+  (cond
+   ((conf-get cfg 'install-source-dir))
+   ((conf-get cfg 'install-prefix)
+    => (lambda (prefix) (make-path prefix "share/snow" impl)))
+   (else (car (get-install-dirs impl cfg)))))
+
+(define (get-install-binary-dir impl cfg)
+  (cond
+   ((conf-get cfg 'install-binary-dir))
+   ((conf-get cfg 'install-prefix)
+    => (lambda (prefix) (make-path prefix "bin")))
+   (else "/usr/local/bin")))
+
+(define (install-with-sudo? cfg path)
+  (case (conf-get cfg '(command install use-sudo?))
+    ((always) #t)
+    ((never) #f)
+    (else
+     (let lp ((path path))
+       (let ((dir (path-directory path)))
+         (and (not (file-is-writable? path))
+              (or (file-exists? path)
+                  (lp dir))))))))
+
+(define (install-file cfg source dest)
+  (if (install-with-sudo? cfg dest)
+      (system "sudo" "cp" source dest)
+      (copy-file source dest)))
+
+(define (install-sexp-file cfg obj dest)
+  (if (install-with-sudo? cfg dest)
+      (call-with-temp-file "sexp"
+        (lambda (tmp-path out)
+          (write-simple-pretty obj out)
+          (close-output-port out)
+          (system "sudo" "cp" tmp-path dest)))
+      (call-with-output-file dest
+        (lambda (out) (write-simple-pretty obj out)))))
+
+(define (install-symbolic-link cfg source dest)
+  (if (install-with-sudo? cfg dest)
+      (system "sudo" "ln" "-s" source dest)
+      (symbolic-link-file source dest)))
+
+(define (install-directory cfg dir)
+  (cond
+   ((file-directory? dir))
+   ((install-with-sudo? cfg dir)
+    (system "sudo" "mkdir" "-p" dir))
+   (else
+    (create-directory* dir))))
+
+(define (install-package-meta-info impl cfg pkg)
+  (let* ((meta-file (get-package-meta-file cfg pkg))
+         (install-dir (get-install-source-dir impl cfg))
+         (path (make-path install-dir meta-file)))
+    ;; write the package name
+    (install-sexp-file cfg pkg path)
+    ;; symlink utility libraries for which the package can't be inferred
+    (let ((pkg-name (package-name pkg)))
+      (for-each
+       (lambda (lib)
+         (let ((lib-name (library-name lib)))
+           (if (not (equal? pkg-name (take lib-name (length pkg-name))))
+               (let ((lib-meta (get-library-meta-file cfg lib)))
+                 (install-symbolic-link
+                  cfg path (make-path install-dir lib-meta))))))
+       (package-libraries pkg)))))
+
+;; The default installer just copies the library file and any included
+;; source files to an installation directory, optionally mapping
+;; extensions to the implementations preferred value.
+(define (default-installer impl cfg library dir)
+  (let* ((library-file (get-library-file cfg library))
+         (ext (conf-get cfg 'library-extension "sld"))
+         (dest-library-file (path-replace-extension library-file ext))
+         (include-files
+          (library-include-files impl cfg (make-path dir library-file)))
+         (rewrite-include-files
+          ;; Rewrite if any include has the same path as the library
+          ;; declaration file after extension renaming.
+          ;; TODO: Also rewrite if multiple libs use same file names?
+          (map
+           (lambda (x)
+             (if (equal? x dest-library-file)
+                 (cons x (string-append x "." ext))
+                 x))
+           include-files))
+         (install-dir (get-install-source-dir impl cfg)))
+    ;; install the library file
+    (let ((path (make-path install-dir dest-library-file)))
+      (install-directory cfg (path-directory path))
+      (if (any pair? rewrite-include-files)
+          (install-sexp-file
+           cfg
+           (library-rewrite-includes library rewrite-include-files)
+           path)
+          (install-file cfg (make-path dir library-file) path))
+      ;; install any includes
+      (cons
+       path
+       (map
+        (lambda (x)
+          (let ((dest-file
+                 (make-path install-dir
+                            (path-relative (if (pair? x) (cdr x) x) dir))))
+            (install-directory cfg (path-directory dest-file))
+            (install-file cfg (if (pair? x) (car x) x) dest-file)
+            dest-file))
+        rewrite-include-files)))))
+
+(define (default-program-installer impl cfg prog dir)
+  (let* ((program-file (get-program-file cfg prog))
+         (dest-program-file (program-install-name prog))
+         (install-dir (get-install-binary-dir impl cfg)))
+    (let ((path (make-path install-dir dest-program-file)))
+      (install-directory cfg (path-directory path))
+      (install-file cfg (make-path dir program-file) path))))
+
+;; installers should return the list of installed files
+(define (lookup-installer installer)
+  (case installer
+    (else default-installer)))
+
+(define (install-library impl cfg library dir)
+  (let ((installer (lookup-installer (conf-get cfg 'installer))))
+    (installer impl cfg library dir)))
+
+(define (build-library impl cfg library dir)
+  ;; the currently supported implementations don't require building
+  #t)
+
+(define (build-program impl cfg prog dir)
+  #t)
+
+(define (lookup-program-installer installer)
+  (case installer
+    (else default-program-installer)))
+
+(define (install-program impl cfg prog dir)
+  (let ((installer (lookup-program-installer
+                    (conf-get cfg 'program-installer))))
+    (installer impl cfg prog dir)))
+
+(define (fetch-package cfg url)
+  (call-with-input-url url port->bytevector))
+
+(define (path-strip-top file)
+  (let ((pos (string-find file #\/)))
+    (if (string-cursor<? pos (string-cursor-end file))
+        (substring-cursor file (string-cursor-next file pos))
+        file)))
+
+(define (maybe-invalid-package-reason impl cfg pkg)
+  (let ((res (invalid-package-reason pkg)))
+    (and res
+         (not (yes-or-no? cfg "Package invalid: " res "\nProceed anyway?"))
+         res)))
+
+(define (package-maybe-digest-mismatches impl cfg pkg raw)
+  (and (not (conf-get cfg 'ignore-digests?))
+       (let ((res (package-digest-mismatches cfg pkg raw)))
+         (and res
+              (not (yes-or-no? cfg "Package checksum mismatches: " res
+                               "\nProceed anyway?"))
+              res))))
+
+(define (package-maybe-signature-mismatches repo impl cfg pkg raw)
+  (cond
+   ((conf-get cfg 'ignore-signature?) #f)
+   ((not (assq 'signature (cdr pkg)))
+    (if (yes-or-no? cfg "Package signature missing.\nProceed anyway?")
+        #f
+        '(package-signature-missing)))
+   (else
+    (let ((res (package-signature-mismatches repo cfg pkg raw)))
+      (and res
+           (not (yes-or-no? cfg "Package signature mismatches: " res
+                            "\nProceed anyway?"))
+           res)))))
+
+;; install from a raw, unzipped snowball as an in-memory bytevector
+(define (install-package-from-snowball repo impl cfg pkg snowball)
+  (cond
+   ((not (tar-safe? snowball))
+    (die 2 "package tarball should contain a single relative directory: "
+         (tar-files snowball)))
+   ((package-maybe-digest-mismatches impl cfg pkg snowball)
+    => (lambda (x) (die 2 "package checksum didn't match: " x)))
+   ((package-maybe-signature-mismatches repo impl cfg pkg snowball)
+    => (lambda (x) (die 2 "package signature didn't match: " x)))
+   (else
+    (call-with-temp-dir
+     "pkg"
+     (lambda (dir)
+       (tar-extract snowball (lambda (f) (make-path dir (path-strip-top f))))
+       (for-each
+        (lambda (lib) (build-library impl cfg lib dir))
+        (package-libraries pkg))
+       (if (test-package impl cfg pkg dir)
+           (let ((installed-files
+                  (append
+                   (append-map
+                    (lambda (lib)
+                      (install-library impl cfg lib dir))
+                    (package-libraries pkg))
+                   (append-map
+                    (lambda (prog)
+                      (build-program impl cfg prog dir)
+                      (install-program impl cfg prog dir))
+                    (package-programs pkg)))))
+             (install-package-meta-info
+              impl cfg
+              `(,@(remove (lambda (x)
+                            (and (pair? x) (eq? 'installed-files (car x))))
+                          pkg)
+                (installed-files ,@installed-files))))))))))
+
+(define (install-package-from-file repo impl cfg file)
+  (let ((pkg (package-file-meta file))
+        (snowball (maybe-gunzip (file->bytevector file))))
+    (install-package-from-snowball repo impl cfg pkg snowball)))
+
+(define (install-package repo impl cfg pkg)
+  (cond
+   ((maybe-invalid-package-reason impl cfg pkg)
+    => (lambda (x) (die 2 "package invalid: " x)))
+   (else
+    (let* ((url (package-url repo pkg))
+           (raw (fetch-package cfg url))
+           (snowball (maybe-gunzip raw)))
+      (install-package-from-snowball impl cfg pkg snowball)))))
+
+(define (install-for-implementation repo impl cfg pkgs)
+  (for-each
+   (lambda (pkg) (install-package repo impl cfg pkg))
+   pkgs))
+
+(define (select-best-candidate impl cfg repo candidates)
+  (cond
+   ((null? (cdr candidates))
+    (car candidates))
+   (else
+    (display "Select a package:\n")
+    (let lp ((ls candidates) (i 1))
+      (if (pair? ls)
+          (let ((pkg (car ls)))
+            (display "  ") (display i)
+            (display "  ") (display (package-name pkg))
+            (display " ") (display (package-version pkg))
+            (display " (") (display (package-author repo pkg #t))
+            (display ")\n")
+            (lp (cdr ls) (+ i 1)))))
+    (let ((n (input-number cfg 'candidate-number "Candidate number: "
+                           1 1 (length candidates))))
+      (list-ref candidates (- n 1))))))
+
+;; Choose packages for the corresponding libraries, and recursively
+;; select uninstalled packages.  Verifies and records preferences for
+;; trusting publishers for different library prefixes.
+(define (expand-package-dependencies repo impl cfg lib-names)
+  (let ((current (installed-libraries impl cfg)))
+    (let lp ((ls lib-names) (res '()) (ignored '()))
+      (cond
+       ((null? ls) res)
+       ((find (lambda (pkg) (package-provides? pkg (car ls))) res)
+        (lp (cdr ls) res ignored))
+       (else
+        (let* ((current-version
+                (cond ((assoc (car ls) current)
+                       => (lambda (x) (package-version (cdr x))))
+                      (else #f)))
+               (candidates
+                (filter
+                 (lambda (pkg)
+                   (and (package-provides? pkg (car ls))
+                        (or (not current-version)
+                            (version>? (package-version pkg)
+                                       current-version))))
+                 (cdr repo))))
+          (cond
+           ((member (car ls) ignored)
+            (lp (cdr ls) res ignored))
+           ((and (null? candidates) (assoc (car ls) current))
+            (if (member (car ls) lib-names)
+                (warn "skipping already installed library" (car ls)))
+            (lp (cdr ls) res (cons (car ls) ignored)))
+           ((and (null? candidates) (member (car ls) lib-names))
+            (die 2 "Can't find package: " (car ls)))
+           ((null? candidates)
+            (if (yes-or-no? cfg "Can't find package: " (car ls)
+                            ".  Proceed anyway?")
+                (lp (cdr ls) res (cons (car ls) ignored))
+                (exit 2)))
+           (else
+            (let ((pkg (select-best-candidate impl cfg repo candidates)))
+              (lp (append (package-dependencies impl cfg pkg) (cdr ls))
+                  (cons pkg res)
+                  ignored))))))))))
+
+;; First lookup dependencies for all implementations so we can
+;; download in a single batch.  Then perform the installations a
+;; single implementation at a time.
+(define (command/install cfg spec . args)
+  (let*-values
+      (((repo) (maybe-update-repository cfg))
+       ((impls) (conf-selected-implementations cfg))
+       ((impl-cfgs) (map (lambda (impl)
+                           (conf-for-implementation cfg impl))
+                         impls))
+       ((package-files lib-names) (partition package-file? args))
+       ((lib-names) (map parse-library-name lib-names))
+       ((impl-pkgs)
+        (map (lambda (impl cfg)
+               (expand-package-dependencies repo impl cfg lib-names))
+             impls
+             impl-cfgs)))
+    (for-each
+     (lambda (impl cfg pkgs)
+       ;; install by name and dependency
+       (install-for-implementation repo impl cfg pkgs)
+       ;; install by file
+       (for-each
+        (lambda (pkg-file)
+          (install-package-from-file repo impl cfg pkg-file))
+        package-files))
+     impls
+     impl-cfgs
+     impl-pkgs)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Upgrade - upgrade installed packages.
+
+;; With explicit packages same as install, but by default upgrade all
+;; available packages.
+(define (command/upgrade cfg spec . args)
+  (if (pair? args)
+      (apply command/install cfg spec args)
+      (let* ((repo (maybe-update-repository cfg))
+             (impls (conf-selected-implementations cfg))
+             (impl-cfgs (map (lambda (impl)
+                               (conf-for-implementation cfg impl))
+                             impls)))
+        (for-each
+         (lambda (impl cfg)
+           (let ((pkgs (map cdr (installed-libraries impl cfg))))
+             (install-for-implementation repo impl cfg pkgs)))
+         impls
+         impl-cfgs))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Status - show the status of installed libraries.
+
+(define (command/status cfg spec . args)
+  (let* ((impls (conf-selected-implementations cfg))
+         (impl-cfgs (map (lambda (impl)
+                           (conf-for-implementation cfg impl))
+                         impls)))
+    (for-each
+     (lambda (impl impl-cfg)
+       (cond
+        ((pair? (cdr impls))
+         (if (not (eq? impl (car impls)))
+             (display "\n"))
+         (display impl)
+         (display ":\n")))
+       (summarize-libraries
+        impl-cfg
+        (if (pair? args)
+            (lookup-installed-libraries
+             impl impl-cfg (map parse-library-name args))
+            (installed-libraries impl impl-cfg))))
+     impls
+     impl-cfgs)))
diff --git a/lib/chibi/snow/commands.sld b/lib/chibi/snow/commands.sld
new file mode 100644
index 00000000..7037b3d1
--- /dev/null
+++ b/lib/chibi/snow/commands.sld
@@ -0,0 +1,50 @@
+
+(define-library (chibi snow commands)
+  (export command/package
+          command/gen-key
+          command/reg-key
+          command/sign
+          command/verify
+          command/upload
+          command/install
+          command/remove
+          command/search
+          command/show
+          command/status
+          command/update
+          command/upgrade)
+  (import (scheme base)
+          (scheme eval)
+          (scheme file)
+          (scheme process-context)
+          (scheme time)
+          (scheme read)
+          (scheme write)
+          (srfi 1)
+          (srfi 27)
+          (srfi 33)
+          (srfi 95)
+          (chibi snow interface)
+          (chibi snow package)
+          (chibi snow utils)
+          (chibi bytevector)
+          (chibi config)
+          (chibi crypto md5)
+          (chibi crypto rsa)
+          (chibi crypto sha2)
+          (chibi doc)
+          (chibi filesystem)
+          (chibi io)
+          (chibi match)
+          (chibi net http)
+          (chibi process)
+          (chibi pathname)
+          (chibi regexp)
+          (chibi show)
+          (chibi show pretty)
+          (chibi string)
+          (chibi sxml)
+          (chibi system)
+          (chibi tar)
+          (chibi zlib))
+  (include "commands.scm"))
diff --git a/lib/chibi/snow/fort.scm b/lib/chibi/snow/fort.scm
new file mode 100644
index 00000000..bb858eb1
--- /dev/null
+++ b/lib/chibi/snow/fort.scm
@@ -0,0 +1,260 @@
+
+(define (static-url cfg path)
+  (make-path "/s" path))
+
+(define (static-local-path cfg path)
+  (make-path (conf-get cfg 'doc-root ".") "s" path))
+
+(define (maybe-parse-hex x)
+  (if (string? x) (hex-string->bytevector x) x))
+
+(define valid-email?
+  ;; Conservatively match local parts allowed by hotmail, removing
+  ;; the restriction on ".." as allowed by Japanese phone providers.
+  (let ((re (regexp
+             '(: (+ (or alphanumeric #\_ #\- #\. #\+ #\= #\& #\'))
+                 "@" (+ (or alphanumeric #\_ #\-))
+                 (+ "." (+ (or alphanumeric #\_ #\-)))))))
+    (lambda (str) (regexp-matches? re str))))
+
+(define (extract-snowball-package bv)
+  (define (path-top path)
+    (substring path 0 (string-find path #\/)))
+  (guard (exn
+          (else
+           (log-error "couldn't extract package.scm: " exn)
+           #f))
+    (cond
+     ((tar-safe? bv)
+      (let* ((files (tar-files bv))
+             (dir (path-top (car files)))
+             (pkg-path (make-path dir "package.scm")))
+        (cond
+         ((member pkg-path files)
+          (read (open-input-bytevector
+                 (tar-extract-file bv pkg-path))))
+         (else
+          (log-error "no package.scm in " dir)
+          #f))))
+     (else
+      (log-error "tar-bomb")
+      #f))))
+
+(define escape-path
+  (lambda (str)
+    (let ((re (regexp '(w/ascii (~ (or alphanumeric #\_ #\- #\.))))))
+      (regexp-replace
+       re
+       str
+       (lambda (m)
+         (let ((n (char->integer
+                   (string-ref (regexp-match-submatch m 0) 0))))
+           (string-append
+            "%"
+            (if (< n 16) "0" "")
+            (number->string n 16))))))))
+
+(define (x->string x)
+  (cond ((string? x) x)
+        ((symbol? x) (symbol->string x))
+        ((number? x) (number->string x))
+        (else (error "not stringable" x))))
+
+(define (email->path str)
+  (let ((ls (string-split str #\@)))
+    (make-path (escape-path (cadr ls)) (escape-path (car ls)))))
+
+(define (repo-publishers cfg)
+  (filter (lambda (x) (and (pair? x) (eq? 'publisher (car x))))
+          (cdr (current-repo cfg))))
+
+(define (invalid-signature-reason cfg sig-spec snowball)
+  (let* ((digest-name (assoc-get (cdr sig-spec) 'digest #f 'sha-256))
+         (digest (assoc-get (cdr sig-spec) digest-name))
+         (actual-digest ((lookup-digest digest-name) snowball))
+         (sig (assoc-get (cdr sig-spec) 'rsa))
+         (email (assoc-get (cdr sig-spec) 'email))
+         (rsa-key-sexp (find (rsa-identity=? email)
+                             (repo-publishers cfg)))
+         (rsa-key (and (pair? rsa-key-sexp)
+                       (extract-rsa-public-key (cdr rsa-key-sexp)))))
+    (cond
+     ((not (equal? digest actual-digest))
+      (string-append "the " digest-name " digest in the signature <" digest
+                     "> didn't match the actual value: <" actual-digest ">"))
+     ((not rsa-key)
+      (string-append "unknown publisher: " email))
+     ((not (rsa-verify? rsa-key
+                        (maybe-parse-hex digest)
+                        (maybe-parse-hex sig)))
+      (log-error "digest: " digest " sig: " (maybe-parse-hex sig)
+                 " verify: " (rsa-encrypt rsa-key digest))
+      "rsa signature did not match")
+     (else
+      #f))))
+
+(define (get-user-password cfg email)
+  (let* ((user-dir (static-local-path cfg (email->path email)))
+         (key-file (make-path user-dir "pub-key"))
+         (key (call-with-input-file key-file read)))
+    (and (pair? key) (assoc-get key 'password))))
+
+(define (package-dir email pkg)
+  (make-path
+   (email->path email)
+   (string-join (map escape-path (map x->string (package-name pkg))) "/")
+   (escape-path (package-version pkg))))
+
+;; Simplistic pretty printing for package/repository/config declarations.
+(define (write-simple-pretty pkg out)
+  (let wr ((ls pkg) (indent 0) (tails 0))
+    (cond
+     ((and (pair? ls)
+           (pair? (cdr ls))
+           (pair? (cadr ls)))
+      (display (make-string indent #\space) out)
+      (write-char #\( out)
+      (write (car ls) out)
+      (newline out)
+      (for-each (lambda (x) (wr x (+ indent 2) 0)) (drop-right (cdr ls) 1))
+      (wr (last ls) (+ indent 2) (+ tails 1)))
+     (else
+      (display (make-string indent #\space) out)
+      (write ls out)
+      (display (make-string tails #\)) out)
+      (newline out)))))
+
+(define (file-lock-loop port-or-fd mode)
+  (let lp ()
+    (let ((res (file-lock port-or-fd mode)))
+      (cond
+       (res)
+       ((memv (errno) '(11 35)) (thread-sleep! 0.01) (lp))
+       (else (error "couldn't lock file" (integer->error-string)))))))
+
+(define (call-with-locked-file path proc . o)
+  (let ((fd (open path open/read-write (if (pair? o) (car o) #o644))))
+    (file-lock-loop fd (+ lock/exclusive lock/non-blocking))
+    (exception-protect (proc fd) (file-lock fd lock/unlock))))
+
+;; Rewrites file in place with the result of (proc orig-contents),
+;; synchronized with file-lock.
+(define (synchronized-rewrite-text-file path proc . o)
+  (cond
+   ((file-exists? path)
+    (call-with-locked-file
+     path
+     (lambda (fd)
+       (let* ((str (port->string (open-input-file-descriptor fd)))
+              (res (proc str))
+              (out (open-output-file-descriptor fd)))
+         (set-file-position! out seek/set 0)
+         (display res out)
+         (file-truncate out (string-size res))
+         (close-output-port out)
+         res))))
+   (else
+    (call-with-output-file path
+      (lambda (out) (display (proc (if (pair? o) (car o) "")) out))))))
+
+(define (synchronized-rewrite-sexp-file path proc . o)
+  (apply synchronized-rewrite-text-file
+         path
+         (lambda (str)
+           (let ((x (call-with-input-string str read)))
+             (call-with-output-string
+               (lambda (out) (write-simple-pretty (proc x) out)))))
+         o))
+
+(define (current-repo cfg)
+  (call-with-input-file (static-local-path cfg "repo.scm") read))
+
+(define (rewrite-repo cfg proc)
+  (synchronized-rewrite-sexp-file
+   (static-local-path cfg "repo.scm")
+   proc
+   "(repository)"))
+
+(define (update-repo cfg rem-pred value)
+  (rewrite-repo
+   cfg
+   (lambda (repo)
+     `(,(car repo) ,value ,@(remove rem-pred (cdr repo))))))
+
+(define (update-repo-object cfg key-field value)
+  (let* ((type (car value))
+         (key-value (assoc-get (cdr value) key-field eq?))
+         (pred
+          (lambda (x)
+            (and (pair? x)
+                 (eq? type (car x))
+                 (equal? key-value (assoc-get (cdr x) key-field eq?))))))
+    (update-repo cfg pred value)))
+
+(define (update-repo-package cfg pkg)
+  (let* ((email (package-email pkg))
+         (auth-pred (lambda (x) (equal? email (package-email x))))
+         (pkg-pred
+          (cond
+           ((package-name pkg)
+            => (lambda (name)
+                 (lambda (x) (equal? name (package-name x)))))
+           (else
+            (let ((libs (map (lambda (x) (assoc-get (cdr x) 'name eq?))
+                             (package-libraries pkg))))
+              (lambda (x)
+                (every (lambda (y)
+                         (member (assoc-get (cdr x) 'name eq?) libs))
+                       (package-libraries x)))))))
+         (rem-pred
+          (lambda (x)
+            (and (pair? x) (eq? 'package (car x))
+                 (auth-pred x) (pkg-pred x)))))
+    (update-repo cfg rem-pred pkg)))
+
+(define (fail msg . args)
+  `(span (@ (style . "background:red")) ,msg ,@args))
+
+(define (page body)
+  `(html
+    (head
+     (title "Snow")
+     (link (@ (type . "text/css")
+              (rel . "stylesheet")
+              (href . "/s/snow.css")))
+     (link (@ (rel . "shortcut icon")
+              (href . "/s/favicon.ico"))))
+    (body
+     (div (@ (id . "head"))
+          (div (@ (id . "head_pic")) "☃")
+          (div (@ (id . "head_name")) (b "Snow")))
+     (div (@ (id . "toolbar"))
+          (nav (@ (id . "menu"))
+               (a (@ (href . "/")) "Home")
+               (a (@ (href . "/pkg")) "Libraries")
+               (a (@ (href . "/doc")) "Docs")
+               (a (@ (href . "/link")) "Resources")
+               (a (@ (href . "/faq")) "FAQ"))
+          (div (@ (id . "search"))
+               (form
+                 (@ (action . "http://www.google.com/search"))
+                 (input (@ (type . "text") (name . "q")))
+                 (input (@ (type . "hidden")
+                           (name . "domains")
+                           (value . "snow-fort.org")))
+                 (input (@ (type . "hidden")
+                           (name . "sitesearch")
+                           (value . "snow-fort.org")))
+                 (input (@ (type . "submit")
+                           (name . "search")
+                           (value . "Search Libraries"))))))
+     ,body)))
+
+(define (respond cfg request proc)
+  (let ((sexp? (equal? "sexp" (request-param request "fmt"))))
+    (servlet-write
+     request
+     (if sexp?
+         (call-with-current-continuation proc)
+         (sxml->xml (proc (lambda (x) x)))))
+    (if sexp? (servlet-write request "\n"))))
diff --git a/lib/chibi/snow/fort.sld b/lib/chibi/snow/fort.sld
new file mode 100644
index 00000000..470f9608
--- /dev/null
+++ b/lib/chibi/snow/fort.sld
@@ -0,0 +1,71 @@
+;; utilities for the snow repo server
+
+(define-library (chibi snow fort)
+  (export fail page respond static-url static-local-path
+          escape-path email->path maybe-parse-hex
+          valid-email? valid-package?
+          extract-snowball-package package-dir
+          invalid-signature-reason
+          rewrite-repo update-repo
+          update-repo-package update-repo-object
+          repo-publishers current-repo get-user-password)
+  (import (scheme base)
+          (scheme read)
+          (scheme write)
+          (scheme file)
+          (srfi 1)
+          (srfi 18)
+          (srfi 33)
+          (chibi snow package)
+          (chibi bytevector)
+          (chibi config)
+          (chibi crypto rsa)
+          (chibi filesystem)
+          (chibi io)
+          (chibi log)
+          (chibi net servlet)
+          (chibi pathname)
+          (chibi regexp)
+          (chibi string)
+          (chibi sxml)
+          (chibi tar))
+  (cond-expand
+   (chibi
+    (import (only (chibi ast)
+                  errno integer->error-string)
+            (only (chibi)
+                  string-size exception-protect
+                  call-with-input-string call-with-output-string)))
+   (else
+    (begin
+      (define (errno) 0)
+      (define (integer->error-string n)
+        (string-append "errno: " (number->string n)))
+      (define string-size string-length)
+      (define (call-with-input-string str proc)
+        (let* ((in (open-input-string str))
+               (res (proc in)))
+          (close-input-port in)
+          res))
+      (define (call-with-output-string proc)
+        (let ((out (open-output-string)))
+          (proc out)
+          (let ((res (get-output-string out)))
+            (close-output-port out)
+            res)))
+      (define (with-exception-protect thunk final)
+        (let* ((finalized? #f)
+               (run-finalize
+                (lambda ()
+                  (cond ((not finalized?)
+                         (set! finalized? #t)
+                         (final))))))
+          (guard (exn (else (run-finalize) (raise exn)))
+            (let ((res (thunk)))
+              (run-finalize)
+              res))))
+      (define-syntax exception-protect
+        (syntax-rules ()
+          ((exception-protect expr final)
+           (with-exception-protect (lambda () expr)  (lambda () final))))))))
+  (include "fort.scm"))
diff --git a/lib/chibi/snow/interface.scm b/lib/chibi/snow/interface.scm
new file mode 100644
index 00000000..d0c45054
--- /dev/null
+++ b/lib/chibi/snow/interface.scm
@@ -0,0 +1,122 @@
+
+;; Abstract user interface for the snow command.  This could be
+;; substituted with a different implementation to provide a GUI.
+
+(define (message . args)
+  (for-each display args)
+  (newline))
+
+(define (info . args)
+  (apply message args))
+
+(define (warn msg . args)
+  (let ((err (current-error-port)))
+    (display "WARNING: " err)
+    (display msg err)
+    (display ": " err)
+    (if (and (pair? args) (null? (cdr args)))
+        (write (car args) err)
+        (for-each (lambda (x) (display "\n  " err) (write x err)) args))
+    (newline err)))
+
+(define (die x . args)
+  (let ((n (if (number? x) x 2))
+        (args (if (number? x) args (cons x args)))
+        (err (current-error-port)))
+    (for-each (lambda (x) (display x err)) args)
+    (newline err)
+    (exit n)))
+
+(define input-history #f)
+
+(define (conf-input-history-file cfg)
+  (or (conf-get cfg 'input-history)
+      (string-append (or (conf-get cfg 'snow-dir)
+                         (string-append (get-environment-variable "HOME")
+                                        "/.snow"))
+                     "/input-history.scm")))
+
+(define (restore-history cfg)
+  (let ((history-file (conf-input-history-file cfg)))
+    (set! input-history
+          (or (guard (exn (else #f))
+                (list->history (call-with-input-file history-file read)))
+              (make-history)))))
+
+(define (save-history cfg)
+  (let ((history-file (conf-input-history-file cfg)))
+    (guard (exn (else (warn "couldn't save history to " history-file)))
+      (call-with-output-file history-file
+        (lambda (out)
+          (write (remove (lambda (x) (equal? x ""))
+                         (history->list input-history))
+                 out))))))
+
+(define (input cfg name prompt . o)
+  (let ((proc (or (and (pair? o) (car o)) (lambda (x) x)))
+        (check (or (and (pair? o) (pair? (cdr o)) (cadr o))
+                   (lambda (str res lp) res))))
+    (let lp ((reason #f))
+      (cond
+       ((and (not reason) (conf-get cfg name))
+        => (lambda (res) (check "" res lp)))
+       (else
+        (if reason
+            (show #t reason fl))
+        (let ((str (edit-line 'prompt: (lambda () (show #f prompt))
+                              'history: input-history)))
+          (history-insert! input-history str)
+          (check str (proc str) lp)))))))
+
+(define (input-hidden prompt)
+  (show #t prompt)
+  (flush-output-port)
+  (let ((res (with-stty '(not echo) (lambda () (read-line)))))
+    (show #t "\n")
+    res))
+
+(define (input-password cfg name prompt1 . o)
+  (let ((prompt2 (or (and (pair? o) (car o))
+                     (string-append prompt1 " (confirmation): "))))
+    (let lp ()
+      (let ((password (input-hidden prompt1)))
+        (cond
+         ((equal? password "")
+          (show #t "password must be non-empty\n")
+          (lp))
+         (else
+          (let ((conf (input-hidden prompt2)))
+            (cond
+             ((not (equal? password conf))
+              (show #t "password didn't match\n")
+              (lp))
+             (else
+              password)))))))))
+
+(define (input-number cfg name prompt . o)
+  (let* ((default (and (pair? o) (car o)))
+         (lo (and (pair? o) (pair? (cdr o)) (cadr o)))
+         (hi (and (pair? o) (pair? (cdr o)) (pair? (cddr o)) (car (cddr o))))
+         (prompt
+          (if default (each prompt " [default=" default "]: ") prompt))
+         (proc (lambda (str)
+                 (if (and default (equal? str ""))
+                     default
+                     (string->number str))))
+         (check
+          (lambda (str res fail)
+            (cond
+             ((not (number? res))
+              (fail "not a valid number"))
+             ((and lo (< res lo))
+              (fail (each "too low, must be greater than " lo)))
+             ((and hi (> res hi))
+              (fail (each "too high, must be less than " hi)))
+             (else
+              res)))))
+    (input cfg name prompt proc check)))
+
+(define (yes-or-no? cfg . prompt)
+  (define (is-true? str)
+    (and (member (string-downcase str) '("#t" "y" "yes")) #t))
+  (input cfg 'always-yes? (each (each-in-list prompt) " [y/n]: ") is-true?))
diff --git a/lib/chibi/snow/interface.sld b/lib/chibi/snow/interface.sld
new file mode 100644
index 00000000..ed353f50
--- /dev/null
+++ b/lib/chibi/snow/interface.sld
@@ -0,0 +1,8 @@
+
+(define-library (chibi snow interface)
+  (export warn info message die input input-password input-number yes-or-no?
+          restore-history save-history)
+  (import (scheme base) (scheme char) (scheme read) (scheme write)
+          (scheme file) (scheme process-context) (srfi 1)
+          (chibi config) (chibi show) (chibi stty) (chibi term edit-line))
+  (include "interface.scm"))
diff --git a/lib/chibi/snow/package.scm b/lib/chibi/snow/package.scm
new file mode 100644
index 00000000..12c7064b
--- /dev/null
+++ b/lib/chibi/snow/package.scm
@@ -0,0 +1,369 @@
+
+;; general utils
+
+(define (read-from-string str)
+  (call-with-input-string str read))
+
+(define (display-to-string x)
+  (cond ((string? x) x)
+        ((symbol? x) (symbol->string x))
+        ((number? x) (number->string x))
+        (else (call-with-output-string (lambda (out) (display x out))))))
+
+(define (maybe-parse-hex x)
+  (if (string? x) (hex-string->bytevector x) x))
+
+;; rsa key utils
+
+(define (lookup-digest name)
+  (case name
+    ((md5) md5)
+    ((sha-224) sha-224)
+    ((sha-256) sha-256)
+    (else (error "unknown digest: " name))))
+
+(define (rsa-identity=? email)
+  (lambda (x)
+    (cond ((not email) #f)
+          ((assoc-get x 'email eq?)
+           => (lambda (e) (string-ci=? email e)))
+          (else #f))))
+
+(define (extract-rsa-key ls name)
+  (define (hex x)
+    (if (integer? x) x (string->number x 16)))
+  (cond
+   ((assq name ls)
+    => (lambda (x)
+         (let ((bits (assoc-get ls 'bits))
+               (modulus (assoc-get (cdr x) 'modulus))
+               (exponent (assoc-get (cdr x) 'exponent)))
+           (and bits modulus exponent
+                (if (eq? name 'private-key)
+                    (make-rsa-key (hex bits) (hex modulus) #f (hex exponent))
+                    (make-rsa-key (hex bits) (hex modulus)
+                                  (hex exponent) #f))))))
+   (else #f)))
+
+(define (extract-rsa-private-key ls)
+  (extract-rsa-key ls 'private-key))
+
+(define (extract-rsa-public-key ls)
+  (extract-rsa-key ls 'public-key))
+
+;; repositories
+
+(define (repo-url repo)
+  (and (pair? repo) (assoc-get (cdr repo) 'url eq?)))
+
+(define (repo-find-publisher repo email)
+  (find (rsa-identity=? email)
+        (filter (lambda (x) (and (pair? x) (eq? 'publisher (car x))))
+                (cdr repo))))
+
+;; packages
+
+(define (package? x)
+  (and (pair? x) (eq? 'package (car x)) (every pair? (cdr x))))
+
+(define (package-name package)
+  (and (pair? package)
+       (eq? 'package (car package))
+       (cond ((assoc-get (cdr package) 'name)
+              => (lambda (x) (and (pair? x) x)))
+             ((assq 'library (cdr package))
+              => (lambda (x) (library-name x)))
+             ((assq 'progam (cdr package))
+              => (lambda (x) (program-name x)))
+             (else #f))))
+
+(define (package-email pkg)
+  (and (package? pkg)
+       (let ((sig (assq 'signature (cdr pkg))))
+         (and (pair? sig)
+              (assoc-get (cdr sig) 'email eq?)))))
+
+(define (package-author repo pkg . o)
+  (and (package? pkg)
+       (let ((email (package-email pkg))
+             (show-email? (and (pair? o) (car o))))
+         (or (cond
+              ((repo-find-publisher repo email)
+               => (lambda (pub)
+                    (let ((name (assoc-get pub 'name)))
+                      (if (and name show-email?)
+                          (string-append name " <" (or email "") ">")
+                          (or name email "")))))
+              (else #f))
+             email))))
+
+(define (package-url repo pkg)
+  (let ((url (and (pair? pkg) (assoc-get (cdr pkg) 'url eq?))))
+    (and url
+         (uri-resolve url (string->path-uri 'http (repo-url repo))))))
+
+(define (package-version pkg)
+  (and (pair? pkg) (assoc-get (cdr pkg) 'version eq?)))
+
+(define (package-digest-mismatches cfg pkg raw)
+  (let ((size (assoc-get (cdr pkg) 'size))
+        (actual-size (bytevector-length raw)))
+    (if (and (integer? size) (not (= size actual-size)))
+        `(size: expected: ,size actual: ,actual-size)
+        (let* ((digest-name (assoc-get (cdr pkg) 'digest #f 'sha-256))
+               (digest (assoc-get (cdr pkg) digest-name))
+               (actual-digest ((lookup-digest digest-name) raw)))
+          (and digest
+               (not (equal? digest actual-digest))
+               `(digest: ,digest-name expected: ,digest
+                         actual: ,actual-digest))))))
+
+(define (package-digest-ok? cfg pkg raw)
+  (not (package-digest-mismatches cfg pkg raw)))
+
+(define (package-signature-mismatches repo cfg pkg raw)
+  (let* ((sig-spec (assoc-get-list (cdr pkg) 'signature))
+         (digest-name (assoc-get sig-spec 'digest #f 'sha-256))
+         (digest (assoc-get sig-spec digest-name))
+         (sig (assoc-get sig-spec 'rsa))
+         (email (assoc-get sig-spec 'email))
+         (rsa-key-sexp (repo-find-publisher repo email))
+         (rsa-key (and (pair? rsa-key-sexp)
+                       (extract-rsa-public-key (cdr rsa-key-sexp)))))
+    (cond
+     ((not email)
+      `(sign: missing-email ,sig-spec))
+     ((not rsa-key)
+      `(sign: unknown-publisher: ,email))
+     ((not (rsa-verify? rsa-key
+                        (maybe-parse-hex digest)
+                        (maybe-parse-hex sig)))
+      `(sign: rsa-signature-invalid: digest: ,digest sig: ,sig
+              actual: ,(rsa-verify rsa-key (maybe-parse-hex digest))))
+     (else #f))))
+
+(define (package-signature-ok? cfg pkg raw)
+  (not (package-signature-mismatches cfg pkg raw)))
+
+(define (failure str . args)
+  (let ((out (open-output-string)))
+    (display str out)
+    (cond
+     ((pair? args)
+      (display ":" out)
+      (for-each (lambda (x) (display " " out) (write x out)) args)))
+    (get-output-string out)))
+
+(define (invalid-library-reason lib)
+  (cond
+   ((not (list? lib)) "library must be a list")
+   ((not (list? (library-name lib)))
+    (failure "library name must be a list" (library-name lib)))
+   ((not (every (lambda (x) (or (symbol? x) (integer? x))) (library-name lib)))
+    (failure "library name must contain only symbols or integers"
+             (library-name lib)))
+   (else #f)))
+
+(define (valid-library? lib)
+  (not (invalid-library-reason lib)))
+
+(define (invalid-package-reason pkg)
+  (cond
+   ((not (list? pkg))
+    "package must be a list")
+   ((not (string? (package-version pkg)))
+    (failure "package-version is not a string" (package-version pkg)))
+   (else
+    (let ((libs (package-libraries pkg)))
+      (cond
+       ((not (pair? libs)) "package must contain at least one library")
+       ((any invalid-library-reason libs))
+       (else #f))))))
+
+(define (valid-package? pkg)
+  (not (invalid-package-reason pkg)))
+
+(define (package-libraries package)
+  (and (package? package) (filter library? (cdr package))))
+
+(define (package-programs package)
+  (and (package? package) (filter program? (cdr package))))
+
+(define (package-provides? package name)
+  (and (pair? package)
+       (eq? 'package (car package))
+       (or (equal? name (assoc-get (cdr package) 'name))
+           (find (lambda (x) (equal? name (library-name x)))
+                 (package-libraries package)))))
+
+(define (package-dependencies impl cfg package)
+  (append-map (lambda (lib) (library-dependencies cfg impl lib))
+              (package-libraries package)))
+
+(define (package-installed-files pkg)
+  (or (and (pair? pkg) (assoc-get-list (cdr pkg) 'installed-files)) '()))
+
+(define (library-name->path name)
+  (if (null? name)
+      ""
+      (call-with-output-string
+        (lambda (out)
+          (let lp ((name name))
+            (display (car name) out)
+            (cond ((pair? (cdr name))
+                   (write-char #\/ out)
+                   (lp (cdr name)))))))))
+
+;; map a library to the path name it would be found in (sans extension)
+(define (library->path library)
+  (library-name->path (library-name library)))
+
+;; find the library declaration file for the given library
+(define (get-library-file cfg library)
+  (or (assoc-get library 'path)
+      (string-append (library->path library) "."
+                     (conf-get cfg 'library-extension "sld"))))
+
+(define (package->path pkg)
+  (library-name->path (package-name pkg)))
+
+(define (package-name->meta-file cfg name)
+  (let ((path (library-name->path name)))
+    (string-append (path-directory path) "/."
+                   (path-strip-directory path) ".meta")))
+
+(define (get-package-meta-file cfg pkg)
+  (package-name->meta-file cfg (package-name pkg)))
+
+(define (get-library-meta-file cfg lib)
+  (package-name->meta-file cfg (library-name lib)))
+
+;; libraries
+
+(define (library? x)
+  (and (pair? x) (eq? 'library (car x)) (every pair? (cdr x))))
+
+(define (library-name lib)
+  (and (pair? lib) (assoc-get (cdr lib) 'name eq?)))
+
+(define (library-url lib)
+  (and (pair? lib) (assoc-get (cdr lib) 'url eq?)))
+
+(define (library-for-impl impl cfg lib)
+  (append
+   lib
+   (append-map
+    (lambda (x)
+      (or (and (pair? x) (eq? 'cond-expand (car x))
+               (cond
+                ((find
+                  (lambda (clause) (check-cond-expand impl cfg (car clause)))
+                  (cdr x))
+                 => cdr)
+                (else #f)))
+          '()))
+    (cdr lib))))
+
+(define (library-dependencies impl cfg lib)
+  (append-map
+   (lambda (x) (or (and (pair? x) (eq? 'depends (car x)) (cdr x)) '()))
+   (cdr (library-for-impl impl cfg lib))))
+
+(define (parse-library-name str)
+  (cond
+   ((pair? str) str)
+   ((equal? "" str) (error "empty library name"))
+   ((eqv? #\( (string-ref str 0)) (read-from-string str))
+   (else (map (lambda (x) (or (string->number x) (string->symbol x)))
+              (string-split str #\.)))))
+
+(define (check-cond-expand impl config test)
+  (define (library-installed? config name)
+    ;; assume it could be installed for now... this is effectively a
+    ;; "suggested" package rather than a required one
+    #t)
+  (cond
+   ((symbol? test)
+    (or (eq? 'else test) (eq? impl test)
+        (memq test (conf-get-list config 'features))))
+   ((pair? test)
+    (case (car test)
+      ((not) (not (check-cond-expand impl config (cadr test))))
+      ((and) (every (lambda (x) (check-cond-expand impl config x)) (cdr test)))
+      ((or) (any (lambda (x) (check-cond-expand impl config x)) (cdr test)))
+      ((library) (every (lambda (x) (library-installed? config x)) (cdr test)))
+      (else
+       (warn "unknown cond-expand form" test)
+       #f)))
+   (else #f)))
+
+;; We can't use the native library system introspection since we may
+;; be analyzing a library which can't be loaded in the native system.
+(define (library-analyze impl config file)
+  (let ((sexp (call-with-input-file file read)))
+    (and (list? sexp)
+         (memq (car sexp) '(define-library library define-module module))
+         (let analyze ((ls (cddr sexp)))
+           (cond
+            ((null? ls) '())
+            (else
+             (append
+              (case (caar ls)
+                ((cond-expand)
+                 (cond
+                  ((find (lambda (x) (check-cond-expand impl config (car x)))
+                         (cdar ls))
+                   => (lambda (x) (analyze (cdr x))))
+                  (else (analyze (cdr ls)))))
+                (else (list (car ls))))
+              (analyze (cdr ls)))))))))
+
+(define (library-include-files impl config file)
+  (let ((lib (library-analyze impl config file))
+        (dir (path-directory file)))
+    (append-map
+     (lambda (x) (map (lambda (y) (make-path dir y)) (cdr x)))
+     (filter (lambda (x) (and (pair? x) (memq (car x) '(include include-ci))))
+             lib))))
+
+(define (library-rewrite-includes x rules)
+  (define (recurse x) (library-rewrite-includes x rules))
+  (define (rewrite x)
+    (cond ((any (lambda (r) (and (pair? r) (equal? x (car r)))) rules) => cdr)
+          (else x)))
+  (cond
+   ((pair? x)
+    (case (car x)
+      ((include include-ci)
+       (cons (car x) (map rewrite (cdr x))))
+      ((cond-expand)
+       (cons (car x)
+             (map (lambda (y) (cons (car y) (map recurse (cdr y)))) (cdr x))))
+      ((define-library library)
+       (cons (car x) (map recurse (cdr x))))
+      (else x)))
+   (else x)))
+
+;; programs
+
+(define (program? x)
+  (and (pair? x) (eq? 'program (car x)) (every pair? (cdr x))))
+
+(define (program-name prog)
+  (and (pair? prog)
+       (cond ((assoc-get (cdr prog) 'name eq?))
+             ((assoc-get (cdr prog) 'path eq?)
+              => (lambda (p) (list (string->symbol (path-strip-directory p)))))
+             (else #f))))
+
+(define (get-program-file cfg prog)
+  (cond ((assoc-get prog 'path))
+        ((assoc-get prog 'name)
+         => (lambda (name) (library-name->path (last name))))
+        (else (error "program missing path: " prog))))
+
+(define (program-install-name prog)
+  (or (assoc-get (cdr prog) 'install-name eq?)
+      (path-strip-extension
+       (path-strip-directory
+        (assoc-get (cdr prog) 'path eq?)))))
diff --git a/lib/chibi/snow/package.sld b/lib/chibi/snow/package.sld
new file mode 100644
index 00000000..3d0837c7
--- /dev/null
+++ b/lib/chibi/snow/package.sld
@@ -0,0 +1,32 @@
+
+(define-library (chibi snow package)
+  (export package? library? program?
+          package-name package-email package-url package-version
+          package-libraries package-programs
+          package-provides? package-dependencies
+          package-installed-files package-author
+          package-digest-mismatches package-signature-mismatches
+          package-digest-ok? package-signature-ok?
+          package->path package-name->meta-file
+          get-package-meta-file get-library-meta-file
+          library-name->path library->path get-library-file
+          library-url library-name parse-library-name library-name->path
+          library-analyze library-include-files library-dependencies
+          library-rewrite-includes
+          get-program-file program-name program-install-name
+          invalid-package-reason valid-package?
+          invalid-library-reason valid-library?
+          repo-find-publisher lookup-digest rsa-identity=?
+          extract-rsa-private-key extract-rsa-public-key)
+  (import (chibi)
+          (srfi 1)
+          (chibi snow interface)
+          (chibi bytevector)
+          (chibi config)
+          (chibi crypto md5)
+          (chibi crypto rsa)
+          (chibi crypto sha2)
+          (chibi pathname)
+          (chibi string)
+          (chibi uri))
+  (include "package.scm"))
diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm
new file mode 100644
index 00000000..941e8dd0
--- /dev/null
+++ b/lib/chibi/snow/utils.scm
@@ -0,0 +1,53 @@
+
+;;> Copies the file \var{from} to \var{to}.
+
+(define (copy-file from to)
+  (let ((in (open-binary-input-file from))
+        (out (open-binary-output-file to)))
+    (let lp ()
+      (let ((n (read-u8 in)))
+        (cond ((eof-object? n) (close-input-port in) (close-output-port out))
+              (else (write-u8 n out) (lp)))))))
+
+(define (call-with-temp-file template proc)
+  (let ((base (string-append
+               "/tmp/" (path-strip-extension template)
+               "-" (number->string (current-process-id)) "-"
+               (number->string (exact (round (current-second)))) "-"))
+        (ext (or (path-extension template) "tmp")))
+    (let lp ((i 0))
+      (let ((path (string-append base (number->string i) "." ext)))
+        (cond
+         ((> i 100)  ;; give up after too many tries regardless
+          (die 2 "Repeatedly failed to generate temp file in /tmp"))
+         ((file-exists? path)
+          (lp (+ i 1)))
+         (else
+          (let ((fd (open path
+                          (bitwise-ior open/write open/create open/exclusive))))
+            (if (not fd)
+                (if (file-exists? path) ;; created between test and open
+                    (lp (+ i 1))
+                    (die 2 "Couldn't generate temp file in /tmp " path))
+                (let* ((out (open-output-file-descriptor fd #o700))
+                       (res (proc path out)))
+                  (close-output-port out)
+                  (delete-file path)
+                  res)))))))))
+
+(define (call-with-temp-dir template proc)
+  (let ((base (string-append
+               "/tmp/" template
+               "-" (number->string (current-process-id)) "-"
+               (number->string (exact (round (current-second)))) "-")))
+    (let lp ((i 0))
+      (let ((path (string-append base (number->string i))))
+        (cond
+         ((> i 100)  ;; give up after too many tries
+          (die 2 "Repeatedly failed to generate temp dir in /tmp " path))
+         ((file-exists? path)
+          (lp (+ i 1)))
+         ((create-directory path #o700)
+          (let ((res (proc path)))
+            (delete-file-hierarchy path)
+            res)))))))
diff --git a/lib/chibi/snow/utils.sld b/lib/chibi/snow/utils.sld
new file mode 100644
index 00000000..d0d1a262
--- /dev/null
+++ b/lib/chibi/snow/utils.sld
@@ -0,0 +1,12 @@
+
+(define-library (chibi snow utils)
+  (export copy-file call-with-temp-file call-with-temp-dir)
+  (import (scheme base)
+          (scheme file)
+          (scheme time)
+          (srfi 33)
+          (chibi filesystem)
+          (chibi pathname)
+          (chibi process)
+          (chibi snow interface))
+  (include "utils.scm"))
diff --git a/tools/snow-chibi b/tools/snow-chibi
new file mode 100755
index 00000000..0aa7b408
--- /dev/null
+++ b/tools/snow-chibi
@@ -0,0 +1,174 @@
+#!/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")
+    (ignore-signature? boolean ("ignore-sig") "don't verify package signatures")
+    (ignore-digest? boolean ("ignore-digest") "don't verify package checksums")
+    ;;(config filename "path to configuration file")
+    (host string "base uri of snow repository")
+    (repository-uri string "uri of snow repository file")
+    (local-root-repository dirname "repository cache dir for root")
+    (local-user-repository dirname "repository cache dir for non-root users")
+    (install-prefix string "prefix directory for installation")
+    (install-source-dir dirname "directory to install library source in")
+    (library-extension string "the extension to use for library files")
+    (installer symbol "name of installer to use")
+    (implementations (list symbol) "impls to install for, or 'all'")
+    (chibi-path filename "path to chibi-scheme executable")
+    ))
+
+(define (conf-default-path name)
+  (make-path (or (get-environment-variable "HOME") ".")
+             (string-append "." name)
+             "config.scm"))
+
+(define search-spec '())
+(define show-spec '())
+(define install-spec
+  '((show-tests? boolean ("show-tests") "show test output even on success")))
+(define upgrade-spec '())
+(define remove-spec '())
+(define status-spec '())
+(define gen-key-spec
+  '((bits integer)
+    (validity-period string)
+    (name string)
+    (library-prefix (list symbol))
+    (email string)))
+(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
+  '((programs (list existing-filename))
+    (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)
+    (sig-file existing-filename)
+    ))
+(define upload-spec
+  `((uri string)
+    ,@package-spec))
+(define update-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"
+      (@ ,upload-spec) (,command/upload files ...))
+     (update
+      "update available package status"
+      (@ ,update-spec) (,command/update))
+     (help
+      "print help"
+      (,app-help-command args ...))
+     )))
+
+(run-application app-spec
+                 (command-line)
+                 (conf-load (conf-default-path "snow")))