suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco pkg: add support for local package-index databases

Browse Source 
Adds `pkg/pnr-db', `raco pkg index-copy', and `raco pkg index-show'.

Includes tools to build a database of modules that are supplied by
packages, which will be useful for a tool to recommend package
installs when a module is not found.

Also, document `pkg/lib' and add extra helper functions
for getting package information from a package name resolver.
This commit is contained in:
Matthew Flatt 2013-04-12 21:04:47 -06:00
parent 50ade25b28
commit 37aa091e1c
18 changed files with 2395 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

301
collects/pkg/db.rkt Normal file
View File

@ -0,0 +1,301 @@
#lang racket/base
(require racket/contract/base
racket/format
racket/set
db)
(provide
(struct-out pkg)
(contract-out
[current-pkg-index-file
(parameter/c path-string?)]
[get-pnr-urls (-> (listof string?))]
[set-pnr-urls! ((listof string?) . -> . void?)]
[set-pnr-pkgs! (string? (listof string?) . -> . void?)]
[get-pkgs (()
(#:pnr-url (or/c #f string?)
#:name (or/c #f string?))
. ->* .
(listof pkg?))]
[set-pkg! (string? string? string? string? string? string?
. -> .
void?)]
[get-pkg-modules (string? string? string?
. -> . (listof module-path?))]
[set-pkg-modules! (string? string? string?
(listof module-path?)
. -> . void?)]))
(struct pkg (name pnr-url author checksum desc tags)
#:transparent)
(define current-pkg-index-file
(make-parameter (build-path
(find-system-path 'addon-dir)
"pnr.sqlite")))
(define (call-with-pnr-db proc)
(define db #f)
(dynamic-wind
(lambda ()
(set! db (sqlite3-connect #:database (current-pkg-index-file)
#:mode 'create
#:busy-retry-limit +inf.0)))
(lambda () (proc db))
(lambda ()
(disconnect db))))
(define (get-pkgs #:pnr-url [pnr-url #f])
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(for/list ([row (in-list
(apply
query-rows
db
(~a "SELECT K.name, N.url, K.author, K.checksum, K.desc, k.tags"
" FROM pkg K, pnr N"
" WHERE N.id = K.pnr"
(if pnr-url
" AND N.url = $1"
""))
(if pnr-url
(list pnr-url)
null)))])
(pkg (vector-ref row 0)
(vector-ref row 1)
(vector-ref row 2)
(vector-ref row 3)
(vector-ref row 4)
(vector-ref row 5))))))
(define (set-pkg! name pnr-url author checksum desc tags)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db pnr-url))
(query db
(~a "UPDATE pkg"
" SET author=$1, checksum=$2, desc=$3, tags=$4"
" WHERE name=$5"
" AND pnr=$6")
author checksum desc tags
name pnr)
(void))))))
(define (get-pkg-modules name pnr-url checksum)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(define pnr (url->pnr db pnr-url))
(map
string->mod
(query-list db
"SELECT name FROM modules WHERE pnr=$1, pkg=$2, checksum=$3"
pnr
name
checksum)))))
(define (set-pkg-modules! name pnr-url checksum modules)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db pnr-url))
(query-exec db
"DELETE FROM modules WHERE pnr=$1, pkg=$2, checksum=$3"
pnr
name
checksum)
(for ([mod (in-list modules)])
(query db
(~a "INSERT INTO modules"
" VALUES ($1, $2, $3, $4)")
(mod->string mod) name pnr checksum)))))))
(define (string->mod mp) (~s mp))
(define (mod->string str) (read (open-input-string str)))
(define (get-pnr-urls)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(query-list db (~a "SELECT url FROM pnr")))))
(define (set-pnr-urls! urls)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(call-with-transaction
db
(lambda ()
(define current-url+ids
(query-rows db "SELECT url, id FROM pnr"))
(define old-urls (for/list ([old (in-list current-url+ids)])
(vector-ref old 0)))
(for ([old (in-list current-url+ids)])
(define old-url (vector-ref old 0))
(define old-id (vector-ref old 1))
(unless (member old-url urls)
(query-exec db
"DELETE FROM pnr WHERE id=$1"
old-id)
(query-exec db
"DELETE FROM pkg WHERE pnr=$1"
old-id)
(query-exec db
"DELETE FROM modules WHERE pnr=$1"
old-id)))
(for ([new-url (in-list urls)])
(unless (member new-url old-urls)
(let loop ([id 0])
(if (query-maybe-row db
"SELECT url FROM pnr WHERE id=$1"
id)
(loop (add1 id))
(query-exec db "INSERT INTO pnr VALUES ($1, $2)"
id
new-url))))))))))
(define (url->pnr db url)
(query-value db
"SELECT id FROM pnr WHERE url=$1"
url))
(define (set-pnr-pkgs! url pkgs)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db url))
(define current-pkgs
(query-list db "SELECT name FROM pkg WHERE pnr=$1"
pnr))
(define new-pkgs (list->set pkgs))
(define old-pkgs (list->set current-pkgs))
(for ([old (in-list current-pkgs)])
(unless (set-member? new-pkgs old)
(query-exec db
"DELETE FROM pkg WHERE pnr=$1, name=$2"
pnr
old)
(query-exec db
"DELETE FROM modules WHERE pnr=$1, pkg=$2"
pnr
old)))
(for ([new (in-list pkgs)])
(unless (set-member? old-pkgs new)
(query-exec db
"INSERT INTO pkg VALUES ($1, $2, $3, $4, $5, $6)"
new
pnr
""
""
""
""))))))))
(define (prepare-pnr-table db)
(prepare-table db
"pnr"
(~a "(id SMALLINT,"
" url VARCHAR(1024))")))
(define (prepare-pkg-table db)
(prepare-table db
"pkg"
(~a "(name VARCHAR(1024),"
" pnr SMALLINT,"
" author VARCHAR(256),"
" checksum VARCHAR(256),"
" desc VARCHAR(4096),"
" tags VARCHAR(1024))")))
(define (prepare-modules-table db)
(prepare-table db
"modules"
(~a "(name VARCHAR(1024),"
" pkg VARCHAR(1024),"
" pnr SMALLINT,"
" checksum VARCHAR(256))")))
(define (prepare-table db which desc)
(when (null?
(query-rows db (~a "SELECT name FROM sqlite_master"
" WHERE type='table' AND name='" which "'")))
(query-exec db (~a "CREATE TABLE " which " "
desc))))
;; ----------------------------------------
(module+ main
(require rackunit
racket/file)
(define (pkg<? a b)
(if (string=? (pkg-name a) (pkg-name b))
(string<? (pkg-pnr-url a) (pkg-pnr-url b))
(string<? (pkg-name a) (pkg-name b))))
(parameterize ([current-pkg-index-file (make-temporary-file
"~a.sqlite")])
(check-equal? (get-pnr-urls) '())
(set-pnr-urls! '("http://a" "http://b"))
(check-equal? (sort (get-pnr-urls) string<?)
'("http://a" "http://b"))
(check-equal? (get-pkgs) '())
(set-pnr-pkgs! "http://a" '("p1"))
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "" "" "" "")))
(set-pnr-pkgs! "http://b" '("p2"))
(check-equal? (sort (get-pkgs) pkg<?)
(list
(pkg "p1" "http://a" "" "" "" "")
(pkg "p2" "http://b" "" "" "" "")))
(check-equal? (get-pkgs #:pnr-url "http://a")
(list
(pkg "p1" "http://a" "" "" "" "")))
(set-pkg! "p1" "http://a" "adam" "123" "the first package" "good")
(check-equal? (sort (get-pkgs) pkg<?)
(list
(pkg "p1" "http://a" "adam" "123" "the first package" "good")
(pkg "p2" "http://b" "" "" "" "")))
(set-pnr-urls! '("http://a" "http://c"))
(check-equal? (sort (get-pnr-urls) string<?)
'("http://a" "http://c"))
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "adam" "123" "the first package" "good")))
(delete-file (current-pkg-index-file))
(void)))

980
collects/pkg/lib.rkt
View File

File diff suppressed because it is too large Load Diff

45
collects/pkg/main.rkt
View File

@ -1,7 +1,9 @@
#lang racket/base
(require (only-in racket/base [version r:version])
racket/function
racket/list
raco/command-name
net/url
"lib.rkt"
"commands.rkt"
(prefix-in setup: setup/setup))
@ -115,14 +117,14 @@
[#:bool installation ("-i") "shorthand for `--scope installation'"]
[#:bool user ("-u") "shorthand for `--scope user'"]
[#:bool shared ("-s") "shorthand for `--scope shared'"]
#:args pkgs
#:args pkg
(call-with-package-scope
'update
scope installation shared user
(lambda ()
(with-package-lock
(define setup-collects
(update-packages pkgs
(update-packages pkg
#:all? all
#:dep-behavior deps
#:deps? update-deps))
@ -144,13 +146,13 @@
[#:bool installation ("-i") "shorthand for `--scope installation'"]
[#:bool user ("-u") "shorthand for `--scope user'"]
[#:bool shared ("-s") "shorthand for `--scope shared'"]
#:args pkgs
#:args pkg
(call-with-package-scope
'remove
scope installation shared user
(lambda ()
(with-package-lock
(remove-packages pkgs
(remove-packages pkg
#:auto? auto
#:force? force)
(setup no-setup #f))))]
@ -225,4 +227,37 @@
[#:bool manifest () "Creates a manifest file for a directory, rather than an archive"]
#:args (package-directory)
(parameterize ([current-pkg-error (pkg-error 'create)])
(create-cmd (if manifest 'MANIFEST (or format 'zip)) package-directory))])
(create-cmd (if manifest 'MANIFEST (or format 'zip)) package-directory))]
[index-show
"Show information about packages as reported by index"
#:once-any
[(#:str index #f) index () "Use <index> instead of configured indexes"]
#:once-each
[#:bool all () "Show all packages"]
[#:bool only-names () "Show only package names"]
#:args pkg-name
(when (and all (pair? pkg-name))
((pkg-error 'index-show) "both `--all' and package names provided"))
(parameterize ([current-pkg-indexes (and index
(list (string->url index)))]
[current-pkg-error (pkg-error 'index-show)])
(index-show-cmd pkg-name
#:all? all
#:only-names? only-names))]
[index-copy
"Copy/merge package name resolver information"
#:once-each
[#:bool from-config () "Include currently configured packages last"]
#:once-any
[#:bool force () "Force replacement fo existing file/directory"]
[#:bool merge () "Merge to existing database"]
#:once-each
[#:bool override () "While merging, override existing with new"]
#:args index
(parameterize ([current-pkg-error (pkg-error 'index-copy)])
(index-copy-cmd (drop-right index 1)
(last index)
#:from-config? from-config
#:force? force
#:merge? merge
#:override? override))])

454
collects/pkg/pnr-db.rkt Normal file
View File

@ -0,0 +1,454 @@
#lang racket/base
(require racket/contract/base
racket/format
racket/set
db)
(provide
(struct-out pkg)
(contract-out
[current-pkg-index-file
(parameter/c path-string?)]
[get-indexes (-> (listof string?))]
[set-indexes! ((listof string?) . -> . void?)]
[set-pkgs! (string? (listof (or/c pkg? string?)) . -> . void?)]
[get-pkgs (()
(#:name (or/c #f string?)
#:index (or/c #f string?))
. ->* .
(listof pkg?))]
[set-pkg! (string? string? string? string? string? string?
. -> .
void?)]
[get-pkg-modules (string? string? string?
. -> . (listof module-path?))]
[set-pkg-modules! (string? string? string?
(listof module-path?)
. -> . void?)]
[get-pkg-tags (string? string?
. -> . (listof string?))]
[set-pkg-tags! (string? string? (listof string?)
. -> . void?)]
[get-module-pkgs (module-path? . -> . pkg?)]))
(struct pkg (name index author source checksum desc)
#:transparent)
(define (prepare-pnr-table db)
(prepare-table db
"pnr"
(~a "(id SMALLINT,"
" url TEXT,"
" pos SMALLINT)")))
(define (prepare-pkg-table db)
(prepare-table db
"pkg"
(~a "(name TEXT,"
" pnr SMALLINT,"
" author TEXT,"
" source TEXT,"
" checksum TEXT,"
" desc TEXT)")))
(define (prepare-tags-table db)
(prepare-table db
"tags"
(~a "(pkg TEXT,"
" pnr TEXT,"
" tag TEXT)")))
(define (prepare-modules-table db)
(prepare-table db
"modules"
(~a "(name TEXT,"
" pkg TEXT,"
" pnr SMALLINT,"
" checksum TEXT)")))
(define current-pkg-index-file
(make-parameter (build-path
(find-system-path 'addon-dir)
(version)
"pnr.sqlite")))
(define (call-with-pnr-db proc)
(define db #f)
(dynamic-wind
(lambda ()
(set! db (sqlite3-connect #:database (current-pkg-index-file)
#:mode 'create
#:busy-retry-limit +inf.0)))
(lambda () (proc db))
(lambda ()
(disconnect db))))
(define (get-pkgs #:name [name #f]
#:index [index #f])
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(for/list ([row (in-list
(apply
query-rows
db
(~a "SELECT K.name, N.url, K.author, K.source, K.checksum, K.desc"
" FROM pkg K, pnr N"
" WHERE N.id = K.pnr"
(if index
" AND N.url = $1"
"")
(if name
(~a " AND K.name = "
(if index "$2" "$1"))
"")
" ORDER BY N.pos")
(append
(if index
(list index)
null)
(if name
(list name)
null))))])
(pkg (vector-ref row 0)
(vector-ref row 1)
(vector-ref row 2)
(vector-ref row 3)
(vector-ref row 4)
(vector-ref row 5))))))
(define (set-pkg! name index author source checksum desc)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db index))
(query db
(~a "UPDATE pkg"
" SET author=$1, source=$2, checksum=$3, desc=$4"
" WHERE name=$5"
" AND pnr=$6")
author source checksum desc
name pnr)
(void))))))
(define (get-pkg-tags name index)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-tags-table db)
(define pnr (url->pnr db index))
(query-list db
(~a "SELECT tag FROM tags"
" WHERE pnr=$1"
" AND pkg=$2")
pnr
name))))
(define (set-pkg-tags! name index tags)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-tags-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db index))
(query-exec db
(~a "DELETE FROM tags"
" WHERE pnr=$1"
" AND pkg=$2")
pnr
name)
(for ([tag (in-list tags)])
(query db
(~a "INSERT INTO tags"
" VALUES ($1, $2, $3)")
name pnr tag)))))))
(define (get-pkg-modules name index checksum)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(define pnr (url->pnr db index))
(map
string->mod
(query-list db
(~a "SELECT name FROM modules"
" WHERE pnr=$1"
" AND pkg=$2"
" AND checksum=$3")
pnr
name
checksum)))))
(define (set-pkg-modules! name index checksum modules)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db index))
(query-exec db
(~a "DELETE FROM modules"
" WHERE pnr=$1"
" AND pkg=$2"
" AND checksum=$3")
pnr
name
checksum)
(for ([mod (in-list modules)])
(query db
(~a "INSERT INTO modules"
" VALUES ($1, $2, $3, $4)")
(mod->string mod) name pnr checksum)))))))
(define (get-module-pkgs mod)
(call-with-pnr-db
(lambda (db)
(define rows
(query-rows db
(~a "SELECT M.pkg, P.url, M.checksum"
" FROM modules M, pnr P"
" WHERE M.name = $1"
" AND M.pnr = P.id")
(mod->string mod)))
(for/list ([row (in-list rows)])
(pkg (vector-ref row 0)
(vector-ref row 1)
""
""
(vector-ref row 2)
"")))))
(define (mod->string mp) (~s mp))
(define (string->mod str) (read (open-input-string str)))
(define (get-indexes)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(query-list db (~a "SELECT url FROM pnr"
" ORDER BY pos")))))
(define (set-indexes! urls)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-tags-table db)
(prepare-modules-table db)
(call-with-transaction
db
(lambda ()
(define current-url+ids
(query-rows db "SELECT url, id FROM pnr"))
(define old-urls (for/list ([old (in-list current-url+ids)])
(vector-ref old 0)))
(for ([old (in-list current-url+ids)])
(define old-url (vector-ref old 0))
(define old-id (vector-ref old 1))
(unless (member old-url urls)
(query-exec db
"DELETE FROM pnr WHERE id=$1"
old-id)
(query-exec db
"DELETE FROM pkg WHERE pnr=$1"
old-id)
(query-exec db
"DELETE FROM tags WHERE pnr=$1"
old-id)
(query-exec db
"DELETE FROM modules WHERE pnr=$1"
old-id)))
(for ([new-url (in-list urls)])
(unless (member new-url old-urls)
(let loop ([id 0])
(if (query-maybe-row db
"SELECT url FROM pnr WHERE id=$1"
id)
(loop (add1 id))
(query-exec db "INSERT INTO pnr VALUES ($1, $2, 0)"
id
new-url)))))
(for ([new-url (in-list urls)]
[pos (in-naturals)])
(query-exec db (~a "UPDATE pnr"
" SET pos = $1"
" WHERE url = $2")
pos
new-url)))))))
(define (url->pnr db url)
(query-value db
"SELECT id FROM pnr WHERE url=$1"
url))
(define (set-pkgs! url pkgs)
(call-with-pnr-db
(lambda (db)
(prepare-pnr-table db)
(prepare-pkg-table db)
(prepare-modules-table db)
(call-with-transaction
db
(lambda ()
(define pnr (url->pnr db url))
(define pkg-names (for/list ([p (in-list pkgs)])
(if (pkg? p)
(pkg-name p)
p)))
(define current-pkgs
(query-list db "SELECT name FROM pkg WHERE pnr=$1"
pnr))
(define new-pkgs (list->set pkg-names))
(define old-pkgs (list->set current-pkgs))
(for ([old (in-list current-pkgs)])
(unless (set-member? new-pkgs old)
(query-exec db
"DELETE FROM pkg WHERE pnr=$1, name=$2"
pnr
old)
(query-exec db
"DELETE FROM tags WHERE pnr=$1, pkg=$2"
pnr
old)
(query-exec db
"DELETE FROM modules WHERE pnr=$1, pkg=$2"
pnr
old)))
(for ([new0 (in-list pkgs)])
(define new (if (pkg? new0)
new0
(pkg new0 "" "" "" "" "")))
(unless (and (string? new0)
(set-member? old-pkgs new0))
(if (set-member? old-pkgs (pkg-name new))
(query-exec db
(~a "UPDATE pkg"
" SET author=$1, source=$2, checksum=$3, desc=$4"
" WHERE name=$5"
" AND pnr=$6")
(pkg-author new)
(pkg-source new)
(pkg-checksum new)
(pkg-desc new)
(pkg-name new)
pnr)
(query-exec db
"INSERT INTO pkg VALUES ($1, $2, $3, $4, $5, $6)"
(pkg-name new)
pnr
(pkg-author new)
(pkg-source new)
(pkg-checksum new)
(pkg-desc new))))))))))
(define (prepare-table db which desc)
(when (null?
(query-rows db (~a "SELECT name FROM sqlite_master"
" WHERE type='table' AND name='" which "'")))
(query-exec db (~a "CREATE TABLE " which " "
desc))))
;; ----------------------------------------
(module+ main
(require rackunit
racket/file)
(define (pkg<? a b)
(if (string=? (pkg-name a) (pkg-name b))
(string<? (pkg-index a) (pkg-index b))
(string<? (pkg-name a) (pkg-name b))))
(parameterize ([current-pkg-index-file (make-temporary-file
"~a.sqlite")])
(check-equal? (get-indexes) '())
(set-indexes! '("http://a" "http://b"))
(check-equal? (get-indexes)
'("http://a" "http://b"))
(check-equal? (get-pkgs) '())
(set-pkgs! "http://a" '("p1"))
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "" "" "" "")))
(set-pkgs! "http://b" '("p2"))
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "" "" "" "")
(pkg "p2" "http://b" "" "" "" "")))
(check-equal? (get-pkgs #:index "http://a")
(list
(pkg "p1" "http://a" "" "" "" "")))
(check-equal? (get-pkgs #:name "p1")
(list
(pkg "p1" "http://a" "" "" "" "")))
(set-pkg! "p1" "http://a" "github:a" "adam" "123" "the first package")
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "github:a" "adam" "123" "the first package")
(pkg "p2" "http://b" "" "" "" "")))
;; reverse order of indexes:
(set-indexes! '("http://b" "http://a"))
(check-equal? (get-indexes)
'("http://b" "http://a"))
(check-equal? (get-pkgs)
(list
(pkg "p2" "http://b" "" "" "" "")
(pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))
(check-equal? (get-pkg-tags "p2" "http://b")
'())
(set-pkg-tags! "p2" "http://b" '("2x" "2y" "2z"))
(check-equal? (sort (get-pkg-tags "p2" "http://b") string<?)
'("2x" "2y" "2z"))
(check-equal? (get-pkg-tags "p1" "http://a")
'())
(set-pkg-modules! "p1" "http://a" "123" (list '(lib "lib1/main.rkt")
'(lib "lib2/main.rkt")))
(check-equal? (sort (get-pkg-modules "p1" "http://a" "123")
string<?
#:key cadr)
(list '(lib "lib1/main.rkt")
'(lib "lib2/main.rkt")))
(check-equal? (get-module-pkgs '(lib "lib1/main.rkt"))
(list
(pkg "p1" "http://a" "" "" "123" "")))
(set-indexes! '("http://a" "http://c"))
(check-equal? (sort (get-indexes) string<?)
'("http://a" "http://c"))
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))
(delete-file (current-pkg-index-file))
(void)))

17
collects/pkg/scribblings/apis.scrbl Normal file
View File

@ -0,0 +1,17 @@
#lang scribble/manual
@(require (for-label (except-in racket/base
remove)
racket/contract/base
pkg
pkg/lib))
@title[#:tag "apis" #:style 'toc]{Package APIs}
The @racketmodname[pkg] provides a programmatic interface to the
@exec{raco pkg} commands, but additional libraries provide smaller
building blocks and local-database support.
@local-table-of-contents[]
@include-section["lib.scrbl"]
@include-section["pnr-db.scrbl"]

15
collects/pkg/scribblings/common.rkt Normal file
View File

@ -0,0 +1,15 @@
#lang at-exp racket/base
(require scribble/manual
scribble/core)
(provide (all-defined-out))
(define (command s)
@exec{raco pkg @|s|})
(define (command-ref s)
@(link-element "plainlink" @command[s] `(raco-pkg-cmd ,s)))
(define (command/toc s)
@(toc-target-element #f @command[s] `(raco-pkg-cmd ,s)))

266
collects/pkg/scribblings/lib.scrbl Normal file
View File

@ -0,0 +1,266 @@
#lang scribble/manual
@(require (for-label (except-in racket/base
remove)
racket/contract/base
pkg
pkg/lib
net/url
syntax/modcollapse
setup/getinfo))
@title[#:tag "lib"]{Package Management Functions}
@defmodule[pkg/lib]{The @racketmodname[pkg/lib] library provides
building blocks on which the @racket[pkg] library and @exec{raco pkg}
commands are built.}
@deftogether[(
@defform[(with-package-lock body ...+)]
@defform[(with-package-lock/read-only body ...+)]
)]{
Evaluates the @racket[body]s while holding a lock to prevent
concurrent modification to the package database. Use the
@racket[with-package-lock/read-only] form for read-only access.
Use these form to wrap uses of functions from @racketmodname[pkg/lib]
that read or modify the package database.}
@deftogether[(
@defboolparam[current-install-system-wide? system-wide?]
@defboolparam[current-install-version-specific? version-specific?]
@defparam[current-show-version s string?]
)]{
Parameters that together determine @tech{package scope} for management
operations and the version for version-specific scope.}
@defparam[current-pkg-error err procedure?]{
A parameter whose value is used to report errors that are normally
intended for an end uses. The arguments to the procedure are the same
as for @racket[error], except that an initial symbol argument is
omitted.
The default value uses @racket[error] with @racket['pkg] as the first
argument. The @exec{raco pkg} command sets this parameter to use
@racket[raise-user-error] with the sub-command name as its first
argument.}
@defparam[current-pkg-indexes indexes (or/c #f (listof url?))]{
A parameter that determines the @tech{package name resolvers} that are
consulted to resolve a @tech{package name}. If the parameter's value
is @racket[#f], then the result of @racket[pkg-config-indexes] is
used.}
@defproc[(pkg-config-indexes) (listof string?)]{
Returns a list of URL strings for the user's configured @tech{package
name resolvers}.}
@defstruct[pkg-info ([orig-pkg (or/c path-string?
(list/c 'link path-string?))]
[checksum (or/c #f string?)]
[auto? boolean?])
#:prefab]{
A structure type that is used to report installed-package information.}
@defproc[(package-directory [name string?]) path-string?]{
Returns the directory that holds the installation of the installed
package @racket[name].}
@defproc[(get-default-package-scope) (or/c 'i 'u 's)]{
Returns the user's configured default @tech{package scope}:
@racket['i] for installation, @racket['u] for user- and
version-specific, and @racket['s] for user-specific but shared across
versions.}
@defproc[(installed-pkg-names [#:scope scope (or/c #f 'i 'u 's)])
(listof string?)]{
Returns a list of installed package names for the given @tech{package
scope}, where @racket[#f] indicates the user's default @tech{package
scope}.}
@defproc[(installed-pkg-table [#:scope scope (or/c #f 'i 'u 's)])
(hash/c string? pkg-info?)]{
Returns a hash table of installed packages for the given @tech{package
scope}, where @racket[#f] indicates the user's default @tech{package
scope}.}
@deftogether[(
@defproc[(pkg-desc? [v any/c]) boolean?]
@defproc[(pkg-desc [name string?]
[type (or/c #f 'file 'dir 'link 'file-url 'dir-url 'github 'name)]
[checksum (or/c string? #f)]
[auto? boolean?])
pkg-desc?]
)]{
A @racket[pkg-desc] value describes a package source plus details of its
intended interpretation, where the @racket[auto?] field indicates that
the package is should be treated as installed automatically for a
dependency.}
@defproc[(stage-package [desc pkg-desc?]
[#:checksum checksum (or/c #f string?) #f])
(values path? (or/c #f string?) boolean?)]{
Locates the implementation of the package specified by @racket[desc] and
downloads and unpacks it to a temporary directory (as needed).
The result is the directory containing the unpacked package content,
the checksum (if any) for the unpacked package, and whether the
directory should be removed after the package content is no longer
needed.}
@defproc[(config-cmd [set? boolean?] [keys/vals list?])
void?]{
Implements the @racket[config] command.}
@defproc[(create-cmd [format (or/c 'zip 'tgz 'plt 'MANIFEST)]
[dir path-string?])
void?]{
Implements the @racket[create] command.}
@defproc[(install-cmd [names (listof string?)]
[#:dep-behavior dep-behavior
(or/c #f 'fail 'force 'search-ask 'search-auto)
#f]
[#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f])
(or/c #f (listof (or/c path-string? (non-empty-listof path-string?))))]{
Implements the @racket[install] command. The result indicates which
collections should be setup via @exec{raco setup}: @racket[#f] means
all, and a list means only the indicated collections.}
@defproc[(update-packages [names (listof string?)]
[#:dep-behavior dep-behavior
(or/c #f 'fail 'force 'search-ask 'search-auto)
#f]
[#:all? all? boolean? #f]
[#:deps? deps? boolean? #f])
(or/c #f (listof (or/c path-string? (non-empty-listof path-string?))))]{
Implements the @racket[update] command. The result is the same as for
@racket[install-packages].}
@defproc[(remove-packages [names (listof string?)]
[#:auto? auto? boolean? #f]
[#:force? force? boolean? #f])
void?]{
Implements the @racket[remove] command.}
@defproc[(show-cmd [indent string?]
[#:directory show-dir? boolean? #f])
void?]{
Implements the @racket[show] command for a single package scope,
printing to the current output port. See also
@racket[installed-pkg-names] and @racket[installed-pkg-table].}
@defproc[(index-show-cmd [names (listof string?)]
[#:all? all? boolean? #f]
[#:only-names? only-names? boolean? #f])
void?]{
Implements the @racket[index-show] command. If @racket[all?] is true,
then @racket[names] should be empty.}
@defproc[(index-copy-cmd [sources (listof path-string?)]
[dest path-string?]
[#:from-config? from-config? boolean? #f]
[#:merge? merge? boolean? #f]
[#:force? force? boolean? #f]
[#:override? override? boolean? #f])
void?]{
Implements the @racket[index-copy] command.}
@defproc[(get-all-pkg-names-from-indexes) (listof string?)]{
Consults @tech{package name resolvers} to obtain a list of available
@tech{package names}.}
@defproc[(get-all-pkg-details-from-indexes)
(hash/c string? (hash/c symbol? any/c))]{
Consults @tech{package name resolvers} to obtain a hash table of available
@tech{package names} mapped to details about the package. Details for
a particular package are provided by a hash table that maps symbols
such as @racket['source], @racket['checksum], and @racket['author].}
@defproc[(get-pkg-details-from-indexes [name string?])
(or/c #f (hash/c symbol? any/c))]{
Consults @tech{package name resolvers} to obtain information for a
single @tech{package name}, returning @racket[#f] if the @tech{package
name} has no resolution. Details for the package are provided in the
same form as from @racket[get-all-pkg-details-from-indexes].}
@defproc[(get-pkg-content [desc pkg-desc?]
[#:extract-info
extract-proc
((or/c #f
((symbol?) ((-> any)) . ->* . any))
. -> . any)
(lambda (get-pkg-info) ...)])
(values (or/c #f string?)
(listof module-path?)
any/c)]{
Gets information about the content of the package specified by
@racket[desc]. The information is determined inspecting the
package---resolving a @tech{package name}, downloading, and unpacking
into a temporary directory as necessary.
The results are as follows:
@itemize[
@item{The checksum, if any, for the downloaded package.}
@item{A list of module paths that are provided by the package.
Each module path is normalized in the sense of
@racket[collapse-module-path].}
@item{Information extracted from the package's metadata. By default,
this information is the package's dependencies, but in general
it is the result of @racket[extract-proc], which receives an
information-getting function (or @racket[#f]) as returned by
@racket[get-info].}
]}

140
collects/pkg/scribblings/pkg.scrbl
View File

@ -1,6 +1,7 @@
#lang scribble/manual
@(require scribble/bnf
scribble/core
"common.rkt"
(for-label pkg
(except-in racket/base remove)
setup/dirs))
@ -22,15 +23,6 @@
@(define (gtech s)
@tech[#:doc '(lib "scribblings/guide/guide.scrbl") s])
@(define (command s)
@exec{raco pkg @|s|})
@(define (command-ref s)
@(link-element "plainlink" @command[s] `(raco-pkg-cmd ,s)))
@(define (command/toc s)
@(toc-target-element #f @command[s] `(raco-pkg-cmd ,s)))
@; ----------------------------------------
@ -183,28 +175,23 @@ means that it has only the characters @|package-name-chars|.}
]
A @deftech{package name resolver} (@deftech{PNR}) is a server that
converts package names to other package sources. A PNR is identified
by a string representing a URL. This URL is combined with
@exec{pkg/}@nonterm{package} path segments (where @nonterm{package} is a package name) plus a
@exec{version=}@nonterm{version} query (where @nonterm{version} is the
Racket version number) to form a URL that should refer to a
@racket[read]-able hash table with the keys: @racket['source] mapped to
the @tech{package source} string and @racket['checksum] mapped to the
@tech{checksum} value. Typically, the @tech{package source} value for
@racket['source] will be a remote URL.
A @deftech{package name resolver} (@deftech{PNR},
a.k.a. @deftech{index}) is a server or database that converts package
names to other package sources. A PNR is identified by a string
representing a URL, where a @litchar{http://} or @litchar{https://}
URL indicates a remote server, and a @litchar{file://} URL indicates a
local database in the form of an SQLite database or a directory tree.
PLT supports two @tech{package name resolvers} that are enabled by
default: @url{https://pkg.racket-lang.org} for new
packages and @url{https://planet-compat.racket-lang.org} for
automatically generated packages for old @|PLaneT|
packages. Anyone may host their own @tech{package name resolver}. The
source for the PLT-hosted resolvers is in the
@racket[(collection-file-path "pkg-index" "meta")]
directory.
default: @url{https://pkg.racket-lang.org} for new packages and
@url{https://planet-compat.racket-lang.org} for automatically
generated packages for old @|PLaneT| packages. Anyone may host a
@tech{package name resolver}, and any file-serving HTTP host can act
as a basic @tech{package name resolver}. See @secref["pnr-protocol"]
for information on how package information is extracted from a PNR.
After a package is installed, the original source of its installation
is recorded, as well as if it was an @tech{automatic installation}. An
is recorded, as well as whether the instalation was an @tech{automatic installation}. An
@deftech{automatic installation} is one that was installed because it
was a dependency of a non-@tech{automatic installation} package.
@ -244,9 +231,9 @@ user-specific, but for all versions and installations of Racket.
@section{Managing Packages}
The Racket package manager has two user interfaces: a command line @exec{raco}
sub-command and a library. They have the exact same capabilities, as
The Racket package manager has two main user interfaces: a command line @exec{raco}
sub-command and a @racketmodname[pkg] library to run the same commands.
They have the exact same capabilities, as
the command line interface invokes the library functions and
reprovides all their options.
@ -329,7 +316,7 @@ the following @nonterm{option}s:
@item{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ...
--- Attempts to remove the given packages. If a package is the dependency
of another package that is not listed, this command fails without
removing any of the @nonterm{pkg}s. It accepts the following @nonterm{option}s:
removing any of the @nonterm{pkg}s. This command accepts the following @nonterm{option}s:
@itemlist[
@item{@DFlag{force} --- Ignore dependencies when removing packages.}
@ -367,7 +354,7 @@ removing any of the @nonterm{pkg}s. It accepts the following @nonterm{option}s:
}
@item{@command/toc{config} @nonterm{option} ... @nonterm{key} @nonterm{val} ... ---
View and modify package configuration options. It accepts the following @nonterm{option}s:
View and modify package configuration options. This command accepts the following @nonterm{option}s:
@itemlist[
@item{@DFlag{set} --- Sets an option, rather than printing it.}
@ -387,7 +374,7 @@ View and modify package configuration options. It accepts the following @nonterm
}
@item{@command/toc{create} @nonterm{option} ... @nonterm{package-directory}
--- Bundles a package directory into a package archive. It accepts the following @nonterm{option}s:
--- Bundles a package directory into a package archive. This command accepts the following @nonterm{option}s:
@itemlist[
@item{@DFlag{format} @nonterm{format} --- Specifies the archive format.
@ -396,9 +383,52 @@ View and modify package configuration options. It accepts the following @nonterm
@item{@DFlag{manifest} --- Creates a manifest file for a directory, rather than an archive.}
]
}
@item{@command/toc{index-show} @nonterm{option} ... @nonterm{package-name} ...
--- Consults @tech{package name resolvers} for a package (that is not necessarily installed)
and displays the resolver's information for the package, such as its source URL and
a checksum. This command accepts the following @nonterm{option}s:
@itemlist[
@item{@DFlag{all} --- Show information for all available packages. When using this flag,
supply no @nonterm{packaee-name}s.}
@item{@DFlag{only-names} --- Show only package names. This option is mainly useful with
@DFlag{all}, but when a @nonterm{packaee-name} is provided,
indexes are consulted to ensure that he package is available.}
@item{@DFlag{index} @nonterm{index} --- Query @nonterm{index} instead of the currently configured
@tech{package name resolvers}.}
]
}
@item{@command/toc{index-copy} @nonterm{option} ... @nonterm{src-index} ... @nonterm{dest-index}
--- Copies information from @tech{package name resolvers} names by @nonterm{src-index}es
to a local database or directory @nonterm{dest-index},
which can be used as a new @tech{package name resolver}.
The @nonterm{src-index}es can be remote or local, while @nonterm{dest-index} must be local
(i.e., a directory path or a SQLite database path, as inferred from the path).
If a @nonterm{src-index} or @nonterm{dest-index} does not start with a URL scheme, it is
treated as a filesystem path. Information from multiple @nonterm{src-index}es is merged,
with information from earlier @nonterm{src-index}es taking precedence over later
@nonterm{src-index}es.
This command accepts the following @nonterm{option}s:
@itemlist[
@item{@DFlag{from-config} --- Adds the currently configured
@tech{package name resolvers} to the end of the @nonterm{src-index}es list.}
@item{@DFlag{force} --- Replaces @nonterm{dest-index} if it exists already.}
@item{@DFlag{merge} --- Adds to @nonterm{dest-index} if it exists already. By default,
information already in @nonterm{dest-index} takes precedence
over new information.}
@item{@DFlag{override} --- Changes merging so that new information takes precedence
over information already in @nonterm{dest-index}.}
]
}
]
@subsection{Programmatic}
@subsection{Programmatic Commands}
@defmodule[pkg]
@ -410,8 +440,10 @@ to the command sub-sub-commands.
@defthing[update procedure?]
@defthing[remove procedure?]
@defthing[show procedure?]
@defthing[config procedure?]
@defthing[create procedure?])
@defthing[config procedure?]
@defthing[create procedure?]
@defthing[index-show procedure?]
@defthing[index-copy procedure?])
]{
Duplicates the @seclink["cmdline"]{command line interface}.
@ -419,7 +451,9 @@ to the command sub-sub-commands.
argument. An argument corresponding to @DFlag{type}, @DFlag{deps},
@DFlag{format}, or @DFlag{scope} accepts its argument as a symbol. All other options
accept booleans, where @racket[#t] is equivalent to the presence of
the option.}
the option.
See also @racketmodname[pkg/lib].}
@; ----------------------------------------
@ -681,6 +715,12 @@ future.
@; ----------------------------------------
@include-section["apis.scrbl"]
@include-section["pnr-protocol.scrbl"]
@; ----------------------------------------
@section[#:style 'quiet]{FAQ}
This section answers anticipated frequently asked questions about
@ -759,6 +799,32 @@ release a new package with a new name. For example, package
@pkgname{libgtk} might become @pkgname{libgtk2}. These packages
should be designed to not conflict with each other, as well.
@subsection{How can I fix my installation to a specific set of package
implementations or @tech{checksums}?}
Packages are updated only when you run a tool such as
@command-ref{update}, so packages are never updated
implicitly. Furthermore, you can snapshot a set of package archives
and install from those archives, instead of relying on package name
resolution through a @tech{package name resolver}.
If you want to control the resolution of package names (including
specific @tech{checksum}s) but not necessary keep a copy of all package
code (assuming that old @tech{checksum}s remain available, such as
through Github), you can create a snapshot of the @tech{package name}
to @tech{package source} mapping by using @command-ref{index-copy}.
For example,
@commandline{raco pkg index-copy --from-config /home/joe/snapshot.sqlite}
creates a snapshot @filepath{/home/joe/snapshot.sqlite} of the current
package name resolution, and then
@commandline{raco pkg config --set indexes file:///home/joe/snapshot.sqlite}
directs all package-name resolution to the snapshot. You can configure
resolution for specific package names by editing the snapshot.
@subsection{Why is the package manager so different than @|Planet1|?}
There are two fundamental differences between @|Planet1| and this package manager.

120
collects/pkg/scribblings/pnr-db.scrbl Normal file
View File

@ -0,0 +1,120 @@
#lang scribble/manual
@(require (for-label racket/base
racket/contract/base
pkg/pnr-db))
@title[#:tag "pnr-db"]{Package Name Database}
@defmodule[pkg/pnr-db]{The @racketmodname[pkg/pnr-db] library provides
tools for storing and retrieving @tech{package name resolver}
information in a local database.}
The functions provided by @racketmodname[pkg/pnr-db] do not actually
manage packages; they do not change or consult the local database of
installed modules in any @tech{package scope}. The functions provided
by @racketmodname[pkg/pnr-db] simply reflect a local copy of the
information that a @tech{package name resolver} and individual package
might provide (but with no guarantee of being in sync with an actual
@tech{package name resolver} or package).
The database is implemented as an SQLite database with its own
locking, so no additional locks are needed for database access, but
beware of concurrent database changes that could break your program
logic.
@defstruct[pkg ([name string?]
[index string?]
[author string?]
[source string?]
[checksum string?]
[desc string?])
#:transparent]{
Represents a package implementation in the database. The @racket[name]
(@tech{package name}) and @racket[index] (@tech{package name
resolver}, normally a URL) fields are always nonempty
strings. Otherwise, unknown fields are represented by empty strings.}
@defparam[current-pkg-index-file file path-string?]{
A parameter that determines the file path used to hold the SQLite
database. The default value is in the user's add-on directory and in
a version-specific subdirectory.}
@deftogether[(
@defproc[(get-indexes) (listof string?)]
@defproc[(set-indexes! [indexes (listof string?)]) void?]
)]{
Returns or sets the list of strings for all @tech{package name
resolvers} represented in the database. (Within the database, each
@tech{package name resolver} gets its own identifying number.)
The order of indices in the list represents a search order.
The @racket[set-indexes!] function removes information for any other
@tech{package name resolvers} from the database.}
@defproc[(get-pkgs [#:name name (or/c #f string?) #f]
[#:index index (or/c #f string?) #f])
(listof pkg?)]{
Gets a list of package descriptions. If @racket[name] or
@racket[index] is not @racket[#f] (or if both are not @racket[#f]),
then the result includes only matching packages.
The result list is ordered by precedence of the @tech{package name
resolver}.}
@defproc[(set-pkgs! [index string?] [pkgs (listof (or/c string? pkg?))])
void?]{
Sets the list of all packages that are recognized by the
@tech{package name resolver} @racket[index].
Information about any other package for @racket[index] is removed from
the database. If a string is provided for @racket[pkgs], it is
treated as a package name; if additional information is already
recorded in the database for the package name, then the additional
information is preserved.}
@defproc[(set-pkg! [name string?]
[index string?]
[author string?]
[source string?]
[checksum string?]
[desc string?])
void?]{
Sets the information for a specific package @racket[name] as
recognized by the @tech{package name resolver} @racket[index].}
@deftogether[(
@defproc[(get-pkg-tags [name string?] [index string?])
(listof string?)]
@defproc[(set-pkg-tags! [name string?] [index string?]
[module-paths (listof string?)])
void?]
)]{
Gets or sets a list of tags for the package
@racket[name] as recognized by the @tech{package name resolver}
@racket[index].}
@deftogether[(
@defproc[(get-pkg-modules [name string?] [index string?] [checksum string?])
(listof module-path?)]
@defproc[(set-pkg-modules! [name string?] [index string?] [checksum string?]
[module-paths (listof module-path?)])
void?]
)]{
Gets or sets a list of module paths that are provided for the package
@racket[name] as recognized by the @tech{package name resolver}
@racket[index] and for a specific @tech{checksum}.}

168
collects/pkg/scribblings/pnr-protocol.scrbl Normal file
View File

@ -0,0 +1,168 @@
#lang scribble/manual
@(require scribble/bnf
"common.rkt")
@title[#:tag "pnr-protocol"]{Package Name Resolver Protocol}
A @tech{package name resolver} is specified by a URL in one of three
forms:
@itemlist[
@item{@litchar{http://} or @litchar{https://} --- a remote URL}
@item{@litchar{file://} ending with @litchar{.sqlite} --- a local
SQLite database}
@item{@litchar{file://} without @litchar{.sqlite} --- a local
directory}
]
@section{Remote and Directory Indexes}
In the case of a remote URL or a local directory naming an
@tech{index}, the URL/path is extended as follows to obtain
information about packages:
@itemlist[
@item{@litchar{pkg} and @nonterm{package} path elements, where
@nonterm{package} is a @tech{package name}, plus a
@exec{version=}@nonterm{version} query (where @nonterm{version}
is the Racket version number) in the case of a remote URL:
This URL/path form is use to obtain information about
@nonterm{package}. An HTTP request for a remote URL should
respond with a @racket[read]-able hash table, as described
below. A path in a local directory formed by adding
@filepath{pkg} and @nonterm{package} should refer to a file
that similarly contains a @racket[read]-able hash table.
The hash table should supply the following keys:
@itemlist[
@item{@racket['source] (required) --- a @tech{package source}
string, typically a remote URL.}
@item{@racket['checksum] (requires) --- a string for a
@tech{checksum}.}
@item{@racket['name] --- a string that is the same as
@nonterm{package}.}
@item{@racket['author] --- a string for the author of the
package, normally an e-mail address.}
@item{@racket['description] --- a string describing the
package.}
@item{@racket['tags] --- a list of strings that describe the
package's categorization.}
]}
@item{@litchar{pkgs} path element: Obtains a list of package names
that are mapped by the @tech{index}. An HTTP request for a remote URL
should respond with a @racket[read]-able list of strings. A
path in a local directory formed by adding @filepath{pkg} and
@nonterm{package} should refer to a file that similarly
contains a @racket[read]-able list of strings.
This URL/path form is used by @command-ref{index-copy} and
tools that allow a user to browse an index.
In the case of a local directory, if no @filepath{pkgs} file is
available, a list is created by listing all files in the
@filepath{pkg} directory.}
@item{@litchar{pkgs-all} path element: Obtains a hash table mapping
package names to package details. An HTTP request for a remote
URL should respond with a @racket[read]-able hash table mapping
strings to hash tables. A path in a local directory formed by
adding @filepath{pkg} and @nonterm{package} should refer to a
file that similarly contains a @racket[read]-able hash table.
This URL/path form is a shortcut for a @litchar{pkgs} URL/path
form combined with a @litchar{pkgs/}@nonterm{package} query for
each package.
In the case of a local directory, if no @filepath{pkgs-all}
file is available, a list is created from files in the
@filepath{pkg} directory.}
]
Note that a local directory served as files through an HTTP server
works as a remote URL, as long as the @filepath{pkgs} and
@filepath{pkgs-all} files are present.
The source for the PLT-hosted @tech{package name resolvers} is in the
@racket[(collection-file-path "pkg-index" "meta")]
directory of the full Racket distribution.
@; ----------------------------------------
@section{SQLite Indexes}
A SQLite database @tech{index} is meant to be constructed and queries
using the @racketmodname[pkg/pnr-db] library, but the database can be
constructed in any way as long as it contains the following tables:
@itemlist[
@item{A @tt{pnr} table with the format
@verbatim[#:indent 2]{(id SMALLINT,
url TEXT,
pos SMALLINT)}.
Normally, the only row in this table is @tt{(0, "local", 0)},
but a database that records the content of a set of other
indexes can also be used as an index, in which case each row
represents an index; the @tt{id} field is a unique identifier
for each index, the @tt{url} field is the index's URL, and the
@tt{pos} column orders the index relative to others (where a
lower @tt{pos} takes precedence).}
@item{A @tt{pkg} table with the format
@verbatim[#:indent 2]{(name TEXT,
pnr SMALLINT,
author TEXT,
source TEXT,
checksum TEXT,
desc TEXT)}
The @tt{pnr} field is normally @tt{0}; in the case that the
database reflects multiple other indexes, the @tt{pnr} field
indicates the package entry's source index.
The @tt{pkg} and @tt{pnr} fields together determine a unique
row in the table.}
@item{A @tt{tags} table with the form
@verbatim[#:indent 2]{(pkg TEXT,
pnr TEXT,
tag TEXT)}
where the @tt{pkg} and @tt{pnr} combination identifies a unique
row in @tt{pkg}.}
@item{A @tt{modules} table with the form
@verbatim[#:indent 2]{(name TEXT,
pkg TEXT,
pnr SMALLINT,
checksum TEXT)}
where the @tt{pkg} and @tt{pnr} combination identifies a unique
row in @tt{pkg}, and @racket[name] is a printed module path.
This table is not currently used by any @exec{raco pkg}
command, but it can be used to suggest package installations to
provide a particular library.}
]

44
collects/pkg/scribblings/pnr.scrbl Normal file
View File

@ -0,0 +1,44 @@
#lang scribble/manual
@(require (for-label racket/base
pkg/pnr
pkg/lib
net/url
syntax/modcollapse))
@title[#:tag "pnr"]{Package Information Download}
@defmodule[pkg/pnr]{The @racketmodname[pkg/pnr]
library provides tools for consulting a @tech{package name resolver}
and package servers to obtain information about a package.}
In particular, @racketmodname[pkg/pnr] uses some of the functions from
@racketmodname[pkg/lib] to obtain information is that useful to
populate a database that is managed by @racketmodname[pkg/db].
See also @racket[pkg-indexes] from @racketmodname[pkg/lib].
@defproc[(get-pkg-names-from-pnr [pnr url?]) (listof string?)]{
Obtains a list of unique package names from the specified
@tech{package name resolver}.}
@defproc[(get-pkg-details-from-pnr [pnr url?]
[name string?])
hash?]{
Returns a hash table representing information about @racket[name] as
reported by @racket[pnr].}
@defproc[(get-pkg-modules [pnr url?]
[name string?])
(values (or/c #f string?) (listof module-path?))]{
Gets a list of module paths that are provided by @racket[name] as
resolved by @racket[pnr] and as provided by the package's server. The
result reports both the checksum of the package (as reported by
@racket[pnr]) and list of module paths.
The module paths are normalized in the sense of
@racket[collapse-module-path].}

37
collects/pkg/util.rkt
View File

@ -5,6 +5,7 @@
racket/file
racket/port
racket/match
racket/format
net/url
json)
@ -77,4 +78,40 @@
(call/input-url+200 (string->url (string-append pkg-url-str ".CHECKSUM"))
port->string)]))
;; uses a custodian to avoid leaks:
(define (call-with-url url handler)
(define c (make-custodian))
(dynamic-wind
void
(lambda ()
(define-values (p hs)
(parameterize ([current-custodian c])
(get-pure-port/headers url #:redirections 25 #:status? #t)))
(begin0
(and (string=? "200" (substring hs 9 12))
(handler p))
(close-input-port p)))
(lambda ()
(custodian-shutdown-all c))))
(define (read-from-server who url pred
[failure
(lambda (s)
(error who
(~a "bad response from server\n"
" url: ~a\n"
" response: ~v")
(url->string url)
s))])
(define bytes (call-with-url url port->bytes))
((if bytes
(with-handlers ([exn:fail:read? (lambda (exn)
(lambda () (failure bytes)))])
(define v (read (open-input-bytes bytes)))
(lambda ()
(if (pred v)
v
(failure bytes))))
(lambda () (failure #f)))))
(provide (all-defined-out))

7
collects/tests/pkg/basic-index.rkt
View File

@ -9,15 +9,20 @@
#"text/s-expr" empty
(λ (op) (write v op))))
(define (pkg-index/basic pkg-name->info)
(define (pkg-index/basic pkg-name->info all-pkgs)
(define (write-info req pkg-name)
(response/sexpr (pkg-name->info pkg-name)))
(define-values (dispatch get-url)
(dispatch-rules
[("pkgs-all") (lambda (req)
(response/sexpr (all-pkgs)))]
[("pkgs") (lambda (req)
(response/sexpr (hash-keys (all-pkgs))))]
[("pkg" (string-arg)) write-info]))
dispatch)
(provide/contract
[pkg-index/basic
(-> (-> string? (hash/c symbol? any/c))
(-> hash?)
(-> request? response?))])

43
collects/tests/pkg/test-indexes-api.rkt Normal file
View File

@ -0,0 +1,43 @@
#lang racket/base
(require pkg/lib
rackunit)
;; The `test-api' function is meant to be called via "test-indexes.rkt"
(provide test-api)
(define (test-api)
(check-true (andmap string? (pkg-config-indexes)))
(define pkg-names (get-all-pkg-names-from-indexes))
(check-not-false (member "pkg-test1" pkg-names))
(check-not-false (member "pkg-test2" pkg-names))
(define details (get-all-pkg-details-from-indexes))
(check-not-false (hash-ref details "pkg-test1" #f))
(check-not-false (hash-ref details "pkg-test2" #f))
(check-equal? (hash-ref (hash-ref details "pkg-test1")
'source)
"http://localhost:9999/pkg-test1.zip")
(check-equal? (hash-ref (hash-ref details "pkg-test2")
'source)
"http://localhost:9999/pkg-test2.zip")
(define test1-details (get-pkg-details-from-indexes "pkg-test1"))
(check-equal? test1-details
(hash-ref details "pkg-test1"))
(define-values (cksum mods deps)
(get-pkg-content (pkg-desc "pkg-test1" #f #f #f)))
(define-values (cksum1 mods1 deps1)
(get-pkg-content (pkg-desc "http://localhost:9999/pkg-test1.zip" #f #f #f)))
(check-equal? cksum cksum1)
(check-equal? mods '((lib "pkg-test1/conflict.rkt")
(lib "pkg-test1/main.rkt")
(lib "pkg-test1/update.rkt")))
(check-equal? deps '())
(define-values (cksum2 mods2 deps2)
(get-pkg-content (pkg-desc "pkg-test2" 'name #f #f)))
(check-equal? deps2 '("pkg-test1")))

3
collects/tests/pkg/test.rkt
View File

@ -52,4 +52,5 @@
"update-deps"
"update-auto"
"versions"
"raco")
"raco"
"indexes")

86
collects/tests/pkg/tests-indexes.rkt Normal file
View File

@ -0,0 +1,86 @@
#lang racket/base
(require pkg/lib
(prefix-in db: pkg/pnr-db)
racket/file
racket/format
"shelly.rkt"
"util.rkt")
(pkg-tests
(shelly-begin
(initialize-indexes)
$ "raco pkg config --set indexes http://localhost:9990"
$ "racket -l racket/base -l pkg/lib -e '(pkg-config-indexes)'"
=stdout> "'(\"http://localhost:9990\")\n"
$ "racket -l racket/base -l tests/pkg/test-indexes-api -e '(test-api)'"
=stderr> ""
(define d (make-temporary-file "pkg-~a" 'directory))
(define db (build-path d "pnr.sqlite"))
(define dir (build-path d "pnr"))
(define dir2 (build-path d "pnr2"))
$ (~a "raco pkg index-copy --from-config " (path->string db))
$ (~a "raco pkg config --set indexes file://" (path->string db))
$ "raco pkg index-show pkg-test1"
=stdout> #rx"Source: http://localhost:9999/pkg-test1.zip"
(parameterize ([db:current-pkg-index-file db])
(db:set-pkgs! "local"
(append (db:get-pkgs)
(list
(db:pkg "fish" "local" "nemo@sub" "http://localhost:9999/fish.zip" "123"
"Not a whale")))))
$ "raco pkg index-show fish" =stdout> #rx"Checksum: 123"
$ (~a "raco pkg index-copy " (path->string db) " " (path->string dir))
$ (~a "raco pkg config --set indexes file://" (path->string dir))
$ "raco pkg index-show fish" =stdout> #rx"Checksum: 123"
$ "raco pkg index-show --only-names fish" =stdout> #rx"fish"
$ "raco pkg index-show --only-names --all" =stdout> #rx"fish"
(delete-file (build-path dir "pkgs"))
(delete-file (build-path dir "pkgs-all"))
$ "raco pkg index-show fish" =stdout> #rx"Checksum: 123"
$ "raco pkg index-show --only-names fish" =stdout> #rx"^fish"
$ "raco pkg index-show --only-names --all" =stdout> #rx"^fish"
(delete-file (build-path dir "pkg/fish"))
$ "raco pkg index-show fish" =exit> 1
(define (try-merge dest)
(shelly-begin
$ (~a "raco pkg config --set indexes file://" (path->string dest))
(make-directory* (build-path dir2 "pkg"))
(define (add-whale! cksum)
(call-with-output-file*
(build-path dir2 "pkg" "whale")
#:exists 'truncate
(lambda (o)
(write (hash 'name "whale"
'checksum cksum
'source "http://localhost:9999/whale.plt")
o))))
(add-whale! "345")
$ (~a "raco pkg index-show --index file://" (path->string dir2) " whale") =stdout> #rx"Checksum: 345"
$ "raco pkg index-show whale" =exit> 1
$ (~a "raco pkg index-copy --merge " (path->string dir2) " " (path->string dest))
$ "raco pkg index-show whale" =stdout> #rx"Checksum: 345"
(add-whale! "567")
$ (~a "raco pkg index-copy --merge " (path->string dir2) " " (path->string dest))
$ "raco pkg index-show whale" =stdout> #rx"Checksum: 345"
$ (~a "raco pkg index-copy --merge --override " (path->string dir2) " " (path->string dest))
$ "raco pkg index-show whale" =stdout> #rx"Checksum: 567"))
(try-merge dir)
(try-merge db)
$ "raco pkg config --set indexes http://localhost:9990"
(delete-directory/files d)))

3
collects/tests/pkg/tests-locking.rkt
View File

@ -19,7 +19,8 @@
(λ (pkg-name)
(semaphore-wait okay-to-respond?-sema)
(define r (hash-ref *index-ht-1* pkg-name #f))
r))
r)
(λ () *index-ht-1*))
#:command-line? #t
#:servlet-regexp #rx""
#:port 9967)

3
collects/tests/pkg/util.rkt
View File

@ -66,7 +66,8 @@
(λ (pkg-name)
(define r (hash-ref index-ht pkg-name #f))
(printf "[>server ~a] ~a = ~a\n" port pkg-name r)
r))
r)
(λ () index-ht))
#:command-line? #t
#:servlet-regexp #rx""
#:port port))